API tools faq
paste
prjbrook

forth85_18. Post_: update OK. Immediate

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