API tools faq
paste
prjbrook

forth85_22. updatevars2 OK. Ran new word.

prjbrook
Aug 10th, 2014
454
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 67.53 KB | None | 0 0
raw download clone embed print report
  1. ;this is forth85_22 Tidies up forth85_21
  2. ;check out simulated line where qqq defined then invoked. Worked.
  3. ;TODO updatevars is a mess. Word <-->byte adr mixup. Done.
  4. ;do and test BRANCH and 0 BRANCH NOT DONE
  5. ; Also calcjump for rjmp opcodes needs tsting. NOT DONE
  6. ;could try (begin .... again) loop
  7. .NOLIST
  8. .include "tn85def.inc"
  9. .LIST
  10. ;.LISTMAC ;sometimes macro code gets in way of clarity in listing
  11. .MACRO header
  12. .db high(@0), low(@0), @1, @2
  13. .ENDMACRO
  14. .MACRO mypop
  15. ld @0,-y
  16. .ENDMACRO
  17. .MACRO mypush
  18. st y+, @0
  19. .ENDMACRO
  20. .MACRO mypop2
  21. mypop @0
  22. mypop @1
  23. .ENDMACRO
  24. .MACRO mypush2
  25. mypush @0
  26. mypush @1
  27. .ENDMACRO
  28. .MACRO pushx
  29. push xl
  30. push xh
  31. .ENDMACRO
  32. .MACRO popx
  33. pop xh
  34. pop xl
  35. .ENDMACRO
  36. .MACRO pushz
  37. push zl
  38. push zh
  39. .ENDMACRO
  40. .MACRO popz
  41. pop zh
  42. pop zl
  43. .ENDMACRO
  44. .MACRO mypopa ;call r16,17 the accumulator a, ditto for r18,r19 for b
  45. mypop r17
  46. mypop r16
  47. .ENDMACRO
  48. .MACRO mypopb
  49. mypop2 r19,r18
  50. .ENDMACRO
  51.  
  52. .def mylatest =r2 ;r2,r3 is mylatest
  53. .def myhere =r4 ;r4,r5 is myhere. The pointer to flash copy in buf2.
  54. .def SOFPG=r6 ;start of flash page
  55. ;r6,r7 byte adr of flash page (11c0)
  56. ;r8,r9 (0012) offset when flash comes into buf2. r8 +E0 = myhere
  57. .def SECONDLETTER =r10 ;helpful for debugging
  58. .def FOUNDCOUNTER = r11 ;dealWithWord clicks this if found =1. Counts successful finds in dictionary.
  59. .def STATE = r12
  60. .def STOP = r13 ;stop interpreting line of words
  61. .def BOTTOM = r14 ;have hit the bottom of the dict and not found a match
  62. .def FOUND = r15 ;if found=1 we have a match of Ram word on dictionary
  63. .def spmcsr_val=r18
  64. .def buf_ctr =r19 ;for flash section
  65. ;r20 is length of word in WORD
  66. ;r21 is the flash length of word with immediate bit 8, if any, still there
  67.  
  68. .def vl = r22
  69. .def vh = r23 ; u,v,w,x,y,z are all pointers
  70. .def wl = r24 ;w=r24,25
  71. .def wh = r25
  72.  
  73. .equ TX_PIN = 0
  74. .equ RX_PIN = 2 ; Tx,Rx pins are PB0 and PB2 resp
  75.  
  76. .def serialByteReg = r16
  77. .def rxByte = r18
  78. .def counterReg = r17
  79.  
  80. .equ testing = 1 ;makes io verbose. comment out later
  81.  
  82.  
  83. .eseg
  84. .org $10
  85. .dw HERE, LATEST ;these should be burned into tn85 with code
  86.  
  87. .DSEG
  88. .ORG 0x60
  89.  
  90. .equ BUF1LENGTH = 128
  91. .equ eHERE = $0010 ;eeprom adr of system varial eHere
  92. .equ eLATEST = $0012
  93.  
  94. buf1: .byte BUF1LENGTH ;input buffer. Lines max about 125
  95. buf2: .byte BUF1LENGTH ;this fits two flash buffers
  96. varSpace: .byte 64 ;might need more than 32 variables
  97. myStackStart: .byte 64 ;currently at $1E0.Meets return stack.
  98.  
  99. .CSEG
  100. .ORG 0x800 ;dictionary starts at 4K (2K words) mark
  101. ;----------------------------------------------------
  102. one_1:
  103. .db 0,0,3, "one" ;code for one
  104. one:
  105. ; rcall stackme
  106. rcall stackme_2
  107. .db 01, 00
  108. ret
  109. ;----------------------------------------------
  110. two_1:
  111. header one_1, 3, "two"
  112. two:
  113. rcall stackme_2
  114. .db 02,00
  115. ret
  116. ;------------------------------------------
  117. dup_1:
  118. header two_1,3,"dup"
  119. dup:
  120. mypop r17
  121. mypop r16
  122. mypush r16
  123. mypush r17
  124. mypush r16
  125. mypush r17
  126.  
  127. ret
  128. ;-------------------------------------------
  129. drop_1:
  130. header dup_1,4,"drop"
  131. drop:
  132. mypop r17
  133. mypop r16 ;TODO what if stack pointer goes thru floor?
  134. ret
  135. ;----------------------------------
  136. swapp_1: ;twp p's becasue assembler recognizes avr opcode swap
  137. header drop_1,5, "swapp"
  138. swapp:
  139. mypop2 r17,r16
  140. mypop2 r19,r18
  141. mypush2 r16,r17
  142. mypush2 r18,r19
  143. ret
  144.  
  145.  
  146. ;-------------------------------------------------
  147. ;shift this later
  148.  
  149. S_1:
  150. ;the EOL token that gets put into end of buf1 to stop parsing
  151. header swapp_1,$81,"S" ;NB always immediate
  152. S: ldi r16,02
  153. mov BOTTOM,r16 ;r14 =2 means a nice stop. EOL without errors
  154. clr STOP
  155. inc STOP ;set time-to-quit flag
  156. ret
  157. ;------------------------------------------
  158.  
  159. fetch_1: ;doesn't like label = @-1
  160. ;classic fetch. (adr -- num). Only in RAM
  161. header S_1,1,"@"
  162. fetch:
  163. pushx ;going to use x to point so better save
  164. mypop xh
  165. mypop xl
  166. ld r16,x+
  167. ld r17,x
  168. mypush r16
  169. mypush r17 ; and put them on my stack
  170. popx ;return with x intact and RAM val on my stack
  171. ret
  172. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  173.  
  174. cfetch_1: ;doesn't like label = c@-1
  175. ;classic fetch. (adr -- num). Only in RAM. Do I want y to advance just one byte on mystack
  176. header fetch_1,2,"c@"
  177. cfetch:
  178. pushx ;going to use x to point so better save
  179. mypop xh
  180. mypop xl
  181. ld r16,x+
  182. mypush r16
  183. popx ;return with x intact and RAM val on my stack
  184. ret
  185. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  186.  
  187. store_1: ;classic != "store"(adr num --) . Num is now at cell adr.
  188. header cfetch_1,1,"!"
  189. store:
  190. mypop2 r17,r16 ;there goes the num
  191. pushx
  192. mypop2 xh,xl ;there goes the address
  193. st x+,r16
  194. st x,r17 ;num goes to cell with location=adr
  195. popx
  196. ret
  197. ;ddddddddddddddddddddddddddddddddddddddddddddddddddd
  198.  
  199. cstore_1: ;classic c!= "store"(adr 8-bitnum --) . 8 bit Num is now at cell adr.
  200. header store_1,2,"c!"
  201. cstore:
  202. mypop r16 ;there goes the num. Just 8 bits at this stage.
  203. pushx
  204. mypop2 xh,xl ;there goes the address
  205. st x+,r16
  206. ; st x,r17 ;num goes to cell with location=adr
  207. popx
  208. ret
  209. ;------------------------------------
  210.  
  211. star_1: ;classic 16*16 mulitply (n n -- n*n)
  212. header cstore_1,1,"*"
  213. star:
  214. mypop2 r17,r16
  215. mypop2 r19,r18 ;now have both numbers in r16..r19
  216. rcall mpy16s ; multiply them. Result in r18..r21. Overflow in r20,21
  217. mypush2 r18,r19
  218. ret
  219. ;-----------------------------------------
  220.  
  221. slashMod_1: ;classic /MOD (n m -- n/m rem)
  222. header star_1,4,"/mod"
  223. slashMod:
  224. push r13
  225. push r14 ;this is STOP but is used by div16s, so better save it
  226. mypop2 r19,r18 ; that's m
  227. mypop2 r17,r16 ;that's n
  228. rcall div16s ;the the 16 by 16 bit divsion
  229. mypush2 r16,r17 ;answer ie n/m
  230. mypush2 r14,r15 ;remainder
  231. pop r14
  232. pop r13
  233. ret
  234. ;dddddddddddddddddddddddddddddddddddddddddddd
  235.  
  236. plus_1: ;classic + ( n n -- n+n)
  237. header slashMod_1,1,"+"
  238. plus:
  239. mypop2 r17,r16
  240. mypop2 r19,r18
  241. clc
  242. add r16,r18
  243. adc r17,r19
  244. mypush2 r16,r17
  245. ret
  246. ;--
  247.  
  248. minus_1: ;classic - ( n m -- n-m)
  249. header plus_1,1,"-"
  250. minus:
  251. mypop2 r19,r18
  252. mypop2 r17,r16
  253. clc
  254. sub r16,r18
  255. sbc r17,r19
  256. mypush2 r16,r17
  257. ret
  258. ;dddddddddddddddddddddddddddddddddddddddddd
  259.  
  260. pstore_1: ;expects eg. 0003 PORTB P! etc, "output 3 via PORTB"
  261. header minus_1,2, "p!"
  262. pstore:
  263. mypopb ;get rid of PORTB number, not used for tiny85, just one port
  264. mypopa ; this is used. it's eg the 003 = R16 above
  265. out PORTB,r16
  266. ret
  267. ;ddddddddddddddddddddddddd
  268.  
  269. portblabel_1:
  270. header pstore_1,5,"PORTB" ; note caps just a filler that point 0b in stack for dropping
  271. portblabel:
  272. ; Extend later on to include perhaps other ports
  273. ; one:
  274. ; rcall stackme
  275.  
  276. rcall stackme_2
  277. .db $0b, 00
  278. ret
  279. ;---------------------
  280.  
  281. datadirstore_1: ;set ddrb. invioked like this 000f PORTB dd! to make pb0..pb3 all outputs
  282. header portblabel_1, 3, "dd!"
  283. datadirstore:
  284. mypopb ; there goes useless 0b = PORTB
  285. mypopa ; 000f now in r17:16
  286. out DDRB,r16
  287. ret
  288. ;dddddddddddddddddddddddddddddddddddd
  289. ;sbilabel_1 ;set bit in PORTB. Just a kludge at this stage
  290. ;header datadirstore_1,3,"sbi" TODO sort out sbi and delay later. Now get on with compiler.
  291. ;first need store system vars in the eeprom. Arbitrarily 0010 is HERE and 0012 (in eeprom) is LATEST
  292. ;----------------------------------------
  293.  
  294. percentcstore_1: ;(n16 adr16 --) %c! stores stack val LSbyte to eeprom adr
  295. ; eg 10 00 1234 stores 34 to 0010 <--eeprom adr
  296. header datadirstore_1,3,"%c!"
  297. percentcstore:
  298. mypopb ;adr in r18,19
  299. mypopa ;data. Lower byte into r16
  300.  
  301. rcall eewritebyte ;burn it into eeprom
  302. ret
  303. ;----------------------------------
  304.  
  305. percentstore_1: ; (n16 adr16 --) b16 stored at eeprom adr adr16 and adr16+1
  306. header percentcstore_1,2, "%!"
  307. percentstore:
  308. mypopb ;adr in b=r18,19
  309. mypopa ;n16 into r16,17 as data
  310.  
  311. rcall eewritebyte ;burn low data byte
  312. clc
  313. inc r18
  314. brne outpcs
  315. inc r17 ;sets up adr+1 for next byte
  316. outpcs:
  317. mov r16,r17 ;r16 now conatins hi byte
  318. rcall eewritebyte
  319. ret
  320. ;-------------------------------
  321.  
  322. percentcfetch_1: ;(eepromadr16--char). Fetch eeprom byte at adr on stack
  323. header percentstore_1,3,"%c@"
  324. percentcfetch:
  325. mypopb ;adr now in r18,19
  326. rcall eereadbyte
  327. mypush r16 ; there's the char going on stack. Should be n16? Not n8?
  328. ret
  329. ;-------------------
  330.  
  331. percentfetch_1: ;(adr16--n16) get 16bits at adr and adr+1
  332. header percentcfetch_1,2,"%@"
  333. percentfetch:
  334. rcall percentcfetch ;low byte now on stack
  335. inc r18
  336. brcc downpf
  337. inc r19
  338. downpf:
  339. rcall eereadbyte ;there's the high byte hitting the mystack
  340. mypush r16
  341. ret
  342. ;-------------------------------
  343. gethere_1: ; leaves current value of eHERE on stack
  344. header percentfetch_1,7,"gethere"
  345. gethere:
  346. rcall stackme_2
  347. .dw eHere
  348. rcall percentfetch
  349. ret
  350. ;--------------------
  351.  
  352. getlatest_1: ;leaves current value of latest on stack
  353. header gethere_1,9, "getlatest"
  354. getlatest:
  355. rcall stackme_2
  356. .dw eLATEST ;the address of the latest link lives in eeprom at address 0012
  357. rcall percentfetch ;get the val out of eeprom
  358. ret
  359. ;------------------
  360.  
  361. colon_1: ;classic ":"compiling new word marker
  362. header getlatest_1,1,":"
  363. rcall coloncode
  364. ret
  365. ;----------------------------------------
  366.  
  367. comma_1: ;classic comma. ;Put adr on stack into dictionary at myhere and bump myhere
  368. header colon_1,1,","
  369. comma:
  370. mypopa ;adr now in r16,17
  371. pushz ;save z
  372. movw zl,myhere ;z now pnts to next avail space in dic
  373. st z+,r16
  374. st z+,r17
  375. movw myhere,zl ;so that myhere is updated as ptr
  376. popz ;bring z back
  377. ret
  378. ;------------------------------------
  379.  
  380. tic_1: ;clasic tic('). Put cfa of next word on stack
  381. header comma_1,1, "'"
  382. tic:
  383. rcall word ;point to next word in input
  384. rcall findword ;leaving cfa in z
  385. mypush2 zl,zh
  386. rcall two ;but it's in bytes. Need words so / by 2
  387. rcall slashmod
  388. rcall drop ;that's the remainder dropped
  389. ;now have cfa of word after ' on stack in word-units.
  390. ret
  391. ;-----------------------
  392.  
  393. dummy_1: ;handy debugging place to put a break point
  394. header tic_1,$85,"dummy" ;first immediate word
  395. dummy:
  396. nop
  397. ret
  398. ;--------------------------------
  399.  
  400. compstackme_2_1: ;needed infront of every number compiled
  401. header dummy_1, $0d,"compstackme_2"
  402. compstackme_2:
  403. ldi r16,low(stackme_2)
  404. ldi r17,high(stackme_2)
  405. mypush2 r16,r17 ;in words need to *2 to convert to bytes
  406. rcall two
  407. rcall star
  408. rcall compileme
  409. ret
  410. ;-----------------------------------------
  411.  
  412. double_1: ;whatever's on stack gets doubled. Usful words-->bytes. (n...2*n)
  413. header compstackme_2_1, 6, "double"
  414. double:
  415. mypopa ;stk to r16,17
  416. clc ;going to do shifts
  417. rol r16
  418. rol r17 ;r16,17 now doubled
  419. mypush2 r16,r17
  420. ret ;with 2*n on my stk
  421. ;--------------------------------------
  422.  
  423. semi_1: ;classic ";". Immediate TODO compile a final ret
  424. header double_1,$81,";"
  425. semi:
  426. nop
  427. rcall insertret ;compile ret
  428. rcall burnbuf2and3
  429. rcall rbrac ;after semi w'got back to executing
  430. ; rcall updatevars ;update HERE and LATEST in eeprom
  431. rcall updatevars2 ;Better version. update HERE and LATEST in eeprom
  432.  
  433. ret
  434. ;---------------------------------------
  435.  
  436. rbrac_1: ;classic "]" ,immediate
  437. header semi_1,$81,"]"
  438. rbrac:
  439. clr STATE ;go to executing
  440. ret
  441. ;------------------------------------------------
  442.  
  443. immediate_1: ;classic IMMEDIATE. Redo len byte so MSbit =1
  444. header rbrac_1,$89,"immediate"
  445. immediate:
  446. mypush2 r2,r3 ;this is mylatest. pnts to link of new word
  447. rcall two
  448. rcall plus ;jmp over link to pnt to len byte
  449. pushx ;better save x
  450. mypop2 xh,xl ;x now pnts to len byte
  451. ld r16,x ; and put it into r6
  452. ldi r18,$80 ;mask
  453. or r16,r18 ;eg 03 --> 83 in hex
  454. st x,r16 ;put len byte back
  455. popx ;back where it was
  456. ret ;done now newly created word is immediate
  457. ;-------------------------------------------------
  458.  
  459. emit_1: ;(n8 --) classic emit
  460.  
  461. header immediate_1, 4, "emit"
  462. emit:
  463. rcall emitcode
  464. ret
  465. ;--------------------------------------
  466.  
  467. getline_1: ;rx a line of chars from serialin. eol = $0d
  468. ;this is the line that gets interpreted
  469. header emit_1,7, "getline"
  470. getline:
  471. rcall rxStrEndCR ;write 64 TODO 128? bytes into buf1 from serial io
  472. .ifdef testing
  473. rcall dumpbuf1
  474. .endif
  475. ret ;with buf1 ready to interpret
  476. ;-------------------------------------------------
  477.  
  478. zero_1: ;stack a zero
  479. header getline_1,4,"zero"
  480. zero:
  481. rcall stackme_2
  482. .db 0,0
  483. ret
  484. ;----------------------------------------
  485.  
  486. equal_1: ;(n1 n2 -- flag)
  487. header zero_1,1,"="
  488. equal:
  489. rcall equalcode
  490. ret
  491. ;----------------------------------------
  492.  
  493. zeroequal_1: ;(n -- flag)
  494. header equal_1,2,"0="
  495. zeroequal:
  496. rcall zero
  497. rcall equal
  498. ret
  499. ;-------------------------
  500.  
  501. over_1: ;(n1 n2 --n1 n2 n1)
  502. header zero_1,4,"over"
  503. over:
  504. mypopa
  505. mypopb
  506. mypush2 r18,r19 ;n1
  507. mypush2 r16,r17 ;n2
  508. mypush2 r18,r19 ;n1. so end up with (n1,n2,n1
  509. ret
  510. ;-----------------------------------
  511.  
  512. rot_1: ;classic (n1 n2 n3 -- n2 n3 n1)
  513. header over_1,3,"rot"
  514. rot:
  515. mypopa
  516. push r17
  517. push r16 ;save n3
  518. rcall swapp ; n2 n1
  519. pop r16
  520. pop r17
  521. mypush2 r16,r17 ;n2 n1 n3
  522. rcall swapp ;n2 n3 n1
  523. ret
  524. ;------------------------------------
  525.  
  526. reverse3_1: ;PB (n1 n2 n3 -- n3 n2 n1). Reverses top 3 order
  527. header rot_1,8,"reverse3"
  528. reverse3:
  529. rcall swapp ; n1 n3 n2
  530. rcall rot ; n3 n2 n1
  531. ret ;so (n1 n2 n3 -- n3 n2 n1)
  532. ;--------------------------------------------
  533.  
  534. unrot_1: ;PB (n1 n2 n3 -- n3 n1 n2) Buries topitem two down
  535. header reverse3_1,5,"unrot"
  536. unrot:
  537. rcall reverse3 ; (n1 n2 n3 -- n3 n2 n1)
  538. rcall swapp ; n3 n1 n2
  539. ret
  540. ;--------------------------------
  541.  
  542. andd_1: ;classic AND
  543. header unrot_1,4,"andd" ; two d's otherwise asm problems
  544. andd:
  545. mypopa
  546. mypopb
  547. and r16,r18
  548. and r17,r19
  549. mypush2 r16,r17
  550. ret
  551. ;----------------------------------------
  552.  
  553.  
  554. orr_1: ;classic OR
  555. header andd_1,3,"orr" ; two r's otherwise asm problems
  556. orr:
  557. mypopa
  558. mypopb
  559. or r16,r18
  560. or r17,r19
  561. mypush2 r16,r17
  562. ret
  563. ;------------------------
  564.  
  565. calcjump_1: ;(to from -- opcode)
  566. header orr_1,$88, "calcjump"
  567. calcjump:
  568. rcall calcjumpcode
  569. ret ;with opcode on stack
  570. ;-----------------------
  571.  
  572. begin_1: ;( -- adr) classic BEGIN. Used in most loops
  573. header calcjump_1,$85,"begin"
  574. begin:
  575. rcall stackmyhere ;put next adr on stack. For AGAIN etc
  576. ret ;with adr on stack
  577. ;---------------------------
  578. again_1: ; (to_adr -- ) classic AGAIN cts loop back to BEGIN
  579. header begin_1, $85,"again"
  580. rcall stackmyhere ; to_adr fr_adr
  581. rcall minus ;rel_adr_distance eg $ffdd
  582. rcall stackme_2
  583. .dw $0002
  584. rcall div ;now adr difference in words. Works better.
  585. rcall stackme_2
  586. .dw $0fff ;$ffdd $0fff
  587. rcall andd ;$0fdd eg.
  588. rcall stackme_2
  589. .dw $c000 ;$0fdd $c000
  590. rcall orr ;$cffdd = rjmp back_to_again
  591. rcall one
  592. rcall minus ;t0-fr-1 = the jump part of rjmp
  593. rcall comma ;insert into dic
  594. ret ;with rjmp opcode in next pos in dic
  595. ;------------------------------
  596.  
  597. div_1: ; (n1 n2 -- n1/n2) classic / Could make 2 / faster with >, one right shift
  598. header again_1,1,"/"
  599. div:
  600. rcall slashMod
  601. rcall drop
  602. ret
  603. ;---------------------------------
  604. LATEST:
  605. halve_1: ; (n -- n/2) use shifts to halve num on stack. Handy
  606. header div_1,5,"halve"
  607. halve:
  608. mypopa
  609. clc
  610. ror r17
  611. ror r16
  612. mypush2 r16,r17 ;now num on stack has been halved
  613. ret ;with n/2 on stk
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621. ;-----------------------------------------------
  622. HERE:
  623. .db "444444444444444444444444444444"
  624. rcall stackme_2
  625. .dw $1234
  626. rcall two
  627. rcall stackme_2
  628. .dw $2468
  629.  
  630. rcall one
  631. rcall plus
  632. rcall dummy
  633. .org $0a14
  634. stad0:
  635. rcall one
  636. rcall drop
  637. rjmp stad0
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655. ;---------------stackme_2 used to live here----------------------------------
  656.  
  657.  
  658.  
  659.  
  660. ;====================================================================================================
  661.  
  662. .ORG 0
  663. rjmp quit
  664. ; rjmp mainloop
  665. ; rjmp start
  666. ;typein: .db "11bb 0014 %! getlatest",$0d, "0013 %@",0x0d
  667.  
  668. typein: .db " : qqq one two dup one ; qqq " ,$0d
  669. ;"11bb 0014 %! ", $0d ;%! getlatest",$0d, "0013 %@",0x0d
  670. ;" one 0010 00ab %c! 0012 cdef %! 0013 %c@ 0013 %@ 0987 drop ", 0x0d
  671.  
  672. ;stackme dropx onex stackme swap drop",0x0d
  673. ;-----------------------------------------------------
  674. ;start:
  675. quit:
  676. ldi r16, low(RAMEND)
  677. out SPL, r16
  678.  
  679.  
  680. ldi r16,high(RAMEND)
  681. out SPH, r16
  682.  
  683. ldi YL,low(myStackStart)
  684. ldi YH,high(myStackStart)
  685. ldi r16, 0xf9 ;PORTB setup
  686. out DDRB,r16 ;
  687. nop
  688. ldi r16, $ff
  689. out PORTB,r16
  690. .IFDEF testing ;testing = simulating on avrstudio4
  691. nop
  692. rcall burneepromvars
  693.  
  694. .ENDIF
  695. forthloop:
  696. ldi r16, low(RAMEND)
  697. out SPL, r16
  698.  
  699.  
  700. ldi r16,high(RAMEND)
  701. out SPH, r16
  702.  
  703. ldi YL,low(myStackStart)
  704. ldi YH,high(myStackStart)
  705.  
  706.  
  707. rcall getline0 ;This is FORTH
  708. rcall interpretLine
  709. .ifdef testing
  710. nop
  711. quithere:
  712. rjmp quithere ;only want one line interpreted when testing
  713. .else
  714. rjmp forthloop
  715. .endif
  716. ;-------------------------------------------------------
  717.  
  718.  
  719. ;rjmp test_interpretLine
  720. ;rjmp test_cfetch
  721. ;rjmp test_store
  722. ;rjmp test_cstore
  723. ;rjmp test_mpy16s
  724. ;rjmp test_mpy16s0
  725. ;rjmp test_star
  726. ;rjmp test_div16s
  727. ;rjmp test_slashMod
  728. ;rjmp test_Hex4ToBin2
  729. rjmp test_interpretLine
  730. ;rjmp setupforflashin
  731. ;rcall coloncode
  732. ;rjmp test_buf2ToFlashBuffer
  733. ;rjmp serialTest0
  734. ;zzz
  735.  
  736. stopper: rjmp stopper
  737. ; rjmp start
  738. ;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
  739. mainloop: ;this is forth. This is run continuously. Needs two versions: live and simulation.
  740. ; rcall quit
  741. rcall getline0
  742. rcall interpretLine
  743. ret
  744. ;--------------------------------------------------------------
  745. getline0: ;force a line into buf1 via flash string. Simulates GETLINE
  746. ldi zl, low(typein<<1)
  747. ldi zh, high(typein<<1)
  748. ldi xl, low(buf1)
  749. ldi xh, high(buf1)
  750. type0:
  751. lpm r16,Z+
  752. st x+,r16
  753. cpi r16,0x0d ;have we got to the end of the line?
  754. brne type0
  755. ret
  756. ;--------------------------------------------
  757. ;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20
  758. ;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char
  759. word: ;maybe give it a header later
  760. ld SECONDLETTER, x ;for debugging. TODO. Should be firstletter?
  761.  
  762. ld r16,x+ ;get char
  763.  
  764. cpi r16,0x20 ;is it a space?
  765. breq word ;if so get next char
  766. ;if here we're point to word start. so save this adr in w
  767. mov r24,xl
  768. mov r25,xh ;wordstart now saved in w
  769.  
  770.  
  771. clr r20 ;length initially 0
  772. nextchar:
  773. inc r20 ;r20 = word length
  774. ld r16,x+ ;get next char
  775. cpi r16,0x20
  776. brne nextchar
  777. dec r24 ;adjust start of word
  778. ;if here we've found a word.Starting at w length in r20.x points to space just past word
  779. ret
  780. ;----------------------------------------
  781.  
  782. compare: ;given a word in buf1 and a word in the dic are they the same? The word in the dic is pointed to by Z.
  783. ; and the word in buf1 is pointed to by w=r24,25. len = r20. Z on entry points to the link. Needs +2 to
  784. lpm r23,z+
  785. lpm r22,z+ ;store next link in v=r22,23. z now points to len byte
  786.  
  787. startc:
  788. ;TODO save copy of flash word in r21 and also do masking of immediates
  789. push r20 ;save length
  790. lpm r16,Z+ ;length of dictionary word, first entry now in r16
  791. mov r21,r16 ;copy length-in-flash to r21. May have immediate bit (bit 7)
  792. andi r16,$0f ;mask off top nibble before comparing
  793. cp r16,r20 ;same lengths?
  794. brne outcom ;not = so bail out
  795. ;if here the words are the same length, what about the rest of the chars.First get x to point to word.
  796. mov xl,r24
  797. mov xh,r25 ;x now point to start of buf1 word
  798. upcom:
  799. lpm r16,z+
  800. ld r17,x+ ;get one corresponding char from each word
  801. cp r16,r17 ;same word?
  802. brne outcom ;bail out if chars are different
  803. dec r20 ;count chars
  804. brne upcom ;still matching and not finished so keep going
  805. ;if here r20 is 0 so match must have been perfect so FOUND = 1
  806. clr FOUND
  807. inc FOUND
  808. outcom:
  809. pop r20 ;get old lngth of buf1 word back
  810. ret
  811. ;-------------------------------------------
  812. jmpNextWord: ;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte)
  813. ; and w = r24,25 contains RAM word start with len in r20
  814. ;exit with z pointing to next word ready for next COMPARE.
  815. clc
  816. rol r22
  817. rol r23 ;above 3 instructions change word address into byte address by doubling
  818. movw r30,r22 ;z now points to next word
  819. ret
  820. ;-----------------------------------------
  821.  
  822. doLatest: ;set up so first jump in dictionary is to top=LATEST and other flags set up.
  823. ; ldi vl, low(LATEST)
  824. ; ldi vh, high(LATEST)
  825. nop
  826. rcall getlatest ;from eeprom. Now on stack
  827. mypop2 vh,vl ;this is in bytes Need to halve it.
  828. ; rcall halve
  829. clr FOUND
  830. clr BOTTOM ;not yet found the match, not yet at the bottom. Either will stop search.
  831. clr STOP ;keep parsing words til this goes to a 1
  832. ret
  833. ;---------------------------------------------
  834. interpretLine: ;given line of words in buf one, search for words one by one. Don't do code
  835. ; or compile at this stage, just find and report that and go into next one.
  836. rcall getline0 ;change later to real getline via terminal
  837. rcall pasteEOL
  838. ldi xl, low(buf1)
  839. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  840. clr FOUNDCOUNTER ;counts finds in line parsing.
  841.  
  842. nextWord:
  843. tst STOP
  844. brne stopLine
  845. rcall word
  846. rcall findWord ;not done yet
  847. rcall dealWithWord ;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le}
  848. rjmp nextWord
  849. stopLine:
  850. ret
  851. ;-----------------------------------------------------------------
  852. findWord:
  853. rcall doLatest
  854. nop
  855. upjmpf:
  856. rcall jmpNextWord
  857. rcall compare
  858. tst FOUND
  859. brne stopsearchf ;if last compare got a match (FOUND=1) then stop searching
  860. tst vl
  861. brne upjmpf ;if v=0000 then we've hit the bottom of the dictionary
  862. tst vh
  863. brne upjmpf ;not found and not at bottom so keep going
  864. ;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
  865. clr BOTTOM
  866. inc BOTTOM ;exit with FOUND=0 and BOTTOM =1
  867. stopsearchf: nop
  868. ret
  869. ;----------------------------
  870. test_interpretLine:
  871. rcall interpretLine
  872. til: rjmp til ;** with r24 pointing to 'S' and FOUND = r15 =1
  873. ;------------------------------
  874. dealWithWord: ;come here when it's time to compile or run code
  875. ;Good debugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just
  876. ; past the word we are seeking (w-s). r10 is 2nd letter of w-s. w = start adr of w-s. v is a link
  877. ; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match
  878. ;
  879. nop
  880. tst FOUND
  881. breq notfound
  882. inc FOUNDCOUNTER
  883.  
  884. ;want to hop over filler bytes,0's added to keep codes on even byte boundaries
  885. ; so if r30 is odd at this stage inc it. odd is lsbit = 1.
  886. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  887. rjmp downd
  888. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  889. inc r30
  890. brcc downd
  891. inc r31 ;add one to z before converting to bytes
  892. ;have to ask at this point, is the word immediate? If so, bit 7 of r21 will be set.
  893. downd:
  894. sbrs r21,7
  895. rjmp downdw ;not immediate so just go on with STATE test
  896. rjmp executeme ;yes, immediate so execute every time.
  897.  
  898.  
  899. downdw: tst STATE
  900. breq executeme
  901. rcall compilecode
  902. rjmp outdww
  903. executeme:
  904. clc
  905. ror zh
  906. ror zl ;put z back into word values
  907.  
  908.  
  909. rcall executeCode
  910.  
  911.  
  912.  
  913. .MESSAGE "Word found"
  914. rjmp outdww
  915. notfound:
  916. nop
  917. ; .MESSAGE "Word not found"
  918. ; clr STOP
  919. ; inc STOP ;stop parsing line
  920. rcall numberh ; word not in dict so must be a number? Form = HHHH
  921. ;now have to add 3 to x so it points past this word ready not next one
  922. clc
  923. inc r26
  924. inc r26
  925. inc r26
  926. brcc outdww
  927. inc r27 ;but only if overflow
  928. nop
  929. outdww:
  930. ret ;with STOP =1 in not a number
  931. ;------------------------------------------------------------------------
  932. pasteEOL: ;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a
  933. ; special end of line word. When the word is invoked it casues a QUIT back to the waiting for input stage.
  934. ; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 "
  935. ldi xl, low(buf1)
  936. ldi xh, high(buf1) ;pnt to start of buffer
  937. clr r17
  938. nxtChar:
  939. inc r17 ;r17 is counter. Bail out when r17 > BUF1LENGTH
  940. cpi r17, BUF1LENGTH -3
  941. breq outProb
  942. ld r16, x+
  943. cpi r16, $0d
  944. brne nxtChar
  945. ;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it.
  946. ldi r16,$20
  947. st -x, r16 ;back up. Then go forward.
  948. ; ldi r16, ']'
  949. st x+, r16
  950. ldi r16,'S'
  951. st x+, r16
  952. ; ldi r16, '}'
  953. ; st x+, r16
  954. ldi r16, $20
  955. st x, r16
  956. rjmp outpel
  957.  
  958.  
  959. outProb:
  960. nop
  961. .MESSAGE "Couldn't find $0d"
  962. outpel:
  963. ret
  964.  
  965. ;-------------------------------------
  966. executeCode: ;with Z pointing to cfa. Not sure whether to jmp or call
  967.  
  968. ijmp
  969. ret
  970. ;---------------------------------------
  971. test_fetch: ;do run thru of @
  972. rcall getline0 ;change later to real getline via terminal
  973. rcall pasteEOL
  974. ldi xl, low(buf1)
  975. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  976.  
  977. ldi r16,$62
  978. mypush r16
  979. ldi r16,$0
  980. mypush r16 ;should now have adr $0062 on mystack
  981. rcall fetch
  982. tf1:
  983. rjmp tf1
  984. ;---------------------------------
  985. test_cfetch: ;do run thru of @
  986. rcall getline0 ;change later to real getline via terminal
  987. rcall pasteEOL
  988. ldi xl, low(buf1)
  989. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  990.  
  991. ldi r16,$62
  992. mypush r16
  993. ldi r16,$0
  994. mypush r16 ;should now have adr $62 on mystack
  995. rcall cfetch
  996. tcf1:
  997. rjmp tcf1
  998. ;----------------------------
  999. test_store:
  1000. rcall getline0 ;change later to real getline via terminal
  1001. rcall pasteEOL
  1002. ldi xl, low(buf1)
  1003. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1004. ldi r16,$62
  1005. ldi r17,$0
  1006. mypush2 r16,r17 ;should now have adr $62 on mystack
  1007. ldi r16, $AB
  1008. ldi r17, $CD
  1009. mypush2 r16,r17 ;now have $ABCD on mystack
  1010. rcall store
  1011. ts1:
  1012. rjmp ts1
  1013. ;------------------------
  1014. test_cstore:
  1015. rcall getline0 ;change later to real getline via terminal
  1016. rcall pasteEOL
  1017. ldi xl, low(buf1)
  1018. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1019. ldi r16,$62
  1020. ldi r17,$0
  1021. mypush2 r16,r17 ;should now have adr $62 on mystack
  1022. ldi r16, $AB
  1023. ; ldi r17, $CD
  1024. mypush r16 ;now have $ABCD on mystack
  1025. rcall cstore
  1026.  
  1027. ts11:
  1028. rjmp ts11
  1029. ;Now put arith routines here. Are from AVR200. Just using 16*16 for * but get 32bit result.
  1030.  
  1031.  
  1032. ;***************************************************************************
  1033. ;*
  1034. ;* "mpy16s" - 16x16 Bit Signed Multiplication
  1035. ;*
  1036. ;* This subroutine multiplies signed the two 16-bit register variables
  1037. ;* mp16sH:mp16sL and mc16sH:mc16sL.
  1038. ;* The result is placed in m16s3:m16s2:m16s1:m16s0.
  1039. ;* The routine is an implementation of Booth's algorithm. If all 32 bits
  1040. ;* in the result are needed, avoid calling the routine with
  1041. ;* -32768 ($8000) as multiplicand
  1042. ;*
  1043. ;* Number of words :16 + return
  1044. ;* Number of cycles :210/226 (Min/Max) + return
  1045. ;* Low registers used :None
  1046. ;* High registers used :7 (mp16sL,mp16sH,mc16sL/m16s0,mc16sH/m16s1,
  1047. ;* m16s2,m16s3,mcnt16s)
  1048. ;*
  1049. ;***************************************************************************
  1050.  
  1051. ;***** Subroutine Register Variables
  1052.  
  1053. .def mc16sL =r16 ;multiplicand low byte
  1054. .def mc16sH =r17 ;multiplicand high byte
  1055. .def mp16sL =r18 ;multiplier low byte
  1056. .def mp16sH =r19 ;multiplier high byte
  1057. .def m16s0 =r18 ;result byte 0 (LSB)
  1058. .def m16s1 =r19 ;result byte 1
  1059. .def m16s2 =r20 ;result byte 2
  1060. .def m16s3 =r21 ;result byte 3 (MSB)
  1061. .def mcnt16s =r22 ;loop counter
  1062.  
  1063. ;***** Code
  1064. mpy16s: clr m16s3 ;clear result byte 3
  1065. sub m16s2,m16s2 ;clear result byte 2 and carry
  1066. ldi mcnt16s,16 ;init loop counter
  1067. m16s_1: brcc m16s_2 ;if carry (previous bit) set
  1068. add m16s2,mc16sL ; add multiplicand Low to result byte 2
  1069. adc m16s3,mc16sH ; add multiplicand High to result byte 3
  1070. m16s_2: sbrc mp16sL,0 ;if current bit set
  1071. sub m16s2,mc16sL ; sub multiplicand Low from result byte 2
  1072. sbrc mp16sL,0 ;if current bit set
  1073. sbc m16s3,mc16sH ; sub multiplicand High from result byte 3
  1074. asr m16s3 ;shift right result and multiplier
  1075. ror m16s2
  1076. ror m16s1
  1077. ror m16s0
  1078. dec mcnt16s ;decrement counter
  1079. brne m16s_1 ;if not done, loop more
  1080. ret
  1081. ;----------------------------------------------------------
  1082. ;***** Multiply Two Signed 16-Bit Numbers (-12345*(-4321))
  1083. test_mpy16s:
  1084. ldi mc16sL,low(-12345)
  1085. ldi mc16sH,high(-12345)
  1086. ldi mp16sL,low(-4321)
  1087. ldi mp16sH,high(-4321)
  1088. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1089. ;=$032df219 (53,342,745)
  1090. tmpy: rjmp tmpy
  1091.  
  1092. test_mpy16s0:
  1093. ldi mc16sL,low(123)
  1094. ldi mc16sH,high(123)
  1095. ldi mp16sL,low(147)
  1096. ldi mp16sH,high(147)
  1097. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1098. tmpy0: rjmp tmpy0
  1099. ;-----------------------
  1100. test_star:
  1101. ldi r16,-$7b
  1102. mypush r16
  1103. ldi r16,$00
  1104. mypush r16 ;that's decimal 123 on stack
  1105. ldi r16,$93
  1106. mypush r16
  1107. ldi r16,$00
  1108. mypush r16 ; and thats dec'147
  1109. rcall star
  1110. tsr: rjmp tsr
  1111.  
  1112. ;--------------------------
  1113. ;***************************************************************************
  1114. ;*
  1115. ;* "div16s" - 16/16 Bit Signed Division
  1116. ;*
  1117. ;* This subroutine divides signed the two 16 bit numbers
  1118. ;* "dd16sH:dd16sL" (dividend) and "dv16sH:dv16sL" (divisor).
  1119. ;* The result is placed in "dres16sH:dres16sL" and the remainder in
  1120. ;* "drem16sH:drem16sL".
  1121. ;*
  1122. ;* Number of words :39
  1123. ;* Number of cycles :247/263 (Min/Max)
  1124. ;* Low registers used :3 (d16s,drem16sL,drem16sH)
  1125. ;* High registers used :7 (dres16sL/dd16sL,dres16sH/dd16sH,dv16sL,dv16sH,
  1126. ;* dcnt16sH)
  1127. ;*
  1128. ;***************************************************************************
  1129.  
  1130. ;***** Subroutine Register Variables
  1131.  
  1132. .def d16s =r13 ;sign register
  1133. .def drem16sL=r14 ;remainder low byte
  1134. .def drem16sH=r15 ;remainder high byte
  1135. .def dres16sL=r16 ;result low byte
  1136. .def dres16sH=r17 ;result high byte
  1137. .def dd16sL =r16 ;dividend low byte
  1138. .def dd16sH =r17 ;dividend high byte
  1139. .def dv16sL =r18 ;divisor low byte
  1140. .def dv16sH =r19 ;divisor high byte
  1141. .def dcnt16s =r20 ;loop counter
  1142.  
  1143. ;***** Code
  1144.  
  1145. div16s: ;push r13 ;PB !!
  1146. ;push r14 ;PB !!
  1147. mov d16s,dd16sH ;move dividend High to sign register
  1148. eor d16s,dv16sH ;xor divisor High with sign register
  1149. sbrs dd16sH,7 ;if MSB in dividend set
  1150. rjmp d16s_1
  1151. com dd16sH ; change sign of dividend
  1152. com dd16sL
  1153. subi dd16sL,low(-1)
  1154. sbci dd16sL,high(-1)
  1155. d16s_1: sbrs dv16sH,7 ;if MSB in divisor set
  1156. rjmp d16s_2
  1157. com dv16sH ; change sign of divisor
  1158. com dv16sL
  1159. subi dv16sL,low(-1)
  1160. sbci dv16sL,high(-1)
  1161. d16s_2: clr drem16sL ;clear remainder Low byte
  1162. sub drem16sH,drem16sH;clear remainder High byte and carry
  1163. ldi dcnt16s,17 ;init loop counter
  1164.  
  1165. d16s_3: rol dd16sL ;shift left dividend
  1166. rol dd16sH
  1167. dec dcnt16s ;decrement counter
  1168. brne d16s_5 ;if done
  1169. sbrs d16s,7 ; if MSB in sign register set
  1170. rjmp d16s_4
  1171. com dres16sH ; change sign of result
  1172. com dres16sL
  1173. subi dres16sL,low(-1)
  1174. sbci dres16sH,high(-1)
  1175. d16s_4: ;pop r14 ;PB!!
  1176. ;pop r13 ;PB!!
  1177. ret ; return
  1178. d16s_5: rol drem16sL ;shift dividend into remainder
  1179. rol drem16sH
  1180. sub drem16sL,dv16sL ;remainder = remainder - divisor
  1181. sbc drem16sH,dv16sH ;
  1182. brcc d16s_6 ;if result negative
  1183. add drem16sL,dv16sL ; restore remainder
  1184. adc drem16sH,dv16sH
  1185. clc ; clear carry to be shifted into result
  1186. rjmp d16s_3 ;else
  1187. d16s_6: sec ; set carry to be shifted into result
  1188. rjmp d16s_3
  1189.  
  1190. ;-----------------------------------------------
  1191.  
  1192. test_div16s:
  1193. ;***** Divide Two Signed 16-Bit Numbers (-22,222/10)
  1194. ldi dd16sL,low(-22222)
  1195. ldi dd16sH,high(-22222)
  1196. ldi dv16sL,low(10)
  1197. ldi dv16sH,high(10)
  1198. rcall div16s ;result: $f752 (-2222)
  1199. ;remainder: $0002 (2)
  1200.  
  1201. forever:rjmp forever
  1202. ;----------------------------------
  1203. test_slashMod:
  1204. ldi r16,$12
  1205. mypush r16
  1206. ldi r16,$34
  1207. mypush r16
  1208. ldi r16,$56 ;NB this is $3412 not $1234
  1209. mypush r16
  1210. ldi r16,$00
  1211. mypush r16
  1212. rcall slashMod ;$3412 / $56 = $9b rem 0 works
  1213. tslm: rjmp tslm
  1214.  
  1215. ;---------------------------------------
  1216. ;From http://www.avr-asm-tutorial.net/avr_en/calc/CONVERT.html#hex2bin
  1217. ; Hex4ToBin2
  1218. ; converts a 4-digit-hex-ascii to a 16-bit-binary
  1219. ; In: Z points to first digit of a Hex-ASCII-coded number
  1220. ; Out: T-flag has general result:
  1221. ; T=0: rBin1H:L has the 16-bit-binary result, Z points
  1222. ; to the first digit of the Hex-ASCII number
  1223. ; T=1: illegal character encountered, Z points to the
  1224. ; first non-hex-ASCII character
  1225. ; Used registers: rBin1H:L (result), R0 (restored after
  1226. ; use), rmp
  1227. ; Called subroutines: Hex2ToBin1, Hex1ToBin1
  1228.  
  1229. .def rBin1H =r17
  1230. .def rBin1L = r16
  1231. .def rmp = r18
  1232. ;
  1233. Hex4ToBin2:
  1234. clt ; Clear error flag
  1235. rcall Hex2ToBin1 ; convert two digits hex to Byte
  1236. brts Hex4ToBin2a ; Error, go back
  1237. mov rBin1H,rmp ; Byte to result MSB
  1238. rcall Hex2ToBin1 ; next two chars
  1239. brts Hex4ToBin2a ; Error, go back
  1240. mov rBin1L,rmp ; Byte to result LSB
  1241. sbiw ZL,4 ; result ok, go back to start
  1242. Hex4ToBin2a:
  1243. ret
  1244. ;
  1245. ; Hex2ToBin1 converts 2-digit-hex-ASCII to 8-bit-binary
  1246. ; Called By: Hex4ToBin2
  1247. ;
  1248. Hex2ToBin1:
  1249. push R0 ; Save register
  1250. rcall Hex1ToBin1 ; Read next char
  1251. brts Hex2ToBin1a ; Error
  1252. swap rmp; To upper nibble
  1253. mov R0,rmp ; interim storage
  1254. rcall Hex1ToBin1 ; Read another char
  1255. brts Hex2ToBin1a ; Error
  1256. or rmp,R0 ; pack the two nibbles together
  1257. Hex2ToBin1a:
  1258. pop R0 ; Restore R0
  1259. ret ; and return
  1260. ;
  1261. ; Hex1ToBin1 reads one char and converts to binary
  1262. ;
  1263. Hex1ToBin1:
  1264. ld rmp,z+ ; read the char
  1265. subi rmp,'0' ; ASCII to binary
  1266. brcs Hex1ToBin1b ; Error in char
  1267. cpi rmp,10 ; A..F
  1268. brcs Hex1ToBin1c ; not A..F
  1269. cpi rmp,$30 ; small letters?
  1270. brcs Hex1ToBin1a ; No
  1271. subi rmp,$20 ; small to capital letters
  1272. Hex1ToBin1a:
  1273. subi rmp,7 ; A..F
  1274. cpi rmp,10 ; A..F?
  1275. brcs Hex1ToBin1b ; Error, is smaller than A
  1276. cpi rmp,16 ; bigger than F?
  1277. brcs Hex1ToBin1c ; No, digit ok
  1278. Hex1ToBin1b: ; Error
  1279. sbiw ZL,1 ; one back
  1280. set ; Set flag
  1281. Hex1ToBin1c:
  1282. ret ; Return
  1283. ;--------------------------------------
  1284. test_Hex4ToBin2:
  1285. pushz
  1286. ldi zl,$60
  1287. clr zh ;z now points to start of buf1
  1288. ldi r16,'0'
  1289. st z+,r16
  1290. ldi r16,'f'
  1291. st z+,r16
  1292. ldi r16,'2'
  1293. st z+,r16
  1294. ldi r16,'3'
  1295. st z+,r16
  1296. ldi zl,$60
  1297. clr zh ;z now points back to start of buf1
  1298. rcall Hex4ToBin2
  1299. popz
  1300. th4: rjmp th4
  1301. ;-------------------------------------
  1302. numberh: ;word not in dictionary. Try to convert it to hex.
  1303. pushz ;algorithm uses z, pity
  1304. movw zl,r24 ;r4,25 = w holds start of current word
  1305. ;z now points eg to '12ab'start. If t=0 then it coverts to real hex
  1306. rcall hex4ToBin2 ;try to convert
  1307. ;above call needs 4 hex digits to emerge with t=0 and binary in r16,17
  1308. ;want this. If t=0 stack r16,17 and carry on interpreting, else emerge with
  1309. ; t=1 and zpointing to first problem char
  1310. brtc gotHex
  1311. ; if here there's a problem that z is pointing to. Bail out of interpret line
  1312. clr STOP
  1313. inc STOP
  1314. rjmp outnh
  1315.  
  1316. gotHex: ;sucess.Real hex in r16,17
  1317. mypush2 r16,r17 ; so push num onto mystack
  1318. ;maybe we're compiling. If so, push num into dic preceded by a call to stackme_2
  1319. tst STATE
  1320. breq outnh ;STATE =0 means executing
  1321. ; rcall tic
  1322. ; .db "stackme_2" ;has to be in dic before a number. cfa of stackme_2 on stack
  1323. rcall compstackme_2
  1324. ; rcall compileme ;insert "rcall stackme_2"opcode into dic
  1325. rcall comma ;there's the number going in
  1326.  
  1327. outnh:
  1328. popz ; but will it be pointing to "right"place in buf1? Yes now OK
  1329.  
  1330. ret
  1331. ; numberh not working fully, ie doesn't point to right place after action.
  1332. ; also no action if not a number? DONE better save this first.
  1333. ;---------------------------------
  1334. ;eeroutines
  1335. eewritebyte: ;write what's in r16 to eeprom adr in r18,19
  1336. sbic EECR,EEPE
  1337. rjmp eewritebyte ;keep looping til ready to write
  1338. ;if here the previous write is all done and we can write the next byte to eeprom
  1339. out EEARH,r19
  1340. out EEARL,r18 ;adr done
  1341. out EEDR,r16 ;byte in right place now
  1342. sbi EECR,EEMPE
  1343. sbi EECR,EEPE ;last 2 instruc write eprom. Takes 3.4 ms
  1344. ret
  1345. ;test with %!
  1346. ;---------------------------------
  1347. eereadbyte: ; read eeprom byte at adr in r18,19 into r16
  1348. ; Wait for completion of previous write
  1349. sbic EECR,EEPE
  1350. rjmp eereadbyte
  1351. ; Set up address (r18:r17) in address register
  1352. out EEARH, r19
  1353. out EEARL, r18
  1354. ; Start eeprom read by writing EERE
  1355. sbi EECR,EERE
  1356. ; Read data from data register
  1357. in r16,EEDR
  1358. ret
  1359. ;------------------------------
  1360. setupforflashin: ;using here etc get appropriate page, offset,myhere values.
  1361. ldi r16,low(HERE)
  1362. ldi r17,high(HERE) ;get here, but from eeprom better?
  1363. mypush2 r16,r17
  1364. rcall stackme_2
  1365. .dw 0002
  1366. rcall star ;now have current HERE in bytes in flash. But what is myhere?
  1367. rcall stackme_2
  1368. .db $0040 ;64 bytes per page
  1369. rcall slashMod
  1370. ;offset on top pagenum under. eg pg 0047, offset 0012
  1371. mypop2 r9,r8 ;store offset (in bytes)
  1372. rcall stackme_2
  1373. .db $0040
  1374. rcall star ;pgnum*64 = byte adr of start of flash page
  1375. mypop2 r7,r6
  1376. mypush2 r8,r9 ;push back offset
  1377. rcall stackme_2
  1378. .dw buf2
  1379. nop
  1380. ;at this stage we have offset in r8,r9 (0012). Also byte adr of flash page
  1381. ; start in r6,r7.(11c0) Stk is (offset buf2Start --) (0012 00E0 --). Need to
  1382. ; add these two together to get myhere, the pointer to RAM here position.
  1383. rcall plus ;add offset to buf2 start to get myhere (00f2)
  1384. ; put my here in r4,r5 for time being.
  1385. mypop2 r5,r4 ;contains eg 00f2 <--myhere
  1386. pushz ;going to use z so save it
  1387. movw zl,r6 ;r6,7 have byte adr of flsh pg strt
  1388. pushx ;save x
  1389. ldi xl,low(buf2)
  1390. ldi xh,high(buf2) ;point x to start of buf2
  1391. ldi r18,128 ;r18=ctr. Two flash pages = 128 bytes
  1392. upflash:
  1393. lpm r16,z+ ;get byte from flash page
  1394. st x+, r16 ; and put into buf2
  1395. dec r18
  1396. brne upflash
  1397. ;done. Now have two flash pages in ram in buf2. Myhere points to where next
  1398. ; entry will go. Where's page num?
  1399. popx
  1400. popz ;as if nothing happened
  1401.  
  1402.  
  1403. ret
  1404.  
  1405.  
  1406.  
  1407. ;outsufi: rjmp outsufi
  1408. ;-----------------------------------
  1409. burneepromvars: ;send latest versions of eHERE and eLATEST to eeprom
  1410. ldi r16,low(HERE)
  1411. ldi r17,high(HERE)
  1412. mypush2 r16,r17
  1413. ;up top we have .equ eHERE = $0010
  1414. ldi r16,low(eHERE)
  1415. ldi r17,high(eHERE)
  1416. mypush2 r16,r17
  1417. ;now have n16 eadr on stack ready for e!
  1418. rcall percentstore
  1419.  
  1420. ;send latest versions of eLATEST to eeprom
  1421. ldi r16,low(LATEST)
  1422. ldi r17,high(LATEST)
  1423. mypush2 r16,r17
  1424. ;up top we have .equ eLATEST = $0010
  1425. ldi r16,low(eLATEST)
  1426. ldi r17,high(eLATEST)
  1427. mypush2 r16,r17
  1428. ;now have n16 eadr on stack ready for e!
  1429. rcall percentstore
  1430. ret
  1431. ;-------------------------------------------
  1432. coloncode: ;this is the classic colon defining word.
  1433. rcall setupforflashin ;get all the relevant vars and bring in flash to buf2
  1434. rcall relinkcode ; insert link into first cell
  1435. rcall create ;compile word preceeded by length
  1436. rcall leftbrac ;set state to 1, we're compiling
  1437. ret ;now every word gets compiled until we hit ";"
  1438. ;-------------------------
  1439. relinkcode: ;put LATEST into where myhere is pointing and update ptr = myhere
  1440. ;also create mylatest
  1441. rcall getlatest ;now on stack
  1442. mypopa ;latest in r16,17
  1443. pushz ;better save z
  1444. movw mylatest,myhere ;mylatest <-- myhere
  1445. movw zl,myhere ;z now points to next available spot in buf2
  1446. st z+,r17 ;problem. Don't work unless highbye first in mem.Why?
  1447. st z+,r16 ;now have new link in start of dic word
  1448. movw myhere,zl ;update myhere to point to length byte. (Not yet there.)
  1449. popz ;restore z
  1450. ret
  1451. ;-------------------------------------------------
  1452. create: ;put word after ":" into dictionary, aftyer link, preceeded by len
  1453. rcall word ;start with x pnting just after ":".End with len in r20, x pointing to
  1454. ; space just after word and start of word in w=r24,25
  1455. pushz ;save z. It's going to be used on ram dictionary
  1456. movw zl,myhere ;z now pnts to next spot in ram dic
  1457. st z+,r20 ; put len byte into ram dic
  1458. mov r18,r20 ;use r18 as ctr, don't wreck r20
  1459. pushx ;save x. It's going to be word ptr in buf1
  1460. movw xl,wl ;x now points to start of word. Going to be sent to buf2
  1461. sendbytes:
  1462. ld r16,x+ ;tx byte from buf1 to
  1463. st z+,r16 ; buf2
  1464. dec r18 ;repeat r20=r18=len times
  1465. brne sendbytes
  1466.  
  1467. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  1468. rjmp downcr
  1469. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  1470. clr r16
  1471. st z+,r16 ;insert padding byte
  1472. ;inc r30
  1473. ;brcc downcr
  1474. ;inc r31 ;add one to z before converting to bytes
  1475.  
  1476. downcr:
  1477. movw myhere,zl ;myhere now points to beyond word in dic
  1478. popx
  1479. popz
  1480. ret ;with word in dic
  1481. ;----------------------------------------------
  1482. leftbrac: ;classic turn on compiling
  1483. clr STATE
  1484. inc STATE ;state =1 ==> now compiling
  1485. ret
  1486. ;------------------------
  1487. compilecode: ;come here with STATE =1 ie compile, not execute. Want to put
  1488. ; eg rcall dup in code in dictionary but not to execute dup. If here
  1489. ; z points to byte address of word
  1490. mypush2 zl,zh
  1491. compileme:
  1492. mypush2 myhere,r5 ;push ptr to RAM dic
  1493. ;next is entry point for eg ' stackme2 already on stack and have to compile
  1494.  
  1495. ldi r16,low(buf2)
  1496. ldi r17,high(buf2) ;start of buf that conatins flash pg in RAM
  1497. mypush2 r16,r17
  1498. rcall minus ; myhere - buf2-start = offset in page
  1499. mypush2 SOFPG,r7 ;push start of flash page address
  1500. rcall plus ;SOFPG + offset = adr of next rcall in dic
  1501. ;if here we have two flash addresses on the stack. TOS = here. Next is there.
  1502. ;want to insert code for "rcall there w"hen I'm at here. eg current debugging indicates
  1503. ; here = $11EB and there is $1012 (cfa of "two"). First compute
  1504. ; relative branch "there - here -2". Then fiddle this val into the rcall opcode
  1505. rcall minus ;that;s there - here. Usu negative.
  1506. ;I got fffffffff..ffe27 for above vals. First mask off all those f's
  1507. rcall two ;stack a 2
  1508. rcall minus ;now have there-here -2 = fe24. When there,here in bytes.
  1509. mypopa ;bring fe26 into r16,17
  1510. clc
  1511. ror r17
  1512. ror r16 ;now a:= a/2
  1513. ldi r18,$ff
  1514. ldi r19,$0f ;mask
  1515. and r16,r18
  1516. and r17,r19
  1517. ; mypush2 r16,r17 ;now fe26 --> 0e26
  1518. ;the rcall opcode is Dxxx where xxx is the branch
  1519. ; mypopa ;bring fe26 into r16,17
  1520. ldi r19, $d0 ;mask
  1521. or r17,r19
  1522. mypush2 r16,r17 ;now have $de26 on stack which is (?) rcall two
  1523. rcall comma ;store this opcode into dic. myhere is ptr
  1524. ret
  1525. ;---------------------------
  1526. stackme_2: ;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack
  1527. ; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack.
  1528. pop r17
  1529. pop r16 ; they now contain eg 0x0804 which contain the 16bit num
  1530. movw zl,r16 ;z now points to cell that cobtains the number
  1531. clc
  1532. rol zl
  1533. rol zh ;double word address for z. lpm coming up
  1534.  
  1535.  
  1536.  
  1537. lpm r16,z+
  1538. lpm r17,z+ ;now have 16bit number in r16,17
  1539.  
  1540. st y+,r16
  1541. st y+, r17 ;mystack now contains the number
  1542.  
  1543. clc
  1544. ror zh
  1545. ror zl ;halve the z pointer to step past the number to return at the right place
  1546.  
  1547. push zl
  1548. push zh
  1549.  
  1550. ret
  1551. ;------------------------------flash write section--------------------
  1552.  
  1553. do_spm:
  1554. ;lds r16,SPMCSR
  1555. in r16,SPMCSR
  1556. andi r16,1
  1557. cpi r16,1
  1558. breq do_spm
  1559. mov r16,spmcsr_val
  1560. out SPMCSR,r16
  1561. spm
  1562. ret
  1563. ;-------------------------------------------------------------------
  1564. buf2ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1565. push r30 ;save for later spm work.
  1566. push r19
  1567. push xl
  1568. push xh ;used as buf_ctr but may interfere with other uses
  1569. ldi XL,low(buf2) ;X pnts to buf1 that contains the 64 bytes.
  1570. ldi XH, high(buf2)
  1571. ;assume Z is already pointing to correct flash start of page.
  1572. flashbuf:
  1573. ldi buf_ctr,32 ;send 32 words
  1574. sendr0r1:
  1575. ld r16, x+ ;get first byte
  1576. mov r0,r16 ; into r0
  1577. ld r16, x+ ; and get the second of the pair into
  1578. mov r1,r16 ; into r1
  1579. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1580. rcall do_spm ;that's r0,r1 gone in.
  1581. inc r30
  1582. inc r30
  1583. dec buf_ctr ;done 32 times?
  1584. brne sendr0r1
  1585. pop xh
  1586. pop xl
  1587. pop r19 ;dont need buf_ctr any more.
  1588. pop r30 ;for next spm job
  1589.  
  1590. ret
  1591. ;--------------------------------------------------------------------------
  1592. ;TODO just have 1 burn routine with buf different
  1593. buf3ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1594. push r30 ;save for later spm work.
  1595. push r19 ;used as buf_ctr but may interfere with other uses
  1596. push xl
  1597. push xh
  1598. ldi XL,low(buf2+64) ;X pnts to buf1 that contains the 64 bytes.
  1599. ldi XH, high(buf2+64)
  1600. ;assume Z is already pointing to correct flash start of page.
  1601. rjmp flashbuf
  1602. ldi buf_ctr,32 ;send 32 words
  1603. sendr0r3:
  1604. ld r16, x+ ;get first byte
  1605. mov r0,r16 ; into r0
  1606. ld r16, x+ ; and get the second of the pair into
  1607. mov r1,r16 ; into r1
  1608. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1609. rcall do_spm ;that's r0,r1 gone in.
  1610. inc r30
  1611. inc r30
  1612. dec buf_ctr ;done 32 times?
  1613. brne sendr0r3
  1614. pop r19 ;dont need buf_ctr any more.
  1615. pop r30 ;for next spm job
  1616. ret
  1617.  
  1618. erasePage: ; assume Z points to start of a flash page. Erase it.
  1619. ldi spmcsr_val,0x03 ;this is the page erase command
  1620. rcall do_spm
  1621. ret
  1622. ;------------------------------------------------------------------
  1623. writePage:
  1624. ldi spmcsr_val, 0x05 ;command that writes temp buffer to flash. 64 bytes
  1625. rcall do_spm
  1626. nop ; page now written. z still points to start of this page
  1627. ret
  1628. ;---------------------------------------------------------------
  1629. test_buf2ToFlashBuffer: ;(adr_flashbufstartinBytes -- )
  1630. ; rcall fillBuf
  1631. ; ldi ZH, $10
  1632. ; ldi ZL,$c0 ;z=$01c0. Start of page 67.
  1633. rcall gethere
  1634. rcall double ;want bytes not words for flash adr
  1635. mypopa ;flashPgStart byte adr now in r16,17
  1636.  
  1637.  
  1638. movw zl,r16 ;z <--start of flash buffer
  1639. rcall erasePage
  1640. rcall buf2ToFlashBuffer
  1641. rcall writePage
  1642. herettt:
  1643. rjmp herettt
  1644. ;----------------------
  1645. ; burnbuf2. Come here from ";". The pair r6,r7 point to start of flash pg (bytes)
  1646. burnbuf2and3:
  1647. movw zl,r6 ;z now pnts to start of flash buf
  1648. rcall erasePage
  1649. rcall buf2ToFlashBuffer
  1650. rcall writePage
  1651. ;now going to burn next ram buffer to next flash page. Bump Z by 64 bytes.
  1652. adiw zh:zl,63 ;z now points to start of next flash buffer
  1653. lpm r16,z+ ;advance z pointer by one.adiw only lets max of 63 to be added.
  1654. ;now z points to start of next 64 byte buffer. Time to put buf3 into it.
  1655. rcall erasePage
  1656. rcall buf3ToFlashBuffer
  1657. rcall writePage
  1658. ret
  1659. heret:
  1660. rjmp heret
  1661. ;-------------------------------------------------------------
  1662. updatevars: ;after doing a colon def we have to update sys vars
  1663. ;TODO new version of LATEST is just old version of HERE.
  1664. ;TODO rplace all this code with updatevars2
  1665. ; just shif HERE into LATEST in eeprom to update. Gen. tidy required.
  1666. mypush2 r4,r5 ;put myhere on stack (E8)
  1667. ldi r16,low(buf2)
  1668. ldi r17,high(buf2)
  1669. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1670. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1671. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1672. rcall plus ;SOFG + offset = new HERE
  1673. ;now put also on stack new version of LATEST
  1674. mypush2 r2,r3 ;that's mylatest on stack
  1675. ldi r16,low(buf2)
  1676. ldi r17,high(buf2)
  1677. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1678. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1679. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1680. rcall plus ;SOFG + offset = new LATEST
  1681. ; now have both LATEST (tos) and HERE on stack. Burn these into eeprom
  1682. ;up top we have .equ eLATEST = $0010
  1683. ;But it's too big. In bytes and causing probs. Solution=covert to words
  1684. rcall halve
  1685. ldi r16,low(eLATEST)
  1686. ldi r17,high(eLATEST)
  1687. mypush2 r16,r17
  1688. ;now have n16 eadr on stack ready for e!
  1689. rcall percentstore
  1690. ; TODO the value for HERE is prob in bytes too. Convert to words.
  1691. ;up top we have .equ eLATEST = $0010
  1692. ldi r16,low(eHERE)
  1693. ldi r17,high(eHERE)
  1694. mypush2 r16,r17
  1695. ;now have n16 eadr on stack ready for e!
  1696. rcall halve ;TODO check this
  1697. rcall percentstore
  1698. ret ;with stack clear and new vals for HERE and LATEST in eeprom
  1699. ;----------
  1700. ;;;;;;;;;;;;;;;;;;;;;;;;;;;Now serial stuff starts;;;;;;;;;;;;;;;;;;;;;;;;;
  1701. halfBitTime: ;better name for this delay. Half of 1/600
  1702. ;myDelay1200:
  1703. ;ldi r21,13 ; 13 works for m328 at 16Mhz
  1704. ldi r21,7 ;try 7 for tiny85 at 8Hmz
  1705. ldi r20,130 ;r20,21 at 130,7 give 833uS. Good for 600baud at 8Mhz
  1706. starthbt:
  1707. inc r20
  1708. nop
  1709. brne starthbt
  1710. dec r21
  1711. brne starthbt
  1712. ret
  1713. ;--------------------------------------------------
  1714. oneBitTime:
  1715. rcall halfBitTime
  1716. rcall halfBitTime
  1717. ret
  1718. ;-------------------------------------------------
  1719. sendAZero:
  1720. ;output 0 on Tx pin
  1721. cbi PORTB,TX_PIN ; send a zero out PB0
  1722. ret
  1723. ;-----------------------------------------------------
  1724.  
  1725. sendAOne:
  1726. ;output 1 on Tx pin
  1727. sbi PORTB,TX_PIN ; send a zero out PB0
  1728. ret
  1729. ;-----------------------------------------------------
  1730. sendStartBit:
  1731. ; send a 0 for one bit time
  1732. rcall sendAZero
  1733. rcall oneBitTime
  1734. ret
  1735. ;-------------------------------------------------------
  1736. sendNextDataBit: ;main output routine for serial tx
  1737. lsr serialByteReg ;push high bit into carry flag then inspect it
  1738. ;originally did lsl but found lsb first.
  1739. brcc gotzero ;if it's a 0 do nothing
  1740. rcall sendAOne ;must have been a 1 in carry
  1741. rjmp down
  1742. gotzero:
  1743. rcall sendAZero ;if here carry was a zero
  1744. down:
  1745. rcall oneBitTime ;so that 1 or 0 lasts 1/600 sec
  1746. ret
  1747. ;-------------------------------------------------------------
  1748. send8DataBits: ; send all bits in serialByteReg
  1749. ldi counterReg,8 ;8 data bits
  1750. sendBit:
  1751. rcall sendNextDataBit
  1752. dec counterReg
  1753. brne sendBit
  1754. ret
  1755. ;--------------------------------------------------------
  1756. sendStopBit:
  1757. ; send a 1 for one bit time
  1758. rcall sendAOne
  1759. rcall oneBitTime
  1760. ret
  1761. ;--------------------------------------------------------
  1762. sendSerialByte: ;main routine. Byte in serialByteReg = r16
  1763. push counterReg
  1764. rcall sendStartBit
  1765. rcall send8DataBits
  1766. rcall sendStopBit
  1767. rcall sendStopBit ;two stops
  1768. pop counterReg
  1769. ret
  1770. ;**************************************************************
  1771. serialTest0: ;output series of 'AAAA..'s
  1772. ldi serialByteReg, 0x43 ;0x41
  1773. rcall sendSerialByte
  1774. rcall oneBitTime ; take a rest
  1775. ldi r16,$44
  1776. mypush r16
  1777. rcall emitcode
  1778.  
  1779. rjmp serialTest0 ;continue forever
  1780. ;---------------------------------------------------------
  1781. ;---------Now do SerialRx routines-------------------
  1782. waitForHigh: ;loop til RX is high
  1783. sbis PINB,RX_PIN ;test that pin for set (PB2)
  1784. rjmp waitForHigh ; loop if rx pin is low
  1785. ret
  1786. ;-----------------------------------------------
  1787. waitForLow: ;PRONBLEMs loop til RX is low. FIXED.
  1788. sbic PINB,2 ;test that pin for set (PB2)
  1789. rjmp waitForLow ; loop if rx pin is high
  1790. ret
  1791. ;---------------------------------------------------
  1792. waitForStartBit: ;loop til get a real start bit
  1793. rcall waitForHigh ;should be marking at start
  1794. rcall waitForLow ;gone low. might be noise
  1795. rcall halfBitTime ;is it still low in middle of bit time
  1796. sbic PINB,RX_PIN ;..well, is it?
  1797. rjmp waitForStartBit ;loop if level gone back high. Not a start bit.
  1798. ret ;we've got our start bit
  1799. ;----------------------------------------------------
  1800. checkForStopBit: ;at end, get carry flag to reflect level. Prob if c=0
  1801. rcall oneBitTime ; go into stop bit frame, halfway
  1802. sec ;should stay a 1 in C if stop bit OK
  1803. sbis PINB,RX_PIN ;don't clc if bit is high
  1804. clc ;but only if we have a weird low stop bit
  1805. ret ;with carry flag = stop bit. Should be a 1
  1806. ;-------------------------------------------------------------
  1807. get8Bits: ;get the 8 data bits. No frame stuff
  1808. clr rxbyte ;this will fill up with bits read from RX_PIN
  1809. push counterReg ;going to use this so save contents for later
  1810. ldi counterReg,8 ;because we're expecting 8 databits
  1811. nextBit:
  1812. rcall oneBitTime ;first enter here when mid-startbit
  1813. rcall rxABit ;get one bit
  1814. dec counterReg ;done?
  1815. brne nextBit ;no, round again
  1816. pop counterReg ;yes, finished, restor counter and get out
  1817. ret
  1818. ;---------------------------------------------------------------
  1819. rxABit: ;big serial input routine for one bit
  1820. clc ;assume a 0
  1821. sbic PINB,RX_PIN ; skip nxt if pin low
  1822. sec ;rx pin was high
  1823. ror rxbyte ;carry flag rolls into msb first
  1824. ret
  1825. ;********************************
  1826. getSerialByte: ;big routine. Serial ends up in rxByte
  1827. push counterReg
  1828. rcall waitForStartBit ;**change
  1829. rcall get8Bits
  1830. rcall checkForStopBit
  1831. pop counterReg
  1832. ret ;with rxByte containing serial bye
  1833. ;----------------------------------------------------
  1834. serialTest1: ;output A then reflect input. Worked OK
  1835. ldi serialByteReg, 0x36 ;0x41
  1836. rcall sendSerialByte
  1837. rcall oneBitTime ; take a rest
  1838. rcall getSerialByte
  1839. mov serialByteReg,rxByte ;output what's been read
  1840. rcall sendSerialByte
  1841. rjmp serialTest1
  1842. ;--------------------------------------------------------
  1843. ;----------Now doing buffer work. Want to and from 64 bytes----------
  1844. fillBuf:
  1845. ldi ZL,low(buf1) ;buf1 is my buffer
  1846. ldi ZH, high(buf1) ;Z now points to buf1
  1847. ldi counterReg,64 ;64 bytes in buffer
  1848. ldi r16,$30
  1849. storeB0:
  1850. st z+,r16
  1851. inc r16
  1852. dec counterReg
  1853. brne storeB0
  1854. herefb:
  1855. ; rjmp herefb
  1856. ret
  1857. ;----------------------------------------------------------
  1858. serialStrOut: ;X points to start of string,r17 has length
  1859. ld serialByteReg, x+
  1860.  
  1861. rcall sendSerialByte
  1862. dec r17 ;got to end of string?
  1863. brne serialStrOut
  1864. ret
  1865. ;----------------------------------
  1866. test_serialStrOut:
  1867. rcall fillBuf
  1868. ldi XL,low(buf1) ;buf1 start of str
  1869. ldi XH, high(buf1)
  1870. ldi r17,64 ;going to send len=r17 bytes
  1871. rcall serialStrOut
  1872. here2:
  1873. rjmp here2
  1874. ;--------------------------------------
  1875. waitForCharD: ;wait til eg a 'D' is pressed then do something.
  1876. ldi serialByteReg, '>' ;0x41
  1877. rcall sendSerialByte
  1878. rcall oneBitTime ; take a rest
  1879. rcall getSerialByte
  1880. mov serialByteReg,rxByte ;output what's been read
  1881. cpi rxByte, 'D'
  1882. brne waitForCharD
  1883. ldi serialByteReg, '*'
  1884. rcall sendSerialByte
  1885. rjmp waitForCharD
  1886. ;-----------------------------------------------------------
  1887. dumpbuf1:
  1888. ldi XL,low(buf1) ;buf1 start of str
  1889. ldi XH, high(buf1)
  1890. ldi r17,64 ;going to send len=r17 bytes
  1891. rcall serialStrOut
  1892. ret
  1893. ;-------------------------------------------------------------
  1894. test_dumpbuf1:
  1895. rcall fillBuf
  1896. rcall getSerialByte ;any one will do.
  1897. rcall dumpbuf1
  1898. rjmp test_dumpbuf1
  1899. ;----------------------------------------------------------
  1900. waitForDDump: ;wait til eg a 'D' is pressed then dump buf1
  1901. ldi serialByteReg, '>' ;0x41
  1902. rcall sendSerialByte
  1903. rcall oneBitTime ; take a rest
  1904. rcall getSerialByte
  1905. mov serialByteReg,rxByte ;output what's been read
  1906. cpi rxByte, 'D'
  1907. brne waitForDDump
  1908. rcall dumpbuf1
  1909. rjmp waitForCharD
  1910. ;---------------------------------------------------------------
  1911. rxStrEndCR: ;get a serial string that ends with CR
  1912. clr counterReg
  1913. ldi XL,low(buf1) ;buf1 is where str will go
  1914. ldi XH, high(buf1)
  1915. upsec:
  1916. rcall getSerialByte
  1917. cpi rxByte,$0d ;is it CR = end of string?
  1918. breq fin
  1919. st x+, rxByte ;char goes into buffer="buf1"
  1920. inc counterReg ;don't go over 64 bytes
  1921. cpi counterReg,64
  1922. brne upsec ;not too long and not CR so keep going
  1923. fin:
  1924. ret
  1925. ;---------------------------------------------
  1926. test_rxStrEndCR: ;just a test of above
  1927. rcall rxStrEndCR
  1928. rcall waitForDDump
  1929. rjmp test_rxStrEndCR
  1930. ;------------------------------------------------------
  1931. test2_rxStrEndCR: ;want a diagnostic dump if testing. Works with .IFDEF
  1932. rcall rxStrEndCR
  1933. .IFDEF testing
  1934. rcall dumpbuf1
  1935. .ENDIF
  1936. rjmp test2_rxStrEndCR
  1937. ;------------------------------------------------------------
  1938. rxStrWithLen: ;expect len char char char.. for len chars
  1939. push counterReg
  1940. ldi XL,low(buf1) ;buf1 is where str will go
  1941. ldi XH, high(buf1)
  1942. rcall getSerialByte ; get length bye Must be less than 65
  1943. mov counterReg, rxByte ;save len in counter
  1944. cpi counterReg,65 ;
  1945. brlo allOK ;less than 65 so carry on. Branch if Lower
  1946. ldi counterReg,64 ; if len>64 then len=64. Buffer = buf1 only 64 bytes
  1947. allOK:
  1948. tst counterReg ;zero yet?
  1949. breq finrs
  1950. rcall getSerialByte ;next serial input byte
  1951. st x+, rxByte ;put into buffer
  1952. dec counterReg ;have we done len=counterReg bytes?
  1953. rjmp allOK
  1954. finrs:
  1955. pop counterReg
  1956. ret
  1957. ;---------------------------------------------------------------
  1958. test_rsStrWithLen: ;works ok with macro $05GHIJKLM. Sends GHIJK
  1959. ldi r16, '#'
  1960. rcall sendSerialByte
  1961. rcall rxStrWithLen
  1962. rcall dumpbuf1
  1963. rjmp test_rsStrWithLen
  1964. ;-----------------------------now start forth i/o words like emit------------------
  1965. emitcode: ; (n8 --)classic emit
  1966. mypop r16
  1967. rcall sendserialbyte
  1968. ret
  1969. ;------------------------------------------------
  1970. insertret: ;semi has to end new word with ret = $9508 opcode
  1971. pushx ;both xl,xh saved for later
  1972. movw xl,myhere ;myhere points to next available spot in ram dic
  1973. ldi r16,$08
  1974. st x+,r16 ;$08 part goes first
  1975. ldi r16,$95
  1976. st x+,r16 ;ret now in ram. Just tidy pointers
  1977. movw myhere,xl
  1978. popx ;so x back where it was and ret inserted.
  1979. ret
  1980. ;--------------------------------
  1981. equalcode: ;(n1 n2 -- flag) if n1 = n2 flag = 0001 else 0000
  1982. mypopa
  1983. mypopb ; now have TOS in r16,17, underneath that in r18,19
  1984. cp r16,r18 ;low bytes =?
  1985. brne zout ;not equal so go out
  1986. cp r17,r19 ;hi bytes =?
  1987. brne zout ;no, so out
  1988. ;if here both n16's are equal so push a 0001
  1989. rcall one
  1990. rjmp aout ;done
  1991. zout:
  1992. rcall zero ;not = so push a zero
  1993. aout:
  1994. ret ;with a flag on stack replacing to n16's
  1995. ;------------------------------
  1996. ;TODO eliminate below and replace with simpler RAM jmp code.
  1997. calcjumpcode: ;(to from -- opcode_for_rjmp to at from)
  1998. ;used when compiling. What is the rjmp opcode if
  1999. ; we know the from and to adr on stack. ( to fr --)
  2000. ldi r16, low(buf2)
  2001. ldi r17, high(buf2)
  2002. mypush2 r16,r17 ; (to fr $e0 --)
  2003. rcall dup ;t f $e0 $eo
  2004. rcall unrot ;t $e0 fr $e0
  2005. rcall minus ;t $e0 frOffset
  2006. rcall unrot ;frOffset t $e0
  2007. rcall minus ;frOffset toOffset
  2008. ;now apply these offsets in flash buffer. Add them to start of flash buffer adr
  2009. mypush2 SOFPG,r7 ; frOffset toOffset SOFPG
  2010. rcall dup ;frOffset toOffset SOFPG SOFPG
  2011. rcall unrot ;frOffset SOFPG toOffset SOFPG
  2012. rcall plus ;frOffset SOFPG toFlashAdr
  2013. rcall unrot ;toFlashAdr frOffset SOFPG
  2014. rcall plus ;toFlashAdr frFlashAdr
  2015. rcall minus ;to -from give last 3 nibbles in rjmp opcode +1
  2016. rcall one
  2017. rcall minus ; now have to - from -1
  2018. rcall stackme_2
  2019. .dw $0fff
  2020. rcall andd ; now have eg. 0f20. Want Cf20
  2021. rcall stackme_2
  2022. .dw $c000 ;should now have right opcode eg cf20
  2023. ret ;with correct rjmp kkk on stack. Ready to insert into RAM dic.
  2024. ;-------------------
  2025. stackmyhere: ;( --- adr) put RAM ptr myhere on stack
  2026. mypush2 myhere, r5
  2027. ret
  2028. ;---------------------------
  2029. begincode: ;when using BEGIN just stack current address.No dic entry
  2030. rcall stackmyhere ;put next adr on stack
  2031. ret
  2032. ;----------------------------
  2033. stkmyhere: ;put myhere on the stack, handy
  2034. mypush2 myhere,r5
  2035. ret
  2036. ;-----------------------------------
  2037. stkSOBuf2: ;stack start of buf2. Handy.
  2038. ldi r16,low(buf2)
  2039. ldi r17,high(buf2)
  2040. mypush2 r16,r17
  2041. ret ;with adr of buf2 on stk
  2042. ;--------------------------
  2043. stkSOFPG: ;put start of flash page on stack, In bytes.
  2044. mypush2 SOFPG,r7
  2045. ret ;with start of current flash page's adr on stack.
  2046. ;-------------------------------
  2047. stklatestadr: ;put e-adr of eLatest. Currently 012 in eeprom
  2048. ldi r16,low(eLATEST)
  2049. ldi r17,high(eLATEST)
  2050. mypush2 r16,r17
  2051. ret ;with 012 or adr of eLatest on stk
  2052. ;-------------------------------------
  2053. stkhereadr: ;same as above but for HERE
  2054. ldi r16,low(eHERE)
  2055. ldi r17,high(eHERE)
  2056. mypush2 r16,r17
  2057. ret ;with adr of ehere,current eeprom adr = $010
  2058. ;-------------------------------------------
  2059. updatevars2: ;better version of update vars. Come here after ";"
  2060. rcall gethere ;the HERE val now on stack. It's a pointer to flash.
  2061. rcall stklatestadr ;usually 012
  2062. rcall percentstore
  2063. ;now with LATEST now containing old HERE. Next fix HERE
  2064. rcall stkmyhere ;current ptr to RAM dic's next free byte
  2065. rcall stkSOBuf2 ;start of buf2 adr
  2066. rcall minus ;gives distance into the buffer
  2067. rcall stkSOFPG ;will add distance to start of flashbuf
  2068. rcall plus ;got flash adr, but in bytes
  2069. rcall halve ;now adr in words
  2070. rcall stkhereadr ;usually %010 in eeprom
  2071. rcall percentstore ;eHERE now updated
  2072. ret ;with vals for HERE and LATEST in eeprom updated after ";"
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!