API tools faq
paste
prjbrook

forth85_41. New IO pins OK at 600baud

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