API tools faq
paste
Advertisement
prjbrook

forth85_46 Some mis-steps. Slimmer.

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