API tools faq
paste
prjbrook

forth85_38 Some progress on T0.

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