API tools faq
paste
prjbrook

forth85_47. Timing investigations. Draft.

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