API tools faq
paste
prjbrook

forth85_43. Usi versions replace bitbang

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