API tools faq
paste
prjbrook

forth85_32. what?code, rs. firstvar OK

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