API tools faq
paste
prjbrook

forth85_34 Looks like begin..while..repeat OK

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