API tools faq
paste
prjbrook

forth85_26. dot(.) ,strings and word going

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