API tools faq
paste
prjbrook

forth85_31. if,else,endif seem ok

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