API tools faq
paste
prjbrook

forth85_26. Getting HERE straight. Not yet

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