API tools faq
paste
prjbrook

forth85_13. Starting colon, relinking etc

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