API tools faq
paste
prjbrook

forth85_39. qickT0 gives OK interrupt timing

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