API tools faq
paste
prjbrook

forth85_29. Got IF opcode issues solved.

prjbrook
Aug 31st, 2014
306
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 84.99 KB | None | 0 0
raw download clone embed print report
  1. ;this is forth85_29 (There's no _28) Tidies up forth85_28. Big issues with IF wandering off. fixed, I think
  2. ; Still need to bail out when stack empty with .S
  3. ;big issues calculating jump opcodes. Silly stack errors.
  4.  
  5.  
  6. ;.equ testing = 1 ;Very handy. Used a lot in AVR Studio4; makes io verbose. comment out later
  7. ;.equ livetesting = 1 ;Very handy when live; comment out to take out the little dumps and diagnostics.
  8.  
  9. .NOLIST
  10. .include "tn85def.inc"
  11. .LIST
  12. ;.LISTMAC ;sometimes macro code gets in way of clarity in listing
  13. .MACRO header
  14. .db high(@0), low(@0), @1, @2
  15. .ENDMACRO
  16. .MACRO mypop
  17. ld @0,-y
  18. .ENDMACRO
  19. .MACRO mypush
  20. st y+, @0
  21. .ENDMACRO
  22. .MACRO mypop2
  23. mypop @0
  24. mypop @1
  25. .ENDMACRO
  26. .MACRO mypush2
  27. mypush @0
  28. mypush @1
  29. .ENDMACRO
  30. .MACRO pushx
  31. push xl
  32. push xh
  33. .ENDMACRO
  34. .MACRO popx
  35. pop xh
  36. pop xl
  37. .ENDMACRO
  38. .MACRO pushz
  39. push zl
  40. push zh
  41. .ENDMACRO
  42. .MACRO popz
  43. pop zh
  44. pop zl
  45. .ENDMACRO
  46. .MACRO mypopa ;call r16,17 the accumulator a, ditto for r18,r19 for b
  47. mypop r17
  48. mypop r16
  49. .ENDMACRO
  50. .MACRO mypopb
  51. mypop2 r19,r18
  52. .ENDMACRO
  53. .macro TAKEMEOUT
  54. .ifdef livetesting
  55. ldi serialByteReg, @0
  56. rcall sendSerialByte
  57. ldi serialByteReg, @0
  58. rcall sendSerialByte
  59. .endif
  60.  
  61. .endmacro
  62.  
  63.  
  64.  
  65.  
  66. .def mylatest =r2 ;r2,r3 is mylatest
  67. .def myhere =r4 ;r4,r5 is myhere. The pointer to flash copy in buf2.
  68. .def SOFPG=r6 ;start of flash page
  69. ;r6,r7 byte adr of flash page (11c0)
  70. ;r8,r9 (0012) offset when flash comes into buf2. r8 +E0 = myhere
  71. .def SECONDLETTER =r10 ;helpful for debugging
  72. .def FOUNDCOUNTER = r11 ;dealWithWord clicks this if found =1. Counts successful finds in dictionary.
  73. .def STATE = r12
  74. .def STOP = r13 ;stop interpreting line of words
  75. .def BOTTOM = r14 ;have hit the bottom of the dict and not found a match
  76. .def FOUND = r15 ;if found=1 we have a match of Ram word on dictionary
  77. .def spmcsr_val=r18
  78. .def buf_ctr =r19 ;for flash section
  79. ;r20 is length of word in WORD
  80. ;r21 is the flash length of word with immediate bit 8, if any, still there
  81.  
  82. .def vl = r22
  83. .def vh = r23 ; u,v,w,x,y,z are all pointers
  84. .def wl = r24 ;w=r24,25
  85. .def wh = r25
  86.  
  87. .equ TX_PIN = 0
  88. .equ RX_PIN = 2 ; Tx,Rx pins are PB0 and PB2 resp
  89.  
  90. .def serialByteReg = r16
  91. .def rxByte = r18
  92. .def counterReg = r17
  93.  
  94.  
  95.  
  96.  
  97. .eseg
  98. .org $10
  99. .dw HERE, LATEST , $0160 ;these should be burned into tn85 with code
  100.  
  101. .DSEG
  102. .ORG 0x60
  103.  
  104. .equ BUF1LENGTH = 128
  105. .equ eHERE = $0010 ;eeprom adr of system varial eHere
  106. .equ eLATEST = $0012
  107. .equ eVar = $0014 ;holds next ram adr for next var declaration
  108.  
  109. buf1: .byte BUF1LENGTH ;input buffer. Lines max about 125
  110. buf2: .byte BUF1LENGTH ;this fits two flash buffers
  111. ;So buf1=060..0df,buf2=0e0..15f,varspace=160..19f,mystack=1a0..ret stack space that ends at 25f
  112. varSpace: .byte 64 ;might need more than 32 variables
  113. myStackStart: .byte 64 ;currently at $1E0.Meets return stack.
  114.  
  115. .CSEG
  116. .ORG 0x800 ;dictionary starts at 4K (2K words) mark
  117. ;----------------------------------------------------
  118. one_1:
  119. .db 0,0,3, "one" ;code for one
  120. one:
  121. ; rcall stackme
  122. rcall stackme_2
  123. .db 01, 00
  124. ret
  125. ;----------------------------------------------
  126. two_1:
  127. header one_1, 3, "two"
  128. two:
  129. rcall stackme_2
  130. .db 02,00
  131. ret
  132. ;------------------------------------------
  133. dup_1:
  134. header two_1,3,"dup"
  135. dup:
  136. mypop r17
  137. mypop r16
  138. mypush r16
  139. mypush r17
  140. mypush r16
  141. mypush r17
  142.  
  143. ret
  144. ;-------------------------------------------
  145. drop_1:
  146. header dup_1,4,"drop"
  147. drop:
  148. mypop r17
  149. mypop r16 ;TODO what if stack pointer goes thru floor?
  150. ret
  151. ;----------------------------------
  152. swapp_1: ;twp p's becasue assembler recognizes avr opcode swap
  153. header drop_1,5, "swapp"
  154. swapp:
  155. mypop2 r17,r16
  156. mypop2 r19,r18
  157. mypush2 r16,r17
  158. mypush2 r18,r19
  159. ret
  160.  
  161.  
  162. ;-------------------------------------------------
  163. ;shift this later
  164.  
  165. S_1:
  166. ;the EOL token that gets put into end of buf1 to stop parsing
  167. header swapp_1,$81,"S" ;NB always immediate
  168. S: ldi r16,02
  169. mov BOTTOM,r16 ;r14 =2 means a nice stop. EOL without errors
  170. clr STOP
  171. inc STOP ;set time-to-quit flag
  172. takemeout 's'
  173. ret
  174. ;------------------------------------------
  175.  
  176. fetch_1: ;doesn't like label = @-1
  177. ;classic fetch. (adr -- num). Only in RAM
  178. header S_1,1,"@"
  179. fetch:
  180. pushx ;going to use x to point so better save
  181. mypop xh
  182. mypop xl
  183. ld r16,x+
  184. ld r17,x
  185. mypush r16
  186. mypush r17 ; and put them on my stack
  187. popx ;return with x intact and RAM val on my stack
  188. ret
  189. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  190.  
  191. cfetch_1: ;doesn't like label = c@-1
  192. ;classic fetch. (adr -- num). Only in RAM. Do I want y to advance just one byte on mystack
  193. header fetch_1,2,"c@"
  194. cfetch:
  195. pushx ;going to use x to point so better save
  196. mypop xh
  197. mypop xl
  198. ld r16,x+
  199. mypush r16
  200. clr r16
  201. mypush r16 ;so we get a 16 bit val on stack
  202. popx ;return with x intact and RAM val on my stack
  203. ret
  204. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  205.  
  206. store_1: ;classic != "store"(num adr --) . Num is now at cell adr.
  207. header cfetch_1,1,"!"
  208. store:
  209.  
  210. pushx
  211. mypop2 xh,xl ;there goes the address
  212. mypop2 r17,r16 ;there goes the num
  213. st x+,r16
  214. st x,r17 ;num goes to cell with location=adr
  215. popx
  216. ret
  217. ;ddddddddddddddddddddddddddddddddddddddddddddddddddd
  218.  
  219. cstore_1: ;classic c!= "store"(adr 16bit --) . Lower 8 bits Num is now at cell adr.
  220. header store_1,2,"c!"
  221. cstore:
  222. mypop r17 ;there's the high byte. Thrown away
  223. mypop r16 ;there goes the num. Just 8 bits at this stage.
  224. pushx
  225. mypop2 xh,xl ;there goes the address
  226. st x+,r16
  227. ; st x,r17 ;num goes to cell with location=adr
  228. popx
  229. ret
  230. ;------------------------------------
  231.  
  232. star_1: ;classic 16*16 mulitply (n n -- n*n)
  233. header cstore_1,1,"*"
  234. star:
  235. mypop2 r17,r16
  236. mypop2 r19,r18 ;now have both numbers in r16..r19
  237. rcall mpy16s ; multiply them. Result in r18..r21. Overflow in r20,21
  238. mypush2 r18,r19
  239. ret
  240. ;-----------------------------------------
  241.  
  242. slashMod_1: ;classic /MOD (n m -- n/m rem)
  243. header star_1,4,"/mod"
  244. slashMod:
  245. push r13
  246. push r14 ;this is STOP but is used by div16s, so better save it
  247. mypop2 r19,r18 ; that's m
  248. mypop2 r17,r16 ;that's n
  249. rcall div16s ;the the 16 by 16 bit divsion
  250. mypush2 r16,r17 ;answer ie n/m
  251. mypush2 r14,r15 ;remainder
  252. pop r14
  253. pop r13
  254. ret
  255. ;dddddddddddddddddddddddddddddddddddddddddddd
  256.  
  257. plus_1: ;classic + ( n n -- n+n)
  258. header slashMod_1,1,"+"
  259. plus:
  260. mypop2 r17,r16
  261. mypop2 r19,r18
  262. clc
  263. add r16,r18
  264. adc r17,r19
  265. mypush2 r16,r17
  266. ret
  267. ;--
  268.  
  269. minus_1: ;classic - ( n m -- n-m)
  270. header plus_1,1,"-"
  271. minus:
  272. mypop2 r19,r18
  273. mypop2 r17,r16
  274. clc
  275. sub r16,r18
  276. sbc r17,r19
  277. mypush2 r16,r17
  278. ret
  279. ;dddddddddddddddddddddddddddddddddddddddddd
  280.  
  281. pstore_1: ;expects eg. 0003 PORTB P! etc, "output 3 via PORTB"
  282. header minus_1,2, "p!"
  283. pstore:
  284. mypopb ;get rid of PORTB number, not used for tiny85, just one port
  285. mypopa ; this is used. it's eg the 003 = R16 above
  286. out PORTB,r16
  287. ret
  288. ;ddddddddddddddddddddddddd
  289.  
  290. portblabel_1:
  291. header pstore_1,5,"PORTB" ; note caps just a filler that point 0b in stack for dropping
  292. portblabel:
  293. ; Extend later on to include perhaps other ports
  294. ; one:
  295. ; rcall stackme
  296.  
  297. rcall stackme_2
  298. .db $0b, 00
  299. ret
  300. ;---------------------
  301.  
  302. datadirstore_1: ;set ddrb. invioked like this 000f PORTB dd! to make pb0..pb3 all outputs
  303. header portblabel_1, 3, "dd!"
  304. datadirstore:
  305. mypopb ; there goes useless 0b = PORTB
  306. mypopa ; 000f now in r17:16
  307. out DDRB,r16
  308. ret
  309. ;dddddddddddddddddddddddddddddddddddd
  310. ;sbilabel_1 ;set bit in PORTB. Just a kludge at this stage
  311. ;header datadirstore_1,3,"sbi" TODO sort out sbi and delay later. Now get on with compiler.
  312. ;first need store system vars in the eeprom. Arbitrarily 0010 is HERE and 0012 (in eeprom) is LATEST
  313. ;----------------------------------------
  314.  
  315. percentcstore_1: ;(n16 adr16 --) %c! stores stack val LSbyte to eeprom adr
  316. ; eg 10 00 1234 stores 34 to 0010 <--eeprom adr
  317. header datadirstore_1,3,"%c!"
  318. percentcstore:
  319. mypopb ;adr in r18,19
  320. mypopa ;data. Lower byte into r16
  321.  
  322. rcall eewritebyte ;burn it into eeprom
  323. ret
  324. ;----------------------------------
  325.  
  326. percentstore_1: ; (n16 adr16 --) b16 stored at eeprom adr adr16 and adr16+1
  327. header percentcstore_1,2, "e!" ;changed %! to e! PB!!
  328. percentstore:
  329. mypopb ;adr in b=r18,19
  330. mypopa ;n16 into r16,17 as data
  331.  
  332. rcall eewritebyte ;burn low data byte
  333. clc
  334. inc r18
  335. brne outpcs
  336. inc r17 ;sets up adr+1 for next byte
  337. outpcs:
  338. mov r16,r17 ;r16 now conatins hi byte
  339. rcall eewritebyte
  340. ret
  341. ;-------------------------------
  342.  
  343. percentcfetch_1: ;(eepromadr16--char). Fetch eeprom byte at adr on stack
  344. header percentstore_1,3,"%c@"
  345. percentcfetch:
  346. mypopb ;adr now in r18,19
  347. rcall eereadbyte
  348. mypush r16 ; there's the char going on stack. Should be n16? Not n8?
  349. ret
  350. ;-------------------
  351.  
  352. percentfetch_1: ;(adr16--n16) get 16bits at adr and adr+1
  353. header percentcfetch_1,2,"e@" ;PB!! changed from %@
  354. percentfetch:
  355. rcall percentcfetch ;low byte now on stack
  356. inc r18
  357. brcc downpf
  358. inc r19
  359. downpf:
  360. rcall eereadbyte ;there's the high byte hitting the mystack
  361. mypush r16
  362. ret
  363. ;-------------------------------
  364. gethere_1: ; leaves current value of eHERE on stack
  365. header percentfetch_1,7,"gethere"
  366. gethere:
  367. rcall stackme_2
  368. .dw eHere
  369. rcall percentfetch
  370. ret
  371. ;--------------------
  372. getlatest_1: ;leaves current value of latest on stack
  373. header gethere_1,9, "getlatest"
  374. getlatest:
  375. rcall stackme_2
  376. .dw eLATEST ;the address of the latest link lives in eeprom at address 0012
  377. rcall percentfetch ;get the val out of eeprom
  378. ret
  379. ;------------------
  380.  
  381. colon_1: ;classic ":"compiling new word marker
  382. header getlatest_1,1,":"
  383. rcall coloncode
  384. ret
  385. ;----------------------------------------
  386.  
  387. comma_1: ;classic comma. ;Put adr on stack into dictionary at myhere and bump myhere
  388. header colon_1,1,","
  389. comma:
  390. mypopa ;adr now in r16,17
  391. pushz ;save z
  392. movw zl,myhere ;z now pnts to next avail space in dic
  393. st z+,r16
  394. st z+,r17
  395. movw myhere,zl ;so that myhere is updated as ptr
  396. popz ;bring z back
  397. ret
  398. ;------------------------------------
  399.  
  400. tic_1: ;clasic tic('). Put cfa of next word on stack
  401. header comma_1,1, "'"
  402. tic:
  403. rcall word ;point to next word in input
  404. rcall findword ;leaving cfa in z
  405. mypush2 zl,zh
  406. rcall two ;but it's in bytes. Need words so / by 2
  407. rcall slashmod
  408. rcall drop ;that's the remainder dropped
  409. ;now have cfa of word after ' on stack in word-units.
  410. ret
  411. ;-----------------------
  412.  
  413. dummy_1: ;handy debugging place to put a break point
  414. header tic_1,$85,"dummy" ;first immediate word
  415. dummy:
  416. nop
  417. ret
  418. ;--------------------------------
  419.  
  420. compstackme_2_1: ;needed infront of every number compiled
  421. header dummy_1, $0d,"compstackme_2"
  422. compstackme_2:
  423. ldi r16,low(stackme_2)
  424. ldi r17,high(stackme_2)
  425. mypush2 r16,r17 ;in words need to *2 to convert to bytes
  426. rcall two
  427. rcall star
  428. rcall compileme
  429. ret
  430. ;-----------------------------------------
  431.  
  432. double_1: ;whatever's on stack gets doubled. Usful words-->bytes. (n...2*n)
  433. header compstackme_2_1, 6, "double"
  434. double:
  435. mypopa ;stk to r16,17
  436. clc ;going to do shifts
  437. rol r16
  438. rol r17 ;r16,17 now doubled
  439. mypush2 r16,r17
  440. ret ;with 2*n on my stk
  441. ;--------------------------------------
  442.  
  443. semi_1: ;classic ";". Immediate TODO compile a final ret
  444. header double_1,$81,";"
  445. semi:
  446. nop
  447. rcall insertret ;compile ret
  448.  
  449. ;rcall oneBitTime
  450. rcall delay100ms ;trying some waits to give spm time
  451. rcall burnbuf2and3
  452. rcall delay100ms ;want plenty of burn time before doing eeprom work
  453. ;rcall oneBitTime ;ditto
  454. ;rcall oneBitTime ;ditto. Seems to be working. eeprom writes wreck spm's.
  455. rcall rbrac ;after semi w'got back to executing
  456. ; rcall updatevars ;update HERE and LATEST in eeprom
  457. rcall updatevars2 ;Better version. update HERE and LATEST in eeprom
  458.  
  459. ret
  460. ;---------------------------------------
  461.  
  462. rbrac_1: ;classic "]" ,immediate
  463. header semi_1,$81,"]"
  464. rbrac:
  465. clr STATE ;go to executing
  466. ret
  467. ;------------------------------------------------
  468.  
  469. immediate_1: ;classic IMMEDIATE. Redo len byte so MSbit =1
  470. header rbrac_1,$89,"immediate"
  471. immediate:
  472. mypush2 r2,r3 ;this is mylatest. pnts to link of new word
  473. rcall two
  474. rcall plus ;jmp over link to pnt to len byte
  475. pushx ;better save x
  476. mypop2 xh,xl ;x now pnts to len byte
  477. ld r16,x ; and put it into r6
  478. ldi r18,$80 ;mask
  479. or r16,r18 ;eg 03 --> 83 in hex
  480. st x,r16 ;put len byte back
  481. popx ;back where it was
  482. ret ;done now newly created word is immediate
  483. ;-------------------------------------------------
  484.  
  485. emit_1: ;(n8 --) classic emit
  486.  
  487. header immediate_1, 4, "emit"
  488. emit:
  489. rcall emitcode
  490. ret
  491. ;--------------------------------------
  492.  
  493. getline_1: ;rx a line of chars from serialin. eol = $0d
  494. ;this is the line that gets interpreted
  495. header emit_1,7, "getline"
  496. getline:
  497. rcall rxStrEndCR ;write 64 TODO 128? bytes into buf1 from serial io
  498. .ifdef testing
  499. rcall dumpbuf1
  500. .endif
  501. ret ;with buf1 ready to interpret
  502. ;-------------------------------------------------
  503.  
  504. zero_1: ;stack a zero
  505. header getline_1,4,"zero"
  506. zero:
  507. rcall stackme_2
  508. .db 0,0
  509. ret
  510. ;----------------------------------------
  511.  
  512. equal_1: ;(n1 n2 -- flag)
  513. header zero_1,1,"="
  514. equal:
  515. rcall equalcode
  516. ret
  517. ;----------------------------------------
  518.  
  519. zeroequal_1: ;(n -- flag)
  520. header equal_1,2,"0="
  521. zeroequal:
  522. rcall zero
  523. rcall equal
  524. ret
  525. ;-------------------------
  526.  
  527. over_1: ;(n1 n2 --n1 n2 n1)
  528. header zero_1,4,"over"
  529. over:
  530. mypopa
  531. mypopb
  532. mypush2 r18,r19 ;n1
  533. mypush2 r16,r17 ;n2
  534. mypush2 r18,r19 ;n1. so end up with (n1,n2,n1
  535. ret
  536. ;-----------------------------------
  537.  
  538. rot_1: ;classic (n1 n2 n3 -- n2 n3 n1)
  539. header over_1,3,"rot"
  540. rot:
  541. mypopa
  542. push r17
  543. push r16 ;save n3
  544. rcall swapp ; n2 n1
  545. pop r16
  546. pop r17
  547. mypush2 r16,r17 ;n2 n1 n3
  548. rcall swapp ;n2 n3 n1
  549. ret
  550. ;------------------------------------
  551.  
  552. reverse3_1: ;PB (n1 n2 n3 -- n3 n2 n1). Reverses top 3 order
  553. header rot_1,8,"reverse3"
  554. reverse3:
  555. rcall swapp ; n1 n3 n2
  556. rcall rot ; n3 n2 n1
  557. ret ;so (n1 n2 n3 -- n3 n2 n1)
  558. ;--------------------------------------------
  559.  
  560. unrot_1: ;PB (n1 n2 n3 -- n3 n1 n2) Buries topitem two down
  561. header reverse3_1,5,"unrot"
  562. unrot:
  563. rcall reverse3 ; (n1 n2 n3 -- n3 n2 n1)
  564. rcall swapp ; n3 n1 n2
  565. ret
  566. ;--------------------------------
  567.  
  568. andd_1: ;classic AND
  569. header unrot_1,4,"andd" ; two d's otherwise asm problems
  570. andd:
  571. mypopa
  572. mypopb
  573. and r16,r18
  574. and r17,r19
  575. mypush2 r16,r17
  576. ret
  577. ;----------------------------------------
  578.  
  579.  
  580. orr_1: ;classic OR
  581. header andd_1,3,"orr" ; two r's otherwise asm problems
  582. orr:
  583. mypopa
  584. mypopb
  585. or r16,r18
  586. or r17,r19
  587. mypush2 r16,r17
  588. ret
  589. ;------------------------
  590.  
  591. calcjump_1: ;(to from -- opcode)
  592. header orr_1,$88, "calcjump"
  593. calcjump:
  594. rcall calcjumpcode
  595. ret ;with opcode on stack
  596. ;-----------------------
  597.  
  598. begin_1: ;( -- adr) classic BEGIN. Used in most loops
  599. header calcjump_1,$85,"begin"
  600. begin:
  601. rcall stackmyhere ;put next adr on stack. For AGAIN etc
  602. ret ;with adr on stack
  603. ;---------------------------
  604. again_1: ; (to_adr -- ) classic AGAIN cts loop back to BEGIN
  605. header begin_1, $85,"again"
  606. again:
  607. rcall stackmyhere ; to_adr fr_adr
  608. rcall minus ;rel_adr_distance eg $ffdd
  609. rcall stackme_2
  610. .dw $0002
  611. rcall div ;now adr difference in words. Works better.
  612. rcall stackme_2
  613. .dw $0fff ;$ffdd $0fff
  614. rcall andd ;$0fdd eg.
  615. rcall stackme_2
  616. .dw $c000 ;$0fdd $c000
  617. rcall orr ;$cffdd = rjmp back_to_again
  618. rcall one
  619. rcall minus ;t0-fr-1 = the jump part of rjmp
  620. rcall comma ;insert into dic
  621. ret ;with rjmp opcode in next pos in dic
  622. ;------------------------------
  623.  
  624. div_1: ; (n1 n2 -- n1/n2) classic / Could make 2 / faster with >, one right shift
  625. header again_1,1,"/"
  626. div:
  627. rcall slashMod
  628. rcall drop
  629. ret
  630. ;---------------------------------
  631.  
  632. halve_1: ; (n -- n/2) use shifts to halve num on stack. Handy
  633. header div_1,5,"halve"
  634. halve:
  635. mypopa
  636. clc
  637. ror r17
  638. ror r16
  639. mypush2 r16,r17 ;now num on stack has been halved
  640. ret ;with n/2 on stk
  641. ;--------------------
  642.  
  643. dumpb1_1: ;dumpbuf1 to serial
  644. header halve_1,6,"dumpb1"
  645. dumpb1:
  646. rcall dumpbuf1
  647. ret
  648. ;---------------------
  649.  
  650. OK_1: ;classic "ok"
  651. header dumpb1_1,2,"OK"
  652. OK:
  653. ldi r16,'K'
  654. ldi r17,'O'
  655. clr r18
  656. mypush2 r16,r18 ;16bits K
  657. mypush2 r17,r18 ;'O'
  658.  
  659. rcall emitcode
  660. rcall emitcode
  661. ldi r16,'}' ;try this for a cursor prompt
  662. clr r18
  663. mypush2 r16,r18
  664. rcall emitcode
  665.  
  666. ret ;after having emitted "OK" to terminal
  667. ;-------------------------------
  668.  
  669. CR_1: ;output a carriage return. Need $0d too?
  670. header OK_1,2, "CR"
  671. CR:
  672. ldi r16,$0d
  673. mypush r16
  674. clr r16
  675. mypush r16 ;all stack items are 16bits
  676. rcall emitcode
  677. ret ;after sending CR to terminal
  678. ;--------------------------
  679.  
  680. test1_1: ;just need some dic word to try with new serialFill
  681. header CR_1,5,"test1"
  682. test1:
  683. ldi serialByteReg, '*'
  684. rcall sendSerialByte
  685. ldi serialByteReg, 'T'
  686. rcall sendSerialByte
  687. ldi serialByteReg, 'T'
  688. rcall sendSerialByte
  689. ldi serialByteReg, '*'
  690. rcall sendSerialByte
  691. inc r1
  692. inc r1 ;TESTING take out later TODO
  693. ret
  694. ;-------------------------------------------------------
  695. dotS_1: ;classic .S Prints stack items nondestructively
  696. header test1_1,2,".S"
  697. dotS:
  698. rcall dotScode ;TODO check there is *something* on the stack first
  699. ret
  700. ;----------------------------------------------------------
  701.  
  702. dot_1: ;( n16 -- ) classic "." that prints the num on the TOS
  703. header dotS_1,1,"."
  704. dot:
  705. push r16
  706. push r17
  707. mypopa ;TO_stk --> r16r17
  708. rcall d1617 ;print it
  709. pop r17
  710. pop r16
  711. ret
  712. ;-----------------------------
  713.  
  714. Sdot_1: ;( adr16 len16 --) classic S" Prints string from flash
  715. header dot_1,2,"S."
  716. Sdot:
  717. push r16
  718. push r17
  719. push r18
  720. ; pushz
  721. mypopb ;r18 = len
  722. mypop2 zh,zl ;x gets the adr in flash of the string
  723. upsd:
  724. lpm r16,z+ ;get byte from flash
  725. rcall sendserialbyte
  726. ;rcall d16
  727. dec r18
  728. brne upsd ;do this for len times
  729. ; popz
  730. pop r18
  731. pop r17
  732. pop r16
  733. ret
  734. ;----------------------------------------
  735.  
  736. words_1: ;classic words. All words get printed out tot the terminal.
  737. header Sdot_1,5,"words"
  738. words:
  739. rcall wordscode
  740. ret
  741. ;---------------------------------------
  742.  
  743. getvarptr_1: ;leaves current value of varptr,currently at 0012,on stack
  744. header words_1,9, "getvarptr"
  745. getvarptr:
  746. rcall stackme_2
  747. .dw eVar ;the address of the latest link lives in eeprom at address 0012
  748. rcall percentfetch ;get the val out of eeprom
  749. ret ;with next avaialble adr for variable on stack. Lives in buf just below mystack
  750. ;-----------------------------------------------
  751. hereadr_1: ;classic here. Puts adr of eHere on stack. Currently 010 in eeprom
  752. header getvarptr_1,7,"hereadr"
  753. hereadr:
  754. rcall stackme_2
  755. .dw eHere
  756. ret ;with eg 010 on stack, the eeprom adr of eHere
  757. ;-----------------------------------------------------
  758. latestadr_1: ;classic latest. Puts adr of eLatest on stack. Currently 012 in eeprom
  759. header hereadr_1,9,"latestadr"
  760. latestadr:
  761. rcall stackme_2
  762. .dw eLatest
  763. ret ;with eg 012 on stack, the current eeprom adr of elatest
  764. ;----------------------------------
  765.  
  766. varptradr_1: ; Puts adr of eVar on stack. Currently 014 in eeprom
  767. header latestadr_1,9,"varptradr"
  768. varptradr:
  769. rcall stackme_2
  770. .dw eVar
  771. ret ;with eg 014 on stack, the eeprom adr of eVar
  772. ;----------------------------------
  773.  
  774. tx16_1: ;need easier word than "sendserialbyte"
  775. header varptradr_1,4,"tx16"
  776. tx16:
  777. rcall sendserialbyte
  778. ret
  779. ;--------------------------------------------
  780. space_1: ;send a space
  781. header tx16_1,5,"space"
  782. space:
  783. rcall stackme_2
  784. .dw $0020
  785. rcall emitcode
  786. ret ;with space sent
  787. ;------------------------------------------
  788.  
  789. report_1: ;send a report at the start of the prog. Esp for system vars debugging
  790. header space_1,6,"report"
  791. report:
  792. ;.ifdef livetesting
  793. rcall gethere
  794. rcall dot
  795. rcall space
  796. rcall getlatest
  797. rcall dot
  798. rcall space
  799. rcall getvarptr
  800. rcall dot
  801. rcall space
  802. ;.endif
  803. ret
  804. ;----------------------------------------------------
  805.  
  806. variable_1: ;classic variable
  807. header report_1,8,"variable"
  808. variable:
  809. rcall variablecode
  810. takemeout '~'
  811. rcall dumpbuf1
  812. rcall report
  813. takemeout '!'
  814. ret ;with variable's name and ram adr in word in flash dictionary
  815. ;---------------------------
  816.  
  817. depth_1: ;classic size of stack
  818. header variable_1,5,"depth"
  819. depth:
  820. rcall depthcode
  821. ret ;with depth num on stack
  822. ;--------------------------------------
  823.  
  824. rx18_1: ;wait for serial byte from terminal and put it into r18
  825. header depth_1,4,"rx18"
  826. rx18:
  827. rcall getserialbyte ;too long a name, hence this one
  828. ret ;with key typed in r18
  829. ;-------------------------------------
  830. ;LATEST:
  831. getkey_1: ;wait for key to be pressed and put ascii-16 on stack
  832. header rx18_1,6,"getkey"
  833. getkey:
  834. ldi r18,'-'
  835. clr r19
  836. mypush2 r18,r19
  837. rcall emitcode
  838. rcall rx18
  839. clr r19
  840. mypush2 r18,r19
  841. ret ;with key value on stack
  842. ;---------insert AVR Studio stuff here-----------------------------
  843.  
  844.  
  845. ;-------hhhhhhhhhhhhhhhhhhere -------------------------
  846.  
  847. zerobranch_1: ;classic obranch code
  848. header getkey_1,7,"0BRANCH"
  849. zerobranch:
  850. ;( flag --) if flag is 0, do nothing,so as to go onto
  851. ; next instruction which will be a jump. If flag is 1 step over rjmp.
  852. mypopa
  853. or r16,r17 ;any 1's?
  854. breq out0b ;a 0 means get out
  855. ;if here the flag was 1 so we have to skip over next instruction
  856. pop r17
  857. pop r16
  858. clc
  859. inc r16
  860. ; inc r16 ;add one to ret adr. It's in WORDS
  861. brcc down0b
  862. inc r17
  863. down0b:
  864. push r16
  865. push r17
  866. out0b:
  867. ret
  868.  
  869. ;--------------------------------------
  870.  
  871. comp0branch_1: ;needed during IF compling
  872. header zerobranch_1,$0b,"comp0branch"
  873. comp0branch:
  874. ldi r16,low(zerobranch)
  875. ldi r17,high(zerobranch)
  876. mypush2 r16,r17 ;in words need to *2 to convert to bytes
  877. rcall two
  878. rcall star
  879. rcall compileme
  880. ret ;with "rcall 0branch"in next
  881. ;--------------------------
  882.  
  883. if_1: ;classic if
  884. header comp0branch_1,$82,"if"
  885. if:
  886. rcall comp0branch
  887. rcall stkmyhere
  888. rcall stackme_2
  889. .dw 00000
  890. rcall comma
  891. ret ; with (rcall 0branch,0000) in dic and adr of the 0000 in myhere on stack
  892. ;-------------------------
  893.  
  894. endif_1: ;classic "then" used in IF .. THEN, but endif better.
  895. header if_1,$85,"endif"
  896. endif: ;(there_adr -- rjmp code )
  897. rcall dup ;need there_adr twice,calc+ store
  898. rcall stkmyhere ;so we can use calc rjmp --> there - here -1
  899. rcall swapp ;because the jump is put into "there"
  900. rcall calcjumpcode ;(jmpcode now on stack)
  901. rcall swapp ;wrong way round for store !
  902. rcall store ;put jmpcode where there are just 0 placeholders near if
  903. ret ;with all the If..End if statement's codes in right place
  904. ;---------------------------------
  905. LATEST:
  906. delay100ms_1: ;handy; delay for about 0.1 sec = 100 ms
  907. header endif_1,10,"delay100ms"
  908. delay100ms:
  909. ldi r16,60
  910. upd100:
  911. rcall oneBitTime
  912. dec r16
  913. brne upd100
  914. ret ;after about a tenth of a second
  915.  
  916.  
  917.  
  918.  
  919.  
  920.  
  921.  
  922. ;-----------------------------------------------
  923. HERE:
  924. .db "444444444444444444444444444444"
  925. rcall stackme_2
  926. .dw $1234
  927. rcall two
  928. rcall stackme_2
  929. .dw $2468
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.  
  946.  
  947.  
  948.  
  949. ;---------------stackme_2 used to live here----------------------------------
  950.  
  951.  
  952.  
  953.  
  954. ;====================================================================================================
  955.  
  956. .ORG 0
  957. rjmp quit
  958. ; rjmp mainloop
  959. ; rjmp start
  960. ;typein: .db "11bb 0014 %! getlatest",$0d, "0013 %@",0x0d
  961. typein: .db ": myword 0001 if 0005 dup endif ; ", $0d
  962. ;typein: .db " : qqq one two dup one ; qqq " ,$0d
  963. ;"11bb 0014 %! ", $0d ;%! getlatest",$0d, "0013 %@",0x0d
  964. ;" one 0010 00ab %c! 0012 cdef %! 0013 %c@ 0013 %@ 0987 drop ", 0x0d
  965.  
  966. ;stackme dropx onex stackme swap drop",0x0d
  967. ;-----------------------------------------------------
  968. ;start:
  969. quit:
  970. ldi r16, low(RAMEND)
  971. out SPL, r16
  972.  
  973.  
  974. ldi r16,high(RAMEND)
  975. out SPH, r16
  976.  
  977. ldi YL,low(myStackStart)
  978. ldi YH,high(myStackStart)
  979. ldi r16, 0xf9 ;PORTB setup
  980. out DDRB,r16 ;
  981. nop
  982. ldi r16, $ff
  983. out PORTB,r16
  984. .IFDEF testing ;testing = simulating on avrstudio4
  985. nop
  986. rcall burneepromvars ;not needed?
  987.  
  988. .ENDIF
  989. forthloop:
  990. ldi r16, low(RAMEND)
  991. out SPL, r16
  992.  
  993.  
  994. ldi r16,high(RAMEND)
  995. out SPH, r16
  996.  
  997. ldi YL,low(myStackStart)
  998. ldi YH,high(myStackStart)
  999.  
  1000. try:
  1001. ;--------------------test these------------------
  1002. ;rcall dumpbuf1
  1003. ;rcall test_dumpbuf1
  1004. ;rcall waitForDDump
  1005. ;rjmp testOKCR
  1006. ;rjmp test_rxStrEndCR
  1007. ;rcall test1
  1008. ;rjmp test_d16
  1009. ;rjmp test_d1617
  1010. ;rjmp test_dlowR
  1011. ;rjmp test_dhighR
  1012. ;rjmp test_dxyz
  1013. ;rjmp test_depthcode
  1014. ;rjmp test_dotScode
  1015. ;rjmp try
  1016. .ifdef testing
  1017. rcall getline0 ;This is FORTH
  1018.  
  1019. .else
  1020. rcall serialFill
  1021. clr STOP
  1022. clr r1
  1023. clr SECONDLETTER
  1024. clr BOTTOM
  1025. ;rcall dlowR
  1026. .endif
  1027. ;TODO work out why this isn't working with test1
  1028. rcall dumpbuf1 ;TAKE OUT
  1029. rcall interpretLine
  1030. rcall dumpbuf1
  1031. .ifdef testing
  1032. nop
  1033. quithere:
  1034. rjmp quithere ;only want one line interpreted when testing
  1035. .else
  1036. takemeout '('
  1037. rjmp forthloop
  1038. .endif
  1039. ;-------------------------------------------------------
  1040.  
  1041.  
  1042. ;rjmp test_interpretLine
  1043. ;rjmp test_cfetch
  1044. ;rjmp test_store
  1045. ;rjmp test_cstore
  1046. ;rjmp test_mpy16s
  1047. ;rjmp test_mpy16s0
  1048. ;rjmp test_star
  1049. ;rjmp test_div16s
  1050. ;rjmp test_slashMod
  1051. ;rjmp test_Hex4ToBin2
  1052. ;rjmp test_interpretLine
  1053.  
  1054. ;rjmp setupforflashin
  1055. ;rcall coloncode
  1056. ;rjmp test_buf2ToFlashBuffer
  1057. ;rjmp serialTest0
  1058. ;zzz
  1059.  
  1060. stopper: rjmp stopper
  1061. ; rjmp start
  1062. ;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
  1063. mainloop: ;this is forth. This is run continuously. Needs two versions: live and simulation.
  1064. ; rcall quit
  1065. rcall getline0
  1066. rcall interpretLine
  1067. ret
  1068. ;--------------------------------------------------------------
  1069. getline0: ;force a line into buf1 via flash string. Simulates GETLINE
  1070. ldi zl, low(typein<<1)
  1071. ldi zh, high(typein<<1)
  1072. ldi xl, low(buf1)
  1073. ldi xh, high(buf1)
  1074. type0:
  1075. lpm r16,Z+
  1076. st x+,r16
  1077. cpi r16,0x0d ;have we got to the end of the line?
  1078. brne type0
  1079. ret
  1080. ;--------------------------------------------
  1081. ;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20
  1082. ;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char
  1083. word: ;maybe give it a header later
  1084. ld SECONDLETTER, x ;for debugging. TODO. Should be firstletter?
  1085.  
  1086. ld r16,x+ ;get char
  1087.  
  1088. cpi r16,0x20 ;is it a space?
  1089. breq word ;if so get next char
  1090. ;if here we're point to word start. so save this adr in w
  1091. mov r24,xl
  1092. mov r25,xh ;wordstart now saved in w
  1093.  
  1094.  
  1095. clr r20 ;length initially 0
  1096. nextchar:
  1097. inc r20 ;r20 = word length
  1098. ld r16,x+ ;get next char
  1099. cpi r16,0x20
  1100. brne nextchar
  1101. dec r24 ;adjust start of word
  1102. ;if here we've found a word.Starting at w length in r20.x points to space just past word
  1103. ret
  1104. ;----------------------------------------
  1105.  
  1106. 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.
  1107. ; and the word in buf1 is pointed to by w=r24,25. len = r20. Z on entry points to the link. Needs +2 to
  1108. lpm r23,z+
  1109. lpm r22,z+ ;store next link in v=r22,23. z now points to len byte
  1110.  
  1111. startc:
  1112. ;TODO save copy of flash word in r21 and also do masking of immediates
  1113. push r20 ;save length
  1114. lpm r16,Z+ ;length of dictionary word, first entry now in r16
  1115. mov r21,r16 ;copy length-in-flash to r21. May have immediate bit (bit 7)
  1116. andi r16,$0f ;mask off top nibble before comparing
  1117. cp r16,r20 ;same lengths?
  1118. brne outcom ;not = so bail out
  1119. ;if here the words are the same length, what about the rest of the chars.First get x to point to word.
  1120. mov xl,r24
  1121. mov xh,r25 ;x now point to start of buf1 word
  1122. upcom:
  1123. lpm r16,z+
  1124. ld r17,x+ ;get one corresponding char from each word
  1125. cp r16,r17 ;same word?
  1126. brne outcom ;bail out if chars are different
  1127. dec r20 ;count chars
  1128. brne upcom ;still matching and not finished so keep going
  1129. ;if here r20 is 0 so match must have been perfect so FOUND = 1
  1130. clr FOUND
  1131. inc FOUND
  1132. outcom:
  1133. pop r20 ;get old lngth of buf1 word back
  1134. ret
  1135. ;-------------------------------------------
  1136. jmpNextWord: ;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte)
  1137. ; and w = r24,25 contains RAM word start with len in r20
  1138. ;exit with z pointing to next word ready for next COMPARE.
  1139. clc
  1140. rol r22
  1141. rol r23 ;above 3 instructions change word address into byte address by doubling
  1142. movw r30,r22 ;z now points to next word
  1143. ret
  1144. ;-----------------------------------------
  1145.  
  1146. doLatest: ;set up so first jump in dictionary is to top=LATEST and other flags set up.
  1147. ; ldi vl, low(LATEST)
  1148. ; ldi vh, high(LATEST)
  1149. nop
  1150. rcall getlatest ;from eeprom. Now on stack
  1151. mypop2 vh,vl ;
  1152. ; rcall halve
  1153. clr FOUND
  1154. clr BOTTOM ;not yet found the match, not yet at the bottom. Either will stop search.
  1155. clr STOP ;keep parsing words til this goes to a 1
  1156. ret
  1157. ;---------------------------------------------
  1158. interpretLine: ;given line of words in buf one, search for words one by one. Don't do code
  1159. ; or compile at this stage, just find and report that and go into next one.
  1160. ; rcall getline0 ;change later to real getline via terminal
  1161.  
  1162. rcall pasteEOL
  1163. ; clr STOP ;can still be 1 from previous line-inputs
  1164. ;takemeout '2'
  1165.  
  1166. ldi xl, low(buf1)
  1167. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1168. clr FOUNDCOUNTER ;counts finds in line parsing.
  1169.  
  1170. nextWord:
  1171. ;rcall dlowR
  1172.  
  1173. tst STOP
  1174.  
  1175. brne stopLine
  1176. takemeout 'S'
  1177. nop
  1178. rcall word
  1179. takemeout 'w'
  1180. rcall findWord
  1181. takemeout 'F'
  1182. takemeout '.'
  1183. ;not done yet
  1184. rcall dealWithWord ;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le}
  1185. rjmp nextWord
  1186. stopLine:
  1187. takemeout 'E'
  1188. ret
  1189. ;-----------------------------------------------------------------
  1190. findWord:
  1191. rcall doLatest
  1192. nop
  1193. ;rcall dumpbuf1
  1194. ;FIND reg values here.
  1195. rcall considercode
  1196. upjmpf:
  1197. rcall jmpNextWord
  1198. takemeout 'f'
  1199.  
  1200. rcall compare
  1201. tst FOUND
  1202. brne stopsearchf ;if last compare got a match (FOUND=1) then stop searching
  1203. tst vl
  1204. brne upjmpf ;if v=0000 then we've hit the bottom of the dictionary
  1205. tst vh
  1206. brne upjmpf ;not found and not at bottom so keep going
  1207. ;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
  1208. clr BOTTOM
  1209. inc BOTTOM ;exit with FOUND=0 and BOTTOM =1
  1210. stopsearchf:
  1211. nop
  1212. ret
  1213. ;----------------------------
  1214. test_interpretLine:
  1215. rcall interpretLine
  1216. til: rjmp til ;** with r24 pointing to 'S' and FOUND = r15 =1
  1217. ;------------------------------
  1218. dealWithWord: ;come here when it's time to compile or run code
  1219. ;Good debugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just
  1220. ; 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
  1221. ; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match
  1222. ;
  1223. nop
  1224. tst FOUND
  1225. breq notfound
  1226. inc FOUNDCOUNTER
  1227.  
  1228. ;want to hop over filler bytes,0's added to keep codes on even byte boundaries
  1229. ; so if r30 is odd at this stage inc it. odd is lsbit = 1.
  1230. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  1231. rjmp downd
  1232. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  1233. inc r30
  1234. brcc downd
  1235. inc r31 ;add one to z before converting to bytes
  1236. ;have to ask at this point, is the word immediate? If so, bit 7 of r21 will be set.
  1237. downd:
  1238. sbrs r21,7
  1239. rjmp downdw ;not immediate so just go on with STATE test
  1240. rjmp executeme ;yes, immediate so execute every time.
  1241.  
  1242.  
  1243. downdw: tst STATE
  1244. breq executeme
  1245. rcall compilecode
  1246. rjmp outdww
  1247. executeme:
  1248. clc
  1249. ror zh
  1250. ror zl ;put z back into word values
  1251.  
  1252.  
  1253. rcall executeCode
  1254.  
  1255.  
  1256.  
  1257. .MESSAGE "Word found"
  1258. rjmp outdww
  1259. notfound:
  1260. nop
  1261. ; .MESSAGE "Word not found"
  1262. ; clr STOP
  1263. ; inc STOP ;stop parsing line
  1264. takemeout 'n'
  1265. rcall numberh ; word not in dict so must be a number? Form = HHHH
  1266. ;now have to add 3 to x so it points past this word ready not next one
  1267. clc
  1268. inc r26
  1269. inc r26
  1270. inc r26
  1271. brcc outdww
  1272. inc r27 ;but only if overflow
  1273. nop
  1274. outdww:
  1275. ret ;with STOP =1 in not a number
  1276. ;------------------------------------------------------------------------
  1277. pasteEOL: ;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a
  1278. ; special end of line word. When the word is invoked it casues a QUIT back to the waiting for input stage.
  1279. ; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 "
  1280.  
  1281. ldi xl, low(buf1)
  1282. ldi xh, high(buf1) ;pnt to start of buffer
  1283. clr r17
  1284. nxtChar:
  1285. inc r17 ;r17 is counter. Bail out when r17 > BUF1LENGTH
  1286. cpi r17, BUF1LENGTH -3
  1287. breq outProb
  1288. ld r16, x+
  1289. cpi r16, $0d
  1290. brne nxtChar
  1291. ;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it.
  1292. ldi r16,$20
  1293. st -x, r16 ;back up. Then go forward.
  1294. TAKEMEOUT 'p'
  1295. ; ldi r16, ']'
  1296. ldi r16,$20 ;This took about 4 day's work to insert this line. Why is it needed?
  1297. st x+, r16
  1298. ldi r16,'S'
  1299. st x+, r16
  1300. ; ldi r16, '}'
  1301. ; st x+, r16
  1302. ldi r16, $20
  1303. st x, r16
  1304. rjmp outpel
  1305.  
  1306.  
  1307. outProb:
  1308. takemeout 'O'
  1309. nop
  1310. .MESSAGE "Couldn't find $0d"
  1311. outpel:
  1312. ret
  1313.  
  1314. ;-------------------------------------
  1315. executeCode: ;with Z pointing to cfa. Not sure whether to jmp or call
  1316.  
  1317. ijmp
  1318. ret
  1319. ;---------------------------------------
  1320. test_fetch: ;do run thru of @
  1321. rcall getline0 ;change later to real getline via terminal
  1322. rcall pasteEOL
  1323. ldi xl, low(buf1)
  1324. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1325.  
  1326. ldi r16,$62
  1327. mypush r16
  1328. ldi r16,$0
  1329. mypush r16 ;should now have adr $0062 on mystack
  1330. rcall fetch
  1331. tf1:
  1332. rjmp tf1
  1333. ;---------------------------------
  1334. test_cfetch: ;do run thru of @
  1335. rcall getline0 ;change later to real getline via terminal
  1336. rcall pasteEOL
  1337. ldi xl, low(buf1)
  1338. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1339.  
  1340. ldi r16,$62
  1341. mypush r16
  1342. ldi r16,$0
  1343. mypush r16 ;should now have adr $62 on mystack
  1344. rcall cfetch
  1345. tcf1:
  1346. rjmp tcf1
  1347. ;----------------------------
  1348. test_store:
  1349. rcall getline0 ;change later to real getline via terminal
  1350. rcall pasteEOL
  1351. ldi xl, low(buf1)
  1352. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1353. ldi r16,$62
  1354. ldi r17,$0
  1355. mypush2 r16,r17 ;should now have adr $62 on mystack
  1356. ldi r16, $AB
  1357. ldi r17, $CD
  1358. mypush2 r16,r17 ;now have $ABCD on mystack
  1359. rcall store
  1360. ts1:
  1361. rjmp ts1
  1362. ;------------------------
  1363. test_cstore:
  1364. rcall getline0 ;change later to real getline via terminal
  1365. rcall pasteEOL
  1366. ldi xl, low(buf1)
  1367. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1368. ldi r16,$62
  1369. ldi r17,$0
  1370. mypush2 r16,r17 ;should now have adr $62 on mystack
  1371. ldi r16, $AB
  1372. ; ldi r17, $CD
  1373. mypush r16 ;now have $ABCD on mystack
  1374. rcall cstore
  1375.  
  1376. ts11:
  1377. rjmp ts11
  1378. ;Now put arith routines here. Are from AVR200. Just using 16*16 for * but get 32bit result.
  1379.  
  1380.  
  1381. ;***************************************************************************
  1382. ;*
  1383. ;* "mpy16s" - 16x16 Bit Signed Multiplication
  1384. ;*
  1385. ;* This subroutine multiplies signed the two 16-bit register variables
  1386. ;* mp16sH:mp16sL and mc16sH:mc16sL.
  1387. ;* The result is placed in m16s3:m16s2:m16s1:m16s0.
  1388. ;* The routine is an implementation of Booth's algorithm. If all 32 bits
  1389. ;* in the result are needed, avoid calling the routine with
  1390. ;* -32768 ($8000) as multiplicand
  1391. ;*
  1392. ;* Number of words :16 + return
  1393. ;* Number of cycles :210/226 (Min/Max) + return
  1394. ;* Low registers used :None
  1395. ;* High registers used :7 (mp16sL,mp16sH,mc16sL/m16s0,mc16sH/m16s1,
  1396. ;* m16s2,m16s3,mcnt16s)
  1397. ;*
  1398. ;***************************************************************************
  1399.  
  1400. ;***** Subroutine Register Variables
  1401.  
  1402. .def mc16sL =r16 ;multiplicand low byte
  1403. .def mc16sH =r17 ;multiplicand high byte
  1404. .def mp16sL =r18 ;multiplier low byte
  1405. .def mp16sH =r19 ;multiplier high byte
  1406. .def m16s0 =r18 ;result byte 0 (LSB)
  1407. .def m16s1 =r19 ;result byte 1
  1408. .def m16s2 =r20 ;result byte 2
  1409. .def m16s3 =r21 ;result byte 3 (MSB)
  1410. .def mcnt16s =r22 ;loop counter
  1411.  
  1412. ;***** Code
  1413. mpy16s: clr m16s3 ;clear result byte 3
  1414. sub m16s2,m16s2 ;clear result byte 2 and carry
  1415. ldi mcnt16s,16 ;init loop counter
  1416. m16s_1: brcc m16s_2 ;if carry (previous bit) set
  1417. add m16s2,mc16sL ; add multiplicand Low to result byte 2
  1418. adc m16s3,mc16sH ; add multiplicand High to result byte 3
  1419. m16s_2: sbrc mp16sL,0 ;if current bit set
  1420. sub m16s2,mc16sL ; sub multiplicand Low from result byte 2
  1421. sbrc mp16sL,0 ;if current bit set
  1422. sbc m16s3,mc16sH ; sub multiplicand High from result byte 3
  1423. asr m16s3 ;shift right result and multiplier
  1424. ror m16s2
  1425. ror m16s1
  1426. ror m16s0
  1427. dec mcnt16s ;decrement counter
  1428. brne m16s_1 ;if not done, loop more
  1429. ret
  1430. ;----------------------------------------------------------
  1431. ;***** Multiply Two Signed 16-Bit Numbers (-12345*(-4321))
  1432. test_mpy16s:
  1433. ldi mc16sL,low(-12345)
  1434. ldi mc16sH,high(-12345)
  1435. ldi mp16sL,low(-4321)
  1436. ldi mp16sH,high(-4321)
  1437. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1438. ;=$032df219 (53,342,745)
  1439. tmpy: rjmp tmpy
  1440.  
  1441. test_mpy16s0:
  1442. ldi mc16sL,low(123)
  1443. ldi mc16sH,high(123)
  1444. ldi mp16sL,low(147)
  1445. ldi mp16sH,high(147)
  1446. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1447. tmpy0: rjmp tmpy0
  1448. ;-----------------------
  1449. test_star:
  1450. ldi r16,-$7b
  1451. mypush r16
  1452. ldi r16,$00
  1453. mypush r16 ;that's decimal 123 on stack
  1454. ldi r16,$93
  1455. mypush r16
  1456. ldi r16,$00
  1457. mypush r16 ; and thats dec'147
  1458. rcall star
  1459. tsr: rjmp tsr
  1460.  
  1461. ;--------------------------
  1462. ;***************************************************************************
  1463. ;*
  1464. ;* "div16s" - 16/16 Bit Signed Division
  1465. ;*
  1466. ;* This subroutine divides signed the two 16 bit numbers
  1467. ;* "dd16sH:dd16sL" (dividend) and "dv16sH:dv16sL" (divisor).
  1468. ;* The result is placed in "dres16sH:dres16sL" and the remainder in
  1469. ;* "drem16sH:drem16sL".
  1470. ;*
  1471. ;* Number of words :39
  1472. ;* Number of cycles :247/263 (Min/Max)
  1473. ;* Low registers used :3 (d16s,drem16sL,drem16sH)
  1474. ;* High registers used :7 (dres16sL/dd16sL,dres16sH/dd16sH,dv16sL,dv16sH,
  1475. ;* dcnt16sH)
  1476. ;*
  1477. ;***************************************************************************
  1478.  
  1479. ;***** Subroutine Register Variables
  1480.  
  1481. .def d16s =r13 ;sign register
  1482. .def drem16sL=r14 ;remainder low byte
  1483. .def drem16sH=r15 ;remainder high byte
  1484. .def dres16sL=r16 ;result low byte
  1485. .def dres16sH=r17 ;result high byte
  1486. .def dd16sL =r16 ;dividend low byte
  1487. .def dd16sH =r17 ;dividend high byte
  1488. .def dv16sL =r18 ;divisor low byte
  1489. .def dv16sH =r19 ;divisor high byte
  1490. .def dcnt16s =r20 ;loop counter
  1491.  
  1492. ;***** Code
  1493.  
  1494. div16s: ;push r13 ;PB !!
  1495. ;push r14 ;PB !!
  1496. mov d16s,dd16sH ;move dividend High to sign register
  1497. eor d16s,dv16sH ;xor divisor High with sign register
  1498. sbrs dd16sH,7 ;if MSB in dividend set
  1499. rjmp d16s_1
  1500. com dd16sH ; change sign of dividend
  1501. com dd16sL
  1502. subi dd16sL,low(-1)
  1503. sbci dd16sL,high(-1)
  1504. d16s_1: sbrs dv16sH,7 ;if MSB in divisor set
  1505. rjmp d16s_2
  1506. com dv16sH ; change sign of divisor
  1507. com dv16sL
  1508. subi dv16sL,low(-1)
  1509. sbci dv16sL,high(-1)
  1510. d16s_2: clr drem16sL ;clear remainder Low byte
  1511. sub drem16sH,drem16sH;clear remainder High byte and carry
  1512. ldi dcnt16s,17 ;init loop counter
  1513.  
  1514. d16s_3: rol dd16sL ;shift left dividend
  1515. rol dd16sH
  1516. dec dcnt16s ;decrement counter
  1517. brne d16s_5 ;if done
  1518. sbrs d16s,7 ; if MSB in sign register set
  1519. rjmp d16s_4
  1520. com dres16sH ; change sign of result
  1521. com dres16sL
  1522. subi dres16sL,low(-1)
  1523. sbci dres16sH,high(-1)
  1524. d16s_4: ;pop r14 ;PB!!
  1525. ;pop r13 ;PB!!
  1526. ret ; return
  1527. d16s_5: rol drem16sL ;shift dividend into remainder
  1528. rol drem16sH
  1529. sub drem16sL,dv16sL ;remainder = remainder - divisor
  1530. sbc drem16sH,dv16sH ;
  1531. brcc d16s_6 ;if result negative
  1532. add drem16sL,dv16sL ; restore remainder
  1533. adc drem16sH,dv16sH
  1534. clc ; clear carry to be shifted into result
  1535. rjmp d16s_3 ;else
  1536. d16s_6: sec ; set carry to be shifted into result
  1537. rjmp d16s_3
  1538.  
  1539. ;-----------------------------------------------
  1540.  
  1541. test_div16s:
  1542. ;***** Divide Two Signed 16-Bit Numbers (-22,222/10)
  1543. ldi dd16sL,low(-22222)
  1544. ldi dd16sH,high(-22222)
  1545. ldi dv16sL,low(10)
  1546. ldi dv16sH,high(10)
  1547. rcall div16s ;result: $f752 (-2222)
  1548. ;remainder: $0002 (2)
  1549.  
  1550. forever:rjmp forever
  1551. ;----------------------------------
  1552. test_slashMod:
  1553. ldi r16,$12
  1554. mypush r16
  1555. ldi r16,$34
  1556. mypush r16
  1557. ldi r16,$56 ;NB this is $3412 not $1234
  1558. mypush r16
  1559. ldi r16,$00
  1560. mypush r16
  1561. rcall slashMod ;$3412 / $56 = $9b rem 0 works
  1562. tslm: rjmp tslm
  1563.  
  1564. ;---------------------------------------
  1565. ;From http://www.avr-asm-tutorial.net/avr_en/calc/CONVERT.html#hex2bin
  1566. ; Hex4ToBin2
  1567. ; converts a 4-digit-hex-ascii to a 16-bit-binary
  1568. ; In: Z points to first digit of a Hex-ASCII-coded number
  1569. ; Out: T-flag has general result:
  1570. ; T=0: rBin1H:L has the 16-bit-binary result, Z points
  1571. ; to the first digit of the Hex-ASCII number
  1572. ; T=1: illegal character encountered, Z points to the
  1573. ; first non-hex-ASCII character
  1574. ; Used registers: rBin1H:L (result), R0 (restored after
  1575. ; use), rmp
  1576. ; Called subroutines: Hex2ToBin1, Hex1ToBin1
  1577.  
  1578. .def rBin1H =r17
  1579. .def rBin1L = r16
  1580. .def rmp = r18
  1581. ;
  1582. Hex4ToBin2:
  1583. clt ; Clear error flag
  1584. rcall Hex2ToBin1 ; convert two digits hex to Byte
  1585. brts Hex4ToBin2a ; Error, go back
  1586. mov rBin1H,rmp ; Byte to result MSB
  1587. rcall Hex2ToBin1 ; next two chars
  1588. brts Hex4ToBin2a ; Error, go back
  1589. mov rBin1L,rmp ; Byte to result LSB
  1590. sbiw ZL,4 ; result ok, go back to start
  1591. Hex4ToBin2a:
  1592. ret
  1593. ;
  1594. ; Hex2ToBin1 converts 2-digit-hex-ASCII to 8-bit-binary
  1595. ; Called By: Hex4ToBin2
  1596. ;
  1597. Hex2ToBin1:
  1598. push R0 ; Save register
  1599. rcall Hex1ToBin1 ; Read next char
  1600. brts Hex2ToBin1a ; Error
  1601. swap rmp; To upper nibble
  1602. mov R0,rmp ; interim storage
  1603. rcall Hex1ToBin1 ; Read another char
  1604. brts Hex2ToBin1a ; Error
  1605. or rmp,R0 ; pack the two nibbles together
  1606. Hex2ToBin1a:
  1607. pop R0 ; Restore R0
  1608. ret ; and return
  1609. ;
  1610. ; Hex1ToBin1 reads one char and converts to binary
  1611. ;
  1612. Hex1ToBin1:
  1613. ld rmp,z+ ; read the char
  1614. subi rmp,'0' ; ASCII to binary
  1615. brcs Hex1ToBin1b ; Error in char
  1616. cpi rmp,10 ; A..F
  1617. brcs Hex1ToBin1c ; not A..F
  1618. cpi rmp,$30 ; small letters?
  1619. brcs Hex1ToBin1a ; No
  1620. subi rmp,$20 ; small to capital letters
  1621. Hex1ToBin1a:
  1622. subi rmp,7 ; A..F
  1623. cpi rmp,10 ; A..F?
  1624. brcs Hex1ToBin1b ; Error, is smaller than A
  1625. cpi rmp,16 ; bigger than F?
  1626. brcs Hex1ToBin1c ; No, digit ok
  1627. Hex1ToBin1b: ; Error
  1628. sbiw ZL,1 ; one back
  1629. set ; Set flag
  1630. Hex1ToBin1c:
  1631. ret ; Return
  1632. ;--------------------------------------
  1633. test_Hex4ToBin2:
  1634. pushz
  1635. ldi zl,$60
  1636. clr zh ;z now points to start of buf1
  1637. ldi r16,'0'
  1638. st z+,r16
  1639. ldi r16,'f'
  1640. st z+,r16
  1641. ldi r16,'2'
  1642. st z+,r16
  1643. ldi r16,'3'
  1644. st z+,r16
  1645. ldi zl,$60
  1646. clr zh ;z now points back to start of buf1
  1647. rcall Hex4ToBin2
  1648. popz
  1649. th4: rjmp th4
  1650. ;-------------------------------------
  1651. numberh: ;word not in dictionary. Try to convert it to hex.
  1652. pushz ;algorithm uses z, pity
  1653. movw zl,r24 ;r4,25 = w holds start of current word
  1654. ;z now points eg to '12ab'start. If t=0 then it coverts to real hex
  1655. rcall hex4ToBin2 ;try to convert
  1656. ;above call needs 4 hex digits to emerge with t=0 and binary in r16,17
  1657. ;want this. If t=0 stack r16,17 and carry on interpreting, else emerge with
  1658. ; t=1 and zpointing to first problem char
  1659. brtc gotHex
  1660. ; if here there's a problem that z is pointing to. Bail out of interpret line
  1661. clr STOP
  1662. inc STOP
  1663. ;TODO put routine here that notes the word can't be excuted and it's
  1664. ; not a number. So output ramstring starting at adr = r24,25 and len in r20
  1665. rjmp outnh
  1666.  
  1667. gotHex: ;sucess.Real hex in r16,17
  1668. mypush2 r16,r17 ; so push num onto mystack
  1669. ;maybe we're compiling. If so, push num into dic preceded by a call to stackme_2
  1670. tst STATE
  1671. breq outnh ;STATE =0 means executing
  1672. ; rcall tic
  1673. ; .db "stackme_2" ;has to be in dic before a number. cfa of stackme_2 on stack
  1674. rcall compstackme_2
  1675. ; rcall compileme ;insert "rcall stackme_2"opcode into dic
  1676. rcall comma ;there's the number going in
  1677.  
  1678. outnh:
  1679. popz ; but will it be pointing to "right"place in buf1? Yes now OK
  1680.  
  1681. ret
  1682. ; numberh not working fully, ie doesn't point to right place after action.
  1683. ; also no action if not a number? DONE better save this first.
  1684. ;---------------------------------
  1685. ;eeroutines
  1686. eewritebyte: ;write what's in r16 to eeprom adr in r18,19
  1687. sbic EECR,EEPE
  1688. rjmp eewritebyte ;keep looping til ready to write
  1689. ;if here the previous write is all done and we can write the next byte to eeprom
  1690. out EEARH,r19
  1691. out EEARL,r18 ;adr done
  1692. out EEDR,r16 ;byte in right place now
  1693. sbi EECR,EEMPE
  1694. sbi EECR,EEPE ;last 2 instruc write eprom. Takes 3.4 ms
  1695. ret
  1696. ;test with %!
  1697. ;---------------------------------
  1698. eereadbyte: ; read eeprom byte at adr in r18,19 into r16
  1699. ; Wait for completion of previous write
  1700. sbic EECR,EEPE
  1701. rjmp eereadbyte
  1702. ; Set up address (r18:r17) in address register
  1703. out EEARH, r19
  1704. out EEARL, r18
  1705. ; Start eeprom read by writing EERE
  1706. sbi EECR,EERE
  1707. ; Read data from data register
  1708. in r16,EEDR
  1709. ret
  1710. ;------------------------------
  1711. setupforflashin: ;using here etc get appropriate page, offset,myhere values.
  1712. ; ldi r16,low(HERE)
  1713. ; ldi r17,high(HERE) ;get here, but from eeprom better?
  1714. ; mypush2 r16,r17
  1715.  
  1716. ;above was a problem replace with one line below
  1717. rcall gethere ;HERE = eg 0a12.Now on stk.Comes from eepprom each time
  1718.  
  1719. rcall stackme_2
  1720. .dw 0002
  1721. rcall star ;now have current HERE in bytes in flash. But what is myhere?
  1722. rcall stackme_2
  1723. .db $0040 ;64 bytes per page
  1724. rcall slashMod
  1725. ;offset on top pagenum under. eg pg 0047, offset 0012
  1726. mypop2 r9,r8 ;store offset (in bytes)
  1727. rcall stackme_2
  1728. .db $0040
  1729. rcall star ;pgnum*64 = byte adr of start of flash page
  1730. mypop2 r7,r6
  1731. mypush2 r8,r9 ;push back offset
  1732. rcall stackme_2
  1733. .dw buf2
  1734. nop
  1735. ;at this stage we have offset in r8,r9 (0012). Also byte adr of flash page
  1736. ; start in r6,r7.(11c0) Stk is (offset buf2Start --) (0012 00E0 --). Need to
  1737. ; add these two together to get myhere, the pointer to RAM here position.
  1738. rcall plus ;add offset to buf2 start to get myhere (00f2)
  1739. ; put my here in r4,r5 for time being.
  1740. mypop2 r5,r4 ;contains eg 00f2 <--myhere
  1741. pushz ;going to use z so save it
  1742. movw zl,r6 ;r6,7 have byte adr of flsh pg strt
  1743. pushx ;save x
  1744. ldi xl,low(buf2)
  1745. ldi xh,high(buf2) ;point x to start of buf2
  1746. ldi r18,128 ;r18=ctr. Two flash pages = 128 bytes
  1747. upflash:
  1748. lpm r16,z+ ;get byte from flash page
  1749. st x+, r16 ; and put into buf2
  1750. dec r18
  1751. brne upflash
  1752. ;done. Now have two flash pages in ram in buf2. Myhere points to where next
  1753. ; entry will go. Where's page num?
  1754. popx
  1755. popz ;as if nothing happened
  1756.  
  1757.  
  1758. ret
  1759.  
  1760.  
  1761.  
  1762. ;outsufi: rjmp outsufi
  1763. ;-----------------------------------
  1764. burneepromvars: ;send latest versions of eHERE and eLATEST to eeprom
  1765. ldi r16,low(HERE)
  1766. ldi r17,high(HERE)
  1767. mypush2 r16,r17
  1768. ;up top we have .equ eHERE = $0010
  1769. ldi r16,low(eHERE)
  1770. ldi r17,high(eHERE)
  1771. mypush2 r16,r17
  1772. ;now have n16 eadr on stack ready for e!
  1773. rcall percentstore
  1774.  
  1775. ;send latest versions of eLATEST to eeprom
  1776. ldi r16,low(LATEST)
  1777. ldi r17,high(LATEST)
  1778. mypush2 r16,r17
  1779. ;up top we have .equ eLATEST = $0010
  1780. ldi r16,low(eLATEST)
  1781. ldi r17,high(eLATEST)
  1782. mypush2 r16,r17
  1783. ;now have n16 eadr on stack ready for e!
  1784. rcall percentstore
  1785. ret
  1786. ;-------------------------------------------
  1787. coloncode: ;this is the classic colon defining word.
  1788. rcall setupforflashin ;get all the relevant vars and bring in flash to buf2
  1789. rcall dxyz
  1790. rcall relinkcode ; insert link into first cell
  1791. rcall create ;compile word preceeded by length
  1792. rcall leftbrac ;set state to 1, we're compiling
  1793. takemeout 'c'
  1794. ;rcall report
  1795. takemeout 'c'
  1796. ret ;now every word gets compiled until we hit ";"
  1797. ;-------------------------
  1798. relinkcode: ;put LATEST into where myhere is pointing and update ptr = myhere
  1799. ;also create mylatest
  1800. rcall getlatest ;now on stack
  1801. mypopa ;latest in r16,17
  1802. pushz ;better save z
  1803. movw mylatest,myhere ;mylatest <-- myhere
  1804. movw zl,myhere ;z now points to next available spot in buf2
  1805. st z+,r17 ;problem. Don't work unless highbye first in mem.Why?
  1806. st z+,r16 ;now have new link in start of dic word
  1807. movw myhere,zl ;update myhere to point to length byte. (Not yet there.)
  1808. popz ;restore z
  1809. ret
  1810. ;-------------------------------------------------
  1811. create: ;put word after ":" into dictionary, aftyer link, preceeded by len
  1812. rcall word ;start with x pnting just after ":".End with len in r20, x pointing to
  1813. ; space just after word and start of word in w=r24,25
  1814. pushz ;save z. It's going to be used on ram dictionary
  1815. movw zl,myhere ;z now pnts to next spot in ram dic
  1816. st z+,r20 ; put len byte into ram dic
  1817. mov r18,r20 ;use r18 as ctr, don't wreck r20
  1818. pushx ;save x. It's going to be word ptr in buf1
  1819. movw xl,wl ;x now points to start of word. Going to be sent to buf2
  1820. sendbytes:
  1821. ld r16,x+ ;tx byte from buf1 to
  1822. st z+,r16 ; buf2
  1823. dec r18 ;repeat r20=r18=len times
  1824. brne sendbytes
  1825.  
  1826. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  1827. rjmp downcr
  1828. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  1829. clr r16
  1830. st z+,r16 ;insert padding byte
  1831. ;inc r30
  1832. ;brcc downcr
  1833. ;inc r31 ;add one to z before converting to bytes
  1834.  
  1835. downcr:
  1836. movw myhere,zl ;myhere now points to beyond word in dic
  1837. popx
  1838. popz
  1839. ret ;with word in dic
  1840. ;----------------------------------------------
  1841. leftbrac: ;classic turn on compiling
  1842. clr STATE
  1843. inc STATE ;state =1 ==> now compiling
  1844. ret
  1845. ;------------------------
  1846. compilecode: ;come here with STATE =1 ie compile, not execute. Want to put
  1847. ; eg rcall dup in code in dictionary but not to execute dup. If here
  1848. ; z points to byte address of word
  1849. mypush2 zl,zh
  1850. compileme:
  1851. mypush2 myhere,r5 ;push ptr to RAM dic
  1852. ;next is entry point for eg ' stackme2 already on stack and have to compile
  1853.  
  1854. ldi r16,low(buf2)
  1855. ldi r17,high(buf2) ;start of buf that conatins flash pg in RAM
  1856. mypush2 r16,r17
  1857. rcall minus ; myhere - buf2-start = offset in page
  1858. mypush2 SOFPG,r7 ;push start of flash page address
  1859. rcall plus ;SOFPG + offset = adr of next rcall in dic
  1860. ;if here we have two flash addresses on the stack. TOS = here. Next is there.
  1861. ;want to insert code for "rcall there w"hen I'm at here. eg current debugging indicates
  1862. ; here = $11EB and there is $1012 (cfa of "two"). First compute
  1863. ; relative branch "there - here -2". Then fiddle this val into the rcall opcode
  1864. rcall minus ;that;s there - here. Usu negative.
  1865. ;I got fffffffff..ffe27 for above vals. First mask off all those f's
  1866. rcall two ;stack a 2
  1867. rcall minus ;now have there-here -2 = fe24. When there,here in bytes.
  1868. mypopa ;bring fe26 into r16,17
  1869. clc
  1870. ror r17
  1871. ror r16 ;now a:= a/2
  1872. ldi r18,$ff
  1873. ldi r19,$0f ;mask
  1874. and r16,r18
  1875. and r17,r19
  1876. ; mypush2 r16,r17 ;now fe26 --> 0e26
  1877. ;the rcall opcode is Dxxx where xxx is the branch
  1878. ; mypopa ;bring fe26 into r16,17
  1879. ldi r19, $d0 ;mask
  1880. or r17,r19
  1881. mypush2 r16,r17 ;now have $de26 on stack which is (?) rcall two
  1882. rcall comma ;store this opcode into dic. myhere is ptr
  1883. ret
  1884. ;---------------------------
  1885. stackme_2: ;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack
  1886. ; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack.
  1887. pop r17
  1888. pop r16 ; they now contain eg 0x0804 which contain the 16bit num
  1889. movw zl,r16 ;z now points to cell that cobtains the number
  1890. clc
  1891. rol zl
  1892. rol zh ;double word address for z. lpm coming up
  1893.  
  1894.  
  1895.  
  1896. lpm r16,z+
  1897. lpm r17,z+ ;now have 16bit number in r16,17
  1898.  
  1899. st y+,r16
  1900. st y+, r17 ;mystack now contains the number
  1901.  
  1902. clc
  1903. ror zh
  1904. ror zl ;halve the z pointer to step past the number to return at the right place
  1905.  
  1906. push zl
  1907. push zh
  1908.  
  1909. ret
  1910. ;------------------------------flash write section--------------------
  1911.  
  1912. do_spm:
  1913. ;lds r16,SPMCSR
  1914. in r16,SPMCSR
  1915. andi r16,1
  1916. cpi r16,1
  1917. breq do_spm
  1918. mov r16,spmcsr_val
  1919. out SPMCSR,r16
  1920. spm
  1921. ret
  1922. ;-------------------------------------------------------------------
  1923. buf2ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1924. push r30 ;save for later spm work.
  1925. push r19
  1926. push xl
  1927. push xh ;used as buf_ctr but may interfere with other uses
  1928. ldi XL,low(buf2) ;X pnts to buf1 that contains the 64 bytes.
  1929. ldi XH, high(buf2)
  1930. ;assume Z is already pointing to correct flash start of page.
  1931. flashbuf:
  1932. ldi buf_ctr,32 ;send 32 words
  1933. sendr0r1:
  1934. ld r16, x+ ;get first byte
  1935. mov r0,r16 ; into r0
  1936. ld r16, x+ ; and get the second of the pair into
  1937. mov r1,r16 ; into r1
  1938. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1939. rcall do_spm ;that's r0,r1 gone in.
  1940. inc r30
  1941. inc r30
  1942. dec buf_ctr ;done 32 times?
  1943. brne sendr0r1
  1944. pop xh
  1945. pop xl
  1946. pop r19 ;dont need buf_ctr any more.
  1947. pop r30 ;for next spm job
  1948.  
  1949. ret
  1950. ;--------------------------------------------------------------------------
  1951. ;TODO just have 1 burn routine with buf different
  1952. buf3ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1953. push r30 ;save for later spm work.
  1954. push r19 ;used as buf_ctr but may interfere with other uses
  1955. push xl
  1956. push xh
  1957. ldi XL,low(buf2+64) ;X pnts to buf1 that contains the 64 bytes.
  1958. ldi XH, high(buf2+64)
  1959. ;assume Z is already pointing to correct flash start of page.
  1960. rjmp flashbuf
  1961. ldi buf_ctr,32 ;send 32 words
  1962. sendr0r3:
  1963. ld r16, x+ ;get first byte
  1964. mov r0,r16 ; into r0
  1965. ld r16, x+ ; and get the second of the pair into
  1966. mov r1,r16 ; into r1
  1967. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1968. rcall do_spm ;that's r0,r1 gone in.
  1969. inc r30
  1970. inc r30
  1971. dec buf_ctr ;done 32 times?
  1972. brne sendr0r3
  1973. pop r19 ;dont need buf_ctr any more.
  1974. pop r30 ;for next spm job
  1975. ret
  1976.  
  1977. erasePage: ; assume Z points to start of a flash page. Erase it.
  1978. ldi spmcsr_val,0x03 ;this is the page erase command
  1979. rcall do_spm
  1980. ret
  1981. ;------------------------------------------------------------------
  1982. writePage:
  1983. ldi spmcsr_val, 0x05 ;command that writes temp buffer to flash. 64 bytes
  1984. rcall do_spm
  1985. nop ; page now written. z still points to start of this page
  1986. ret
  1987. ;---------------------------------------------------------------
  1988. test_buf2ToFlashBuffer: ;(adr_flashbufstartinBytes -- )
  1989. ; rcall fillBuf
  1990. ; ldi ZH, $10
  1991. ; ldi ZL,$c0 ;z=$01c0. Start of page 67.
  1992. rcall gethere
  1993. rcall double ;want bytes not words for flash adr
  1994. mypopa ;flashPgStart byte adr now in r16,17
  1995.  
  1996.  
  1997. movw zl,r16 ;z <--start of flash buffer
  1998. rcall erasePage
  1999. rcall buf2ToFlashBuffer
  2000. rcall writePage
  2001. herettt:
  2002. rjmp herettt
  2003. ;----------------------
  2004. ; y2. Come here from ";". The pair r6,r7 point to start of flash pg (bytes)
  2005. burnbuf2and3:
  2006. takemeout 'U'
  2007. ldi r16, 'U'
  2008. clr r17
  2009. mypush2 r16,r17
  2010. rcall emitcode
  2011. rcall dlowR
  2012. movw zl,r6 ;z now pnts to start of flash buf
  2013. rcall dxyz ;having !!! PROBS take out later
  2014. rcall erasePage
  2015. rcall buf2ToFlashBuffer
  2016. rcall writePage
  2017. ;now going to burn next ram buffer to next flash page. Bump Z by 64 bytes.
  2018. adiw zh:zl,63 ;z now points to start of next flash buffer
  2019. lpm r16,z+ ;advance z pointer by one.adiw only lets max of 63 to be added.
  2020. ;now z points to start of next 64 byte buffer. Time to put buf3 into it.
  2021. rcall erasePage
  2022. rcall buf3ToFlashBuffer
  2023. rcall writePage
  2024. ret
  2025. heret:
  2026. rjmp heret
  2027. ;-------------------------------------------------------------
  2028. updatevars: ;after doing a colon def we have to update sys vars
  2029. ;TODO new version of LATEST is just old version of HERE.
  2030. ;TODO rplace all this code with updatevars2
  2031. ; just shif HERE into LATEST in eeprom to update. Gen. tidy required.
  2032. mypush2 r4,r5 ;put myhere on stack (E8)
  2033. ldi r16,low(buf2)
  2034. ldi r17,high(buf2)
  2035. mypush2 r16,r17 ;start of buf2 on stack (E0)
  2036. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  2037. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  2038. rcall plus ;SOFG + offset = new HERE
  2039. ;now put also on stack new version of LATEST
  2040. mypush2 r2,r3 ;that's mylatest on stack
  2041. ldi r16,low(buf2)
  2042. ldi r17,high(buf2)
  2043. mypush2 r16,r17 ;start of buf2 on stack (E0)
  2044. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  2045. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  2046. rcall plus ;SOFG + offset = new LATEST
  2047. ; now have both LATEST (tos) and HERE on stack. Burn these into eeprom
  2048. ;up top we have .equ eLATEST = $0010
  2049. ;But it's too big. In bytes and causing probs. Solution=covert to words
  2050. rcall halve
  2051. ldi r16,low(eLATEST)
  2052. ldi r17,high(eLATEST)
  2053. mypush2 r16,r17
  2054. ;now have n16 eadr on stack ready for e!
  2055. rcall percentstore
  2056. ; TODO the value for HERE is prob in bytes too. Convert to words.
  2057. ;up top we have .equ eLATEST = $0010
  2058. ldi r16,low(eHERE)
  2059. ldi r17,high(eHERE)
  2060. mypush2 r16,r17
  2061. ;now have n16 eadr on stack ready for e!
  2062. rcall halve ;TODO check this
  2063. rcall percentstore
  2064. ret ;with stack clear and new vals for HERE and LATEST in eeprom
  2065. ;----------
  2066. ;;;;;;;;;;;;;;;;;;;;;;;;;;;Now serial stuff starts;;;;;;;;;;;;;;;;;;;;;;;;;
  2067. halfBitTime: ;better name for this delay. Half of 1/600
  2068. ;myDelay1200:
  2069. ;ldi r21,13 ; 13 works for m328 at 16Mhz
  2070. push r20
  2071. push r21
  2072. ldi r21,7 ;try 7 for tiny85 at 8Hmz
  2073. ldi r20,130 ;r20,21 at 130,7 give 833uS. Good for 600baud at 8Mhz
  2074. starthbt:
  2075. inc r20
  2076. nop
  2077. brne starthbt
  2078. dec r21
  2079. brne starthbt
  2080. pop r21
  2081. pop r20
  2082. ret
  2083. ;--------------------------------------------------
  2084. oneBitTime:
  2085. rcall halfBitTime
  2086. rcall halfBitTime
  2087. ret
  2088. ;-------------------------------------------------
  2089. sendAZero:
  2090. ;output 0 on Tx pin
  2091. cbi PORTB,TX_PIN ; send a zero out PB0
  2092. ret
  2093. ;-----------------------------------------------------
  2094.  
  2095. sendAOne:
  2096. ;output 1 on Tx pin
  2097. sbi PORTB,TX_PIN ; send a zero out PB0
  2098. ret
  2099. ;-----------------------------------------------------
  2100. sendStartBit:
  2101. ; send a 0 for one bit time
  2102. rcall sendAZero
  2103. rcall oneBitTime
  2104. ret
  2105. ;-------------------------------------------------------
  2106. sendNextDataBit: ;main output routine for serial tx
  2107. lsr serialByteReg ;push high bit into carry flag then inspect it
  2108. ;originally did lsl but found lsb first.
  2109. brcc gotzero ;if it's a 0 do nothing
  2110. rcall sendAOne ;must have been a 1 in carry
  2111. rjmp down
  2112. gotzero:
  2113. rcall sendAZero ;if here carry was a zero
  2114. down:
  2115. rcall oneBitTime ;so that 1 or 0 lasts 1/600 sec
  2116. ret
  2117. ;-------------------------------------------------------------
  2118. send8DataBits: ; send all bits in serialByteReg
  2119. ldi counterReg,8 ;8 data bits
  2120. sendBit:
  2121. rcall sendNextDataBit
  2122. dec counterReg
  2123. brne sendBit
  2124. ret
  2125. ;--------------------------------------------------------
  2126. sendStopBit:
  2127. ; send a 1 for one bit time
  2128. rcall sendAOne
  2129. rcall oneBitTime
  2130. ret
  2131. ;--------------------------------------------------------
  2132. sendSerialByte: ;main routine. Byte in serialByteReg = r16
  2133. .ifdef testing
  2134. mov r0, r16
  2135. .else
  2136. push counterReg
  2137. rcall sendStartBit
  2138. rcall send8DataBits
  2139. rcall sendStopBit
  2140. rcall sendStopBit ;two stops
  2141. pop counterReg
  2142. .endif
  2143. ret
  2144. ;**************************************************************
  2145. serialTest0: ;output series of 'AAAA..'s
  2146. ldi serialByteReg, 0x43 ;0x41
  2147. rcall sendSerialByte
  2148. rcall oneBitTime ; take a rest
  2149. ldi r16,$44
  2150. mypush r16
  2151. rcall emitcode
  2152.  
  2153. rjmp serialTest0 ;continue forever
  2154. ;---------------------------------------------------------
  2155. ;---------Now do SerialRx routines-------------------
  2156. waitForHigh: ;loop til RX is high
  2157. sbis PINB,RX_PIN ;test that pin for set (PB2)
  2158. rjmp waitForHigh ; loop if rx pin is low
  2159. ret
  2160. ;-----------------------------------------------
  2161. waitForLow: ;PRONBLEMs loop til RX is low. FIXED.
  2162. sbic PINB,2 ;test that pin for set (PB2)
  2163. rjmp waitForLow ; loop if rx pin is high
  2164. ret
  2165. ;---------------------------------------------------
  2166. waitForStartBit: ;loop til get a real start bit
  2167. rcall waitForHigh ;should be marking at start
  2168. rcall waitForLow ;gone low. might be noise
  2169. rcall halfBitTime ;is it still low in middle of bit time
  2170. sbic PINB,RX_PIN ;..well, is it?
  2171. rjmp waitForStartBit ;loop if level gone back high. Not a start bit.
  2172. ret ;we've got our start bit
  2173. ;----------------------------------------------------
  2174. checkForStopBit: ;at end, get carry flag to reflect level. Prob if c=0
  2175. rcall oneBitTime ; go into stop bit frame, halfway
  2176. sec ;should stay a 1 in C if stop bit OK
  2177. sbis PINB,RX_PIN ;don't clc if bit is high
  2178. clc ;but only if we have a weird low stop bit
  2179. ret ;with carry flag = stop bit. Should be a 1
  2180. ;-------------------------------------------------------------
  2181. get8Bits: ;get the 8 data bits. No frame stuff
  2182. clr rxbyte ;this will fill up with bits read from RX_PIN
  2183. push counterReg ;going to use this so save contents for later
  2184. ldi counterReg,8 ;because we're expecting 8 databits
  2185. nextBit:
  2186. rcall oneBitTime ;first enter here when mid-startbit
  2187. rcall rxABit ;get one bit
  2188. dec counterReg ;done?
  2189. brne nextBit ;no, round again
  2190. pop counterReg ;yes, finished, restor counter and get out
  2191. ret
  2192. ;---------------------------------------------------------------
  2193. rxABit: ;big serial input routine for one bit
  2194. clc ;assume a 0
  2195. sbic PINB,RX_PIN ; skip nxt if pin low
  2196. sec ;rx pin was high
  2197. ror rxbyte ;carry flag rolls into msb first
  2198. ret
  2199. ;********************************
  2200. getSerialByte: ;big routine. Serial ends up in rxByte
  2201. push counterReg
  2202. rcall waitForStartBit ;**change
  2203. rcall get8Bits
  2204. rcall checkForStopBit
  2205. pop counterReg
  2206. ret ;with rxByte containing serial bye
  2207. ;----------------------------------------------------
  2208. serialTest1: ;output A then reflect input. Worked OK
  2209. ldi serialByteReg, 0x36 ;0x41
  2210. rcall sendSerialByte
  2211. rcall oneBitTime ; take a rest
  2212. rcall getSerialByte
  2213. mov serialByteReg,rxByte ;output what's been read
  2214. rcall sendSerialByte
  2215. rjmp serialTest1
  2216. ;--------------------------------------------------------
  2217. ;----------Now doing buffer work. Want to and from 64 bytes----------
  2218. fillBuf:
  2219. ldi ZL,low(buf1) ;buf1 is my buffer
  2220. ldi ZH, high(buf1) ;Z now points to buf1
  2221. ldi counterReg,64 ;64 bytes in buffer
  2222. ldi r16,$30
  2223. storeB0:
  2224. st z+,r16
  2225. inc r16
  2226. dec counterReg
  2227. brne storeB0
  2228. herefb:
  2229. ; rjmp herefb
  2230. ret
  2231. ;----------------------------------------------------------
  2232. serialStrOut: ;X points to start of string,r17 has length
  2233. ld serialByteReg, x+
  2234.  
  2235. rcall sendSerialByte
  2236. dec r17 ;got to end of string?
  2237. brne serialStrOut
  2238. ret
  2239. ;----------------------------------
  2240. test_serialStrOut:
  2241. rcall fillBuf
  2242. ldi XL,low(buf1) ;buf1 start of str
  2243. ldi XH, high(buf1)
  2244. ldi r17,64 ;going to send len=r17 bytes
  2245. rcall serialStrOut
  2246. here2:
  2247. rjmp here2
  2248. ;--------------------------------------
  2249. waitForCharD: ;wait til eg a 'D' is pressed then do something.
  2250. ldi serialByteReg, '>' ;0x41
  2251. rcall sendSerialByte
  2252. rcall oneBitTime ; take a rest
  2253. rcall getSerialByte
  2254. mov serialByteReg,rxByte ;output what's been read
  2255. cpi rxByte, 'D'
  2256. brne waitForCharD
  2257. ldi serialByteReg, '*'
  2258. rcall sendSerialByte
  2259. rjmp waitForCharD
  2260. ;-----------------------------------------------------------
  2261. dumpbuf1:
  2262. .ifdef livetesting
  2263. ldi XL,low(buf1) ;buf1 start of str
  2264. ldi XH, high(buf1)
  2265. ldi r17,64 ;going to send len=r17 bytes
  2266. rcall serialStrOut
  2267. .endif
  2268. ret
  2269. ;-------------------------------------------------------------
  2270. test_dumpbuf1:
  2271. rcall fillBuf
  2272. rcall getSerialByte ;any one will do.
  2273. rcall dumpbuf1
  2274. rjmp test_dumpbuf1
  2275. ;----------------------------------------------------------
  2276. waitForDDump: ;wait til eg a 'D' is pressed then dump buf1
  2277. ldi serialByteReg, '>' ;0x41
  2278. rcall sendSerialByte
  2279. rcall oneBitTime ; take a rest
  2280. rcall getSerialByte
  2281. mov serialByteReg,rxByte ;output what's been read
  2282. cpi rxByte, 'D'
  2283. brne waitForDDump
  2284. rcall dumpbuf1
  2285. rjmp waitForCharD
  2286. ;---------------------------------------------------------------
  2287. rxStrEndCR: ;get a serial string that ends with CR
  2288. clr counterReg
  2289. ldi XL,low(buf1) ;buf1 is where str will go
  2290. ldi XH, high(buf1)
  2291. takemeout 'A'
  2292. upsec:
  2293. rcall getSerialByte
  2294.  
  2295. st x+, rxByte ;char goes into buffer="buf1"
  2296.  
  2297. cpi rxByte,$0d ;is it CR = end of string?
  2298. breq fin
  2299. inc counterReg ;don't go over 64 bytes
  2300. cpi counterReg,64
  2301. brne upsec ;not too long and not CR so keep going
  2302. fin:
  2303. ret
  2304. ;---------------------------------------------
  2305. test_rxStrEndCR: ;just a test of above
  2306. rcall OK
  2307. rcall CR
  2308. rcall rxStrEndCR
  2309. rcall dumpbuf1
  2310. rcall CR
  2311. ; rcall waitForDDump
  2312. rjmp test_rxStrEndCR
  2313. ;------------------------------------------------------
  2314. test2_rxStrEndCR: ;want a diagnostic dump if testing. Works with .IFDEF
  2315. rcall rxStrEndCR
  2316. .IFDEF testing
  2317. rcall dumpbuf1
  2318. .ENDIF
  2319. rjmp test2_rxStrEndCR
  2320. ;------------------------------------------------------------
  2321. rxStrWithLen: ;expect len char char char.. for len chars
  2322. push counterReg
  2323. ldi XL,low(buf1) ;buf1 is where str will go
  2324. ldi XH, high(buf1)
  2325. rcall getSerialByte ; get length bye Must be less than 65
  2326. mov counterReg, rxByte ;save len in counter
  2327. cpi counterReg,65 ;
  2328. brlo allOK ;less than 65 so carry on. Branch if Lower
  2329. ldi counterReg,64 ; if len>64 then len=64. Buffer = buf1 only 64 bytes
  2330. allOK:
  2331. tst counterReg ;zero yet?
  2332. breq finrs
  2333. rcall getSerialByte ;next serial input byte
  2334. st x+, rxByte ;put into buffer
  2335. dec counterReg ;have we done len=counterReg bytes?
  2336. rjmp allOK
  2337. finrs:
  2338. pop counterReg
  2339. ret
  2340. ;---------------------------------------------------------------
  2341. test_rsStrWithLen: ;works ok with macro $05GHIJKLM. Sends GHIJK
  2342. ldi r16, '#'
  2343. rcall sendSerialByte
  2344. rcall rxStrWithLen
  2345. rcall dumpbuf1
  2346. rjmp test_rsStrWithLen
  2347. ;-----------------------------now start forth i/o words like emit------------------
  2348. emitcode: ; (n8 --)classic emit
  2349. mypop r16
  2350. mypop r16 ;want lower byte eg in 0041 want just the 41
  2351. rcall sendserialbyte
  2352. ret
  2353. ;------------------------------------------------
  2354. insertret: ;semi has to end new word with ret = $9508 opcode
  2355. pushx ;both xl,xh saved for later
  2356. movw xl,myhere ;myhere points to next available spot in ram dic
  2357. ldi r16,$08
  2358. st x+,r16 ;$08 part goes first
  2359. ldi r16,$95
  2360. st x+,r16 ;ret now in ram. Just tidy pointers
  2361. movw myhere,xl
  2362. popx ;so x back where it was and ret inserted.
  2363. ret
  2364. ;--------------------------------
  2365. equalcode: ;(n1 n2 -- flag) if n1 = n2 flag = 0001 else 0000
  2366. mypopa
  2367. mypopb ; now have TOS in r16,17, underneath that in r18,19
  2368. cp r16,r18 ;low bytes =?
  2369. brne zout ;not equal so go out
  2370. cp r17,r19 ;hi bytes =?
  2371. brne zout ;no, so out
  2372. ;if here both n16's are equal so push a 0001
  2373. rcall one
  2374. rjmp aout ;done
  2375. zout:
  2376. rcall zero ;not = so push a zero
  2377. aout:
  2378. ret ;with a flag on stack replacing to n16's
  2379. ;------------------------------
  2380. ;TODO eliminate below and replace with simpler RAM jmp code.
  2381. calcjumpcode: ;(to from -- opcode_for_rjmp to at from)
  2382. ;used when compiling. What is the rjmp opcode if
  2383. ; we know the from and to adr on stack. ( to fr --)
  2384. ldi r16, low(buf2)
  2385. ldi r17, high(buf2)
  2386. mypush2 r16,r17 ; (to fr $e0 --)
  2387. rcall dup ;t f $e0 $eo
  2388. rcall unrot ;t $e0 fr $e0
  2389. rcall minus ;t $e0 frOffset
  2390. rcall unrot ;frOffset t $e0
  2391. rcall minus ;frOffset toOffset
  2392. ;now apply these offsets in flash buffer. Add them to start of flash buffer adr
  2393. mypush2 SOFPG,r7 ; frOffset toOffset SOFPG
  2394. rcall dup ;frOffset toOffset SOFPG SOFPG
  2395. rcall unrot ;frOffset SOFPG toOffset SOFPG
  2396. rcall plus ;frOffset SOFPG toFlashAdr
  2397. rcall unrot ;toFlashAdr frOffset SOFPG
  2398. rcall plus ;toFlashAdr frFlashAdr
  2399. rcall minus ;to -from give last 3 nibbles in rjmp opcode +1
  2400. ; rcall one
  2401. rcall two ;to - from - 2 when working with bytes
  2402. rcall minus ; now have to - from -2
  2403. rcall halve ;now have jmp length in words. Required for opcode.
  2404. rcall stackme_2
  2405. .dw $0fff
  2406. rcall andd ; now have eg. 0f20. Want Cf20
  2407. rcall stackme_2
  2408. .dw $c000 ;should now have right opcode eg cf20
  2409. rcall orr ;don't forget this !!!!!
  2410. ret ;with correct rjmp kkk on stack. Ready to insert into RAM dic.
  2411. ;-------------------
  2412. stackmyhere: ;( --- adr) put RAM ptr myhere on stack
  2413. mypush2 myhere, r5
  2414. ret
  2415. ;---------------------------
  2416. begincode: ;when using BEGIN just stack current address.No dic entry
  2417. rcall stackmyhere ;put next adr on stack
  2418. ret
  2419. ;----------------------------
  2420. stkmyhere: ;put myhere on the stack, handy
  2421. mypush2 myhere,r5
  2422. ret
  2423. ;-----------------------------------
  2424. stkSOBuf2: ;stack start of buf2. Handy.
  2425. ldi r16,low(buf2)
  2426. ldi r17,high(buf2)
  2427. mypush2 r16,r17
  2428. ret ;with adr of buf2 on stk
  2429. ;--------------------------
  2430. stkSOFPG: ;put start of flash page on stack, In bytes.
  2431. mypush2 SOFPG,r7
  2432. ret ;with start of current flash page's adr on stack.
  2433. ;-------------------------------
  2434. stklatestadr: ;put e-adr of eLatest. Currently 012 in eeprom
  2435. ldi r16,low(eLATEST)
  2436. ldi r17,high(eLATEST)
  2437. mypush2 r16,r17
  2438. ret ;with 012 or adr of eLatest on stk
  2439. ;-------------------------------------
  2440. stkhereadr: ;same as above but for HERE
  2441. ldi r16,low(eHERE)
  2442. ldi r17,high(eHERE)
  2443. mypush2 r16,r17
  2444. ret ;with adr of ehere,current eeprom adr = $010
  2445. ;-------------------------------------------
  2446. updatevars2: ;better version of update vars. Come here after ";"
  2447. ;TODO check this version.DONE and eliminate other one.
  2448. rcall gethere ;the HERE val now on stack. It's a pointer to flash.
  2449. rcall stklatestadr ;usually 012
  2450. rcall percentstore
  2451. ;now with LATEST now containing old HERE. Next fix HERE
  2452. rcall stkmyhere ;current ptr to RAM dic's next free byte
  2453. rcall stkSOBuf2 ;start of buf2 adr
  2454. rcall minus ;gives distance into the buffer
  2455. rcall stkSOFPG ;will add distance to start of flashbuf
  2456. rcall plus ;got flash adr, but in bytes
  2457. rcall halve ;now adr in words
  2458. rcall stkhereadr ;usually %010 in eeprom
  2459. rcall percentstore ;eHERE now updated
  2460. ret ;with vals for HERE and LATEST in eeprom updated after ";"
  2461. ;--------------------
  2462. testOKCR:
  2463. rcall OK
  2464. rcall OK
  2465. rcall CR
  2466. rjmp testOKCR
  2467. ;--------------------
  2468. serialFill: ;main input routine from terminal. Output OK} then
  2469. ; wait until buf1 has string of words ( <64 chars?) ending in $0d
  2470.  
  2471. rcall clrbuf1
  2472. rcall CR
  2473. ;rcall report
  2474. rcall OK
  2475. rcall rxStrEndCR
  2476. ret ; buf1 now filled with words from terminal
  2477.  
  2478. ;------------------------dump routines _______________
  2479. outnib: ;given $23 in r16, output the 3 as '3' = $33
  2480. push r18 ;going to use this
  2481. andi r16,$0f ; $3a --> $0a
  2482. cpi r16,$0a ;more than 10?
  2483. brge gothexo ;Nibble >= 10 jump down to gothex
  2484. ldi r18,$30 ; add $30 to 0..9
  2485. rjmp doneon
  2486. gothexo:
  2487. ldi r18,$37
  2488. doneon:
  2489. add r16,r18 ;now r16 nibble $03 is a '3'
  2490. rcall sendserialbyte ;print it
  2491. pop r18 ;used this as counter
  2492. ret ;note, it wrecks r16
  2493. ;--------------------------------------------
  2494. d16: ;dump contents of r16. Good for debugging.
  2495. push r16 ;keep contents for later
  2496. push r16 ;need this one after swap
  2497. swap r16 ;$34 wants 3 to come out first
  2498. rcall outnib ;print ascii eg '3'in above if r16 = $34
  2499. pop r16 ;get nice version back eg $34
  2500. rcall outnib ;print the '4'
  2501. pop r16 ;so r16 not wrecked.
  2502. ret ;with r16 printed in ascii
  2503. ;-----------------------------------
  2504. test_d16: ldi r16,$a5
  2505. rcall d16
  2506. ldi r16,$b6
  2507. rcall d16
  2508. rjmp test_d16
  2509. ;--------------------------------
  2510. d1617: ;dump r16 and r17 for debugging purposes
  2511. push r16
  2512. push r17 ;
  2513. push r16 ;just one min
  2514. mov r16, r17
  2515. rcall d16 ;that's r17 gone
  2516. pop r16
  2517. rcall d16 ;and then r16
  2518. pop r17
  2519. pop r16
  2520. ret ;with r17:r16 output in ascii
  2521. ;----------------------------------------
  2522. test_d1617:
  2523. ldi r16,$34
  2524. ldi r17,$1F
  2525. rcall d1617
  2526. rjmp test_d1617
  2527. ;-----------------------------------
  2528. dlowR: ;dump low registers. r0..r15 for debugging
  2529. ;.ifdef livetesting
  2530. push r16
  2531. push r18
  2532. pushx ;macro
  2533. clr xl
  2534. clr xh
  2535. ldi r18,16 ;r18 is a counter
  2536. prlow:
  2537. ld r16,x+ ;assume is x is 0 we'll get r0
  2538. rcall d16
  2539. rcall spacecode
  2540. dec r18
  2541. cpi r18,$07
  2542. breq doeseq7
  2543. tst r18
  2544. brne prlow
  2545. rjmp outprl
  2546. doeseq7:
  2547. ldi r16,'L'
  2548. rcall sendserialbyte
  2549. rcall spacecode
  2550. rjmp prlow
  2551.  
  2552. outprl:
  2553. popx ;macro
  2554. pop r18
  2555. pop r16
  2556. ;B.endif
  2557. ret ;with all the registers r0 ..r15 output in ascii to terminal screen
  2558. ;----------------------------------
  2559. test_dlowR:
  2560. rcall CR
  2561. ldi r16,$02
  2562. mov r0,r16
  2563. ldi r16,$52
  2564. mov r5,r16
  2565. ldi r16,$f2
  2566. mov r15,r16
  2567. rcall dlowR
  2568. rcall CR
  2569. rjmp test_dlowR
  2570. ;-----------------------------
  2571. spacecode: ;output a space
  2572. push r16
  2573. ldi r16,$20
  2574. rcall sendserialbyte
  2575. pop r16
  2576. ret
  2577. ;-------------------------------
  2578. dhighR: ;dump high registers. r18..r25 for debugging
  2579. push r16
  2580. push r17
  2581. pushx ;macro
  2582. ldi xl,18
  2583. ; clr xl
  2584. clr xh
  2585. ldi r17,8 ;r18 is a counter
  2586. prhi:
  2587. ld r16,x+ ;assume is x is 18 we'll get r18
  2588. rcall d16
  2589. rcall spacecode
  2590. dec r17
  2591. cpi r17,5
  2592. breq doeseq21
  2593. tst r17
  2594. brne prhi
  2595. rjmp outprh
  2596. doeseq21:
  2597. ldi r16,'H'
  2598. rcall sendserialbyte
  2599. rcall spacecode
  2600. rjmp prhi
  2601.  
  2602. outprh:
  2603. popx ;macro
  2604. pop r17
  2605. pop r16
  2606. ret ;with all the registers r0 ..r15 output in ascii to terminal screen
  2607. ;----------------------------------
  2608. test_dhighR:
  2609. rcall CR
  2610. ldi r18,$88
  2611. ldi r19,$19
  2612. ldi r20,$88 ;
  2613. ldi r21,$88
  2614. ldi r22,$22
  2615. ldi r23,$23
  2616. ldi r24,$24
  2617. ldi r25,$25
  2618. rcall dhighR
  2619. rcall CR
  2620. rjmp test_dhighR
  2621. ;------------------------------------
  2622. dxyz: ;dump the three pointer regs x,y,z
  2623.  
  2624. push r16
  2625. push r17
  2626. movw r16,xl ;r17:16 gets xh:xl
  2627. rcall d1617
  2628. rcall spacecode
  2629. movw r16,yl
  2630. rcall d1617
  2631. rcall spacecode
  2632. movw r16,zl
  2633. rcall d1617
  2634. rcall spacecode
  2635. pop r17
  2636. pop r16
  2637. ret ;with x,y,z output in ascii as a tripple
  2638. ;--------------------------------------
  2639. test_dxyz:
  2640. rcall CR
  2641. ldi xl,$12
  2642. ldi xh,$34
  2643. ldi yl,$56
  2644. ldi yh,$78
  2645. ldi zl,$9A
  2646. ldi zh,$bc
  2647. rcall CR
  2648. rcall dxyz
  2649. rcall CR
  2650. rjmp test_dxyz
  2651. ;--------------------------------
  2652. ;mystack needs a DEPTH word.
  2653. depthcode: ; (--n16)
  2654. ;leave on mystack the number of items on the stack by bytes.
  2655. movw r16,yl ;now r16,17 has y pointer
  2656. ldi r18, low(myStackStart) ;
  2657. ldi r19, high(myStackStart) ;r18,19 probably contain $1A0, the start of mystack
  2658. mypush2 r16,r17
  2659. mypush2 r18,r19 ;setup for eg $1a6 - $1a0
  2660. rcall minus ;difference=depth = eg 0006 as above.
  2661. ret ; with depth on stack
  2662. ;-----------------------------------------
  2663. test_depthcode:
  2664. ldi r16,$01
  2665. ldi r17,$23
  2666. mypush2 r16,r17
  2667. mypush2 r16,r17
  2668. mypush2 r16,r17
  2669. rcall depthcode
  2670. uptd: mypopa ;depth now in r16,17
  2671. up2: rcall d1617
  2672. rjmp up2
  2673. ;------------------------------------
  2674. dotScode: ;classic .S, print stack non-destructively
  2675. push r16
  2676. push r18
  2677. pushx ;macro
  2678. rcall depthcode ;now depth = len of stk on the mystack top
  2679. ; rcall drop ;stk =eg 0006 . want just len = 06
  2680. mypop2 r17,r18 ;so r18 now has length in bytes we're printing
  2681. ldi xl, low(myStackStart)
  2682. ldi xh, high(myStackStart)
  2683.  
  2684. ; movw xl,yl ;use x as temp ptr. Keep y pointing to mystack top
  2685. upds:
  2686. ld r16,x+ ;get tos, Pre-decrement.
  2687. rcall d16 ;print it
  2688. rcall spacecode ;
  2689. dec r18
  2690. brne upds
  2691. ldi r16, ']'
  2692. rcall sendserialbyte
  2693. rcall spacecode
  2694. popx ;macro
  2695. pop r18
  2696. pop r16
  2697. ret ;with the stack items printed to term screen + ]
  2698. ;-----------------------------
  2699. test_dotScode:
  2700. ldi r16,$A1
  2701. ldi r17,$B2
  2702. mypush2 r16,r17
  2703. mypush2 r16,r17
  2704. mypush2 r16,r17
  2705. rcall dotScode
  2706. rcall drop
  2707. rcall drop
  2708. rcall drop
  2709. uptds:
  2710. rjmp uptds
  2711. ;---------------------------------
  2712. wordscode: ;classic words. List all the words in the dic
  2713. push r16
  2714. push r17
  2715. push r22
  2716. push r23
  2717. push r24
  2718. pushz
  2719. rcall doLatest ;get first link into v
  2720. upwo:
  2721. rcall jmpNextWord ;pnt to link part of next word
  2722. lpm r23,z+
  2723. lpm r22,z+ ;store link into v=r23,24
  2724. lpm r16,z+ ;get len
  2725. andi r16,$0f ;don't want eg $85 to be len when it means immediate len 5.
  2726. clr r17 ;need eg 0006 on stk not 06 later
  2727. mypush2 r16,r17 ;len byte now on mystk
  2728. ;at this stage z points to the start of word name
  2729. mypush2 zl,zh ;flash start adr of string now on mystack
  2730. rcall swapp ; but wrong way round. Want len = TOS
  2731. rcall Sdot ;print the string on the term
  2732. rcall spacecode ;but add space after each word
  2733. tst vl
  2734. brne upwo ;if vl:vh = r23,24 = 0000 finish
  2735. tst vh
  2736. brne upwo
  2737. popz ;
  2738. pop r24
  2739. pop r23
  2740. pop r22
  2741. pop r17 ;TODO macro with multiple pops & pushes
  2742. pop r16
  2743. ret ;with all the words in dic printed
  2744. ;-----------------------------------------------
  2745. clrbuf1:
  2746. ldi ZL,low(buf1) ;buf1 is my buffer
  2747. ldi ZH, high(buf1) ;Z now points to buf1
  2748. ldi counterReg,64 ;64 bytes in buffer
  2749. ldi r16,$30
  2750. storecl:
  2751. st z+,r16
  2752. inc r16
  2753. dec counterReg
  2754. brne storecl
  2755.  
  2756. ret
  2757. ;-----------------------
  2758. updatevarptrcode: ;update varptr currently at eeprom's 0016. Add 2 to its contents.
  2759. rcall getvarptr ;eg 0160 in ram
  2760. rcall two
  2761. rcall plus ;now is eg 0162
  2762. rcall varptradr ;usually 0016 in eeprom
  2763. rcall percentstore ;should be called estore ie e!
  2764. ret ;with ptr val = old ptrval + 2
  2765. ;-------------------------
  2766. variablecode: ;big word called each time variable is declared
  2767. rcall coloncode ;does all the create work in buf
  2768.  
  2769. rcall getvarptr ;put eg 0162 on stack. Address of next RAM var place.
  2770. rcall compstackme_2 ;put stackme_2 as first code when called
  2771.  
  2772. rcall comma
  2773. rcall updatevarptrcode ;add 2 to varptr
  2774. rcall semi ;finish off and burn to flash
  2775.  
  2776. ret ;with variable created.
  2777. ;----------------------------------
  2778. considercode: ;having probs with findword going awol. Need another debug routine.
  2779. .ifdef livetesting
  2780. rcall CR
  2781. takemeout '[' ;just little mark for Id
  2782. rcall dhighR ;
  2783. ;Used when we've found a word.Starting at w(r24,25) length in r20. x points to space just past word.
  2784. ; u = r22,23
  2785. takemeout ']' ;just little mark for Id
  2786. .endif
  2787. ret
  2788. ;-------------------------
  2789. ifcode: ;classic IF
  2790. rcall tic
  2791. rcall zerobranch
  2792. rcall comma
  2793. rcall stackmyhere
  2794. rcall zero
  2795. rcall comma
  2796. ret ;with (rcall zerobranch, 0000) in dictionary in RAM
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!