API tools faq
paste
prjbrook

forth85_17. Better. Flashing in simulation

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