API tools faq
paste
Advertisement
prjbrook

forth85_48. Deep issue solved.

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