prjbrook

forth85_19 Testing,live. 0=, ret insert

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