API tools faq
paste
prjbrook

forth85_20. AND OR some calcjumps

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