API tools faq
paste
prjbrook

forth85_21. updatevars needs work

prjbrook
Aug 10th, 2014
419
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 65.85 KB | None | 0 0
raw download clone embed print report
  1. ;this is forth85_21 Tidies up forth85_20
  2. ;TODO updatevars is a mess. Word <-->byte adr mixup.
  3. ;do and test BRANCH and 0 BRANCH NOT DONE
  4. ; Also calcjump for rjmp opcodes needs tsting. NOT DONE
  5. ;could try (begin .... again) loop
  6. .NOLIST
  7. .include "tn85def.inc"
  8. .LIST
  9. ;.LISTMAC ;sometimes macro code gets in way of clarity in listing
  10. .MACRO header
  11. .db high(@0), low(@0), @1, @2
  12. .ENDMACRO
  13. .MACRO mypop
  14. ld @0,-y
  15. .ENDMACRO
  16. .MACRO mypush
  17. st y+, @0
  18. .ENDMACRO
  19. .MACRO mypop2
  20. mypop @0
  21. mypop @1
  22. .ENDMACRO
  23. .MACRO mypush2
  24. mypush @0
  25. mypush @1
  26. .ENDMACRO
  27. .MACRO pushx
  28. push xl
  29. push xh
  30. .ENDMACRO
  31. .MACRO popx
  32. pop xh
  33. pop xl
  34. .ENDMACRO
  35. .MACRO pushz
  36. push zl
  37. push zh
  38. .ENDMACRO
  39. .MACRO popz
  40. pop zh
  41. pop zl
  42. .ENDMACRO
  43. .MACRO mypopa ;call r16,17 the accumulator a, ditto for r18,r19 for b
  44. mypop r17
  45. mypop r16
  46. .ENDMACRO
  47. .MACRO mypopb
  48. mypop2 r19,r18
  49. .ENDMACRO
  50.  
  51. .def mylatest =r2 ;r2,r3 is mylatest
  52. .def myhere =r4 ;r4,r5 is myhere. The pointer to flash copy in buf2.
  53. .def SOFPG=r6 ;start of flash page
  54. ;r6,r7 byte adr of flash page (11c0)
  55. ;r8,r9 (0012) offset when flash comes into buf2. r8 +E0 = myhere
  56. .def SECONDLETTER =r10 ;helpful for debugging
  57. .def FOUNDCOUNTER = r11 ;dealWithWord clicks this if found =1. Counts successful finds in dictionary.
  58. .def STATE = r12
  59. .def STOP = r13 ;stop interpreting line of words
  60. .def BOTTOM = r14 ;have hit the bottom of the dict and not found a match
  61. .def FOUND = r15 ;if found=1 we have a match of Ram word on dictionary
  62. .def spmcsr_val=r18
  63. .def buf_ctr =r19 ;for flash section
  64. ;r20 is length of word in WORD
  65. ;r21 is the flash length of word with immediate bit 8, if any, still there
  66.  
  67. .def vl = r22
  68. .def vh = r23 ; u,v,w,x,y,z are all pointers
  69. .def wl = r24 ;w=r24,25
  70. .def wh = r25
  71.  
  72. .equ TX_PIN = 0
  73. .equ RX_PIN = 2 ; Tx,Rx pins are PB0 and PB2 resp
  74.  
  75. .def serialByteReg = r16
  76. .def rxByte = r18
  77. .def counterReg = r17
  78.  
  79. .equ testing = 1 ;makes io verbose. comment out later
  80.  
  81.  
  82. .eseg
  83. .org $10
  84. .dw HERE, LATEST ;these should be burned into tn85 with code
  85.  
  86. .DSEG
  87. .ORG 0x60
  88.  
  89. .equ BUF1LENGTH = 128
  90. .equ eHERE = $0010 ;eeprom adr of system varial eHere
  91. .equ eLATEST = $0012
  92.  
  93. buf1: .byte BUF1LENGTH ;input buffer. Lines max about 125
  94. buf2: .byte BUF1LENGTH ;this fits two flash buffers
  95. varSpace: .byte 64 ;might need more than 32 variables
  96. myStackStart: .byte 64 ;currently at $1E0.Meets return stack.
  97.  
  98. .CSEG
  99. .ORG 0x800 ;dictionary starts at 4K (2K words) mark
  100. ;----------------------------------------------------
  101. one_1:
  102. .db 0,0,3, "one" ;code for one
  103. one:
  104. ; rcall stackme
  105. rcall stackme_2
  106. .db 01, 00
  107. ret
  108. ;----------------------------------------------
  109. two_1:
  110. header one_1, 3, "two"
  111. two:
  112. rcall stackme_2
  113. .db 02,00
  114. ret
  115. ;------------------------------------------
  116. dup_1:
  117. header two_1,3,"dup"
  118. dup:
  119. mypop r17
  120. mypop r16
  121. mypush r16
  122. mypush r17
  123. mypush r16
  124. mypush r17
  125.  
  126. ret
  127. ;-------------------------------------------
  128. drop_1:
  129. header dup_1,4,"drop"
  130. drop:
  131. mypop r17
  132. mypop r16 ;TODO what if stack pointer goes thru floor?
  133. ret
  134. ;----------------------------------
  135. swapp_1: ;twp p's becasue assembler recognizes avr opcode swap
  136. header drop_1,5, "swapp"
  137. swapp:
  138. mypop2 r17,r16
  139. mypop2 r19,r18
  140. mypush2 r16,r17
  141. mypush2 r18,r19
  142. ret
  143.  
  144.  
  145. ;-------------------------------------------------
  146. ;shift this later
  147.  
  148. S_1:
  149. ;the EOL token that gets put into end of buf1 to stop parsing
  150. header swapp_1,$81,"S" ;NB always immediate
  151. S: ldi r16,02
  152. mov BOTTOM,r16 ;r14 =2 means a nice stop. EOL without errors
  153. clr STOP
  154. inc STOP ;set time-to-quit flag
  155. ret
  156. ;------------------------------------------
  157.  
  158. fetch_1: ;doesn't like label = @-1
  159. ;classic fetch. (adr -- num). Only in RAM
  160. header S_1,1,"@"
  161. fetch:
  162. pushx ;going to use x to point so better save
  163. mypop xh
  164. mypop xl
  165. ld r16,x+
  166. ld r17,x
  167. mypush r16
  168. mypush r17 ; and put them on my stack
  169. popx ;return with x intact and RAM val on my stack
  170. ret
  171. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  172.  
  173. cfetch_1: ;doesn't like label = c@-1
  174. ;classic fetch. (adr -- num). Only in RAM. Do I want y to advance just one byte on mystack
  175. header fetch_1,2,"c@"
  176. cfetch:
  177. pushx ;going to use x to point so better save
  178. mypop xh
  179. mypop xl
  180. ld r16,x+
  181. mypush r16
  182. popx ;return with x intact and RAM val on my stack
  183. ret
  184. ;dddddddddddddddddddddddddddddddddddddddddddddddd
  185.  
  186. store_1: ;classic != "store"(adr num --) . Num is now at cell adr.
  187. header cfetch_1,1,"!"
  188. store:
  189. mypop2 r17,r16 ;there goes the num
  190. pushx
  191. mypop2 xh,xl ;there goes the address
  192. st x+,r16
  193. st x,r17 ;num goes to cell with location=adr
  194. popx
  195. ret
  196. ;ddddddddddddddddddddddddddddddddddddddddddddddddddd
  197.  
  198. cstore_1: ;classic c!= "store"(adr 8-bitnum --) . 8 bit Num is now at cell adr.
  199. header store_1,2,"c!"
  200. cstore:
  201. mypop r16 ;there goes the num. Just 8 bits at this stage.
  202. pushx
  203. mypop2 xh,xl ;there goes the address
  204. st x+,r16
  205. ; st x,r17 ;num goes to cell with location=adr
  206. popx
  207. ret
  208. ;------------------------------------
  209.  
  210. star_1: ;classic 16*16 mulitply (n n -- n*n)
  211. header cstore_1,1,"*"
  212. star:
  213. mypop2 r17,r16
  214. mypop2 r19,r18 ;now have both numbers in r16..r19
  215. rcall mpy16s ; multiply them. Result in r18..r21. Overflow in r20,21
  216. mypush2 r18,r19
  217. ret
  218. ;-----------------------------------------
  219.  
  220. slashMod_1: ;classic /MOD (n m -- n/m rem)
  221. header star_1,4,"/mod"
  222. slashMod:
  223. push r13
  224. push r14 ;this is STOP but is used by div16s, so better save it
  225. mypop2 r19,r18 ; that's m
  226. mypop2 r17,r16 ;that's n
  227. rcall div16s ;the the 16 by 16 bit divsion
  228. mypush2 r16,r17 ;answer ie n/m
  229. mypush2 r14,r15 ;remainder
  230. pop r14
  231. pop r13
  232. ret
  233. ;dddddddddddddddddddddddddddddddddddddddddddd
  234.  
  235. plus_1: ;classic + ( n n -- n+n)
  236. header slashMod_1,1,"+"
  237. plus:
  238. mypop2 r17,r16
  239. mypop2 r19,r18
  240. clc
  241. add r16,r18
  242. adc r17,r19
  243. mypush2 r16,r17
  244. ret
  245. ;--
  246.  
  247. minus_1: ;classic - ( n m -- n-m)
  248. header plus_1,1,"-"
  249. minus:
  250. mypop2 r19,r18
  251. mypop2 r17,r16
  252. clc
  253. sub r16,r18
  254. sbc r17,r19
  255. mypush2 r16,r17
  256. ret
  257. ;dddddddddddddddddddddddddddddddddddddddddd
  258.  
  259. pstore_1: ;expects eg. 0003 PORTB P! etc, "output 3 via PORTB"
  260. header minus_1,2, "p!"
  261. pstore:
  262. mypopb ;get rid of PORTB number, not used for tiny85, just one port
  263. mypopa ; this is used. it's eg the 003 = R16 above
  264. out PORTB,r16
  265. ret
  266. ;ddddddddddddddddddddddddd
  267.  
  268. portblabel_1:
  269. header pstore_1,5,"PORTB" ; note caps just a filler that point 0b in stack for dropping
  270. portblabel:
  271. ; Extend later on to include perhaps other ports
  272. ; one:
  273. ; rcall stackme
  274.  
  275. rcall stackme_2
  276. .db $0b, 00
  277. ret
  278. ;---------------------
  279.  
  280. datadirstore_1: ;set ddrb. invioked like this 000f PORTB dd! to make pb0..pb3 all outputs
  281. header portblabel_1, 3, "dd!"
  282. datadirstore:
  283. mypopb ; there goes useless 0b = PORTB
  284. mypopa ; 000f now in r17:16
  285. out DDRB,r16
  286. ret
  287. ;dddddddddddddddddddddddddddddddddddd
  288. ;sbilabel_1 ;set bit in PORTB. Just a kludge at this stage
  289. ;header datadirstore_1,3,"sbi" TODO sort out sbi and delay later. Now get on with compiler.
  290. ;first need store system vars in the eeprom. Arbitrarily 0010 is HERE and 0012 (in eeprom) is LATEST
  291. ;----------------------------------------
  292.  
  293. percentcstore_1: ;(n16 adr16 --) %c! stores stack val LSbyte to eeprom adr
  294. ; eg 10 00 1234 stores 34 to 0010 <--eeprom adr
  295. header datadirstore_1,3,"%c!"
  296. percentcstore:
  297. mypopb ;adr in r18,19
  298. mypopa ;data. Lower byte into r16
  299.  
  300. rcall eewritebyte ;burn it into eeprom
  301. ret
  302. ;----------------------------------
  303.  
  304. percentstore_1: ; (n16 adr16 --) b16 stored at eeprom adr adr16 and adr16+1
  305. header percentcstore_1,2, "%!"
  306. percentstore:
  307. mypopb ;adr in b=r18,19
  308. mypopa ;n16 into r16,17 as data
  309.  
  310. rcall eewritebyte ;burn low data byte
  311. clc
  312. inc r18
  313. brne outpcs
  314. inc r17 ;sets up adr+1 for next byte
  315. outpcs:
  316. mov r16,r17 ;r16 now conatins hi byte
  317. rcall eewritebyte
  318. ret
  319. ;-------------------------------
  320.  
  321. percentcfetch_1: ;(eepromadr16--char). Fetch eeprom byte at adr on stack
  322. header percentstore_1,3,"%c@"
  323. percentcfetch:
  324. mypopb ;adr now in r18,19
  325. rcall eereadbyte
  326. mypush r16 ; there's the char going on stack. Should be n16? Not n8?
  327. ret
  328. ;-------------------
  329.  
  330. percentfetch_1: ;(adr16--n16) get 16bits at adr and adr+1
  331. header percentcfetch_1,2,"%@"
  332. percentfetch:
  333. rcall percentcfetch ;low byte now on stack
  334. inc r18
  335. brcc downpf
  336. inc r19
  337. downpf:
  338. rcall eereadbyte ;there's the high byte hitting the mystack
  339. mypush r16
  340. ret
  341. ;-------------------------------
  342. gethere_1: ; leaves current value of eHERE on stack
  343. header percentfetch_1,7,"gethere"
  344. gethere:
  345. rcall stackme_2
  346. .dw eHere
  347. rcall percentfetch
  348. ret
  349. ;--------------------
  350.  
  351. getlatest_1: ;leaves current value of latest on stack
  352. header gethere_1,9, "getlatest"
  353. getlatest:
  354. rcall stackme_2
  355. .dw eLATEST ;the address of the latest link lives in eeprom at address 0012
  356. rcall percentfetch ;get the val out of eeprom
  357. ret
  358. ;------------------
  359.  
  360. colon_1: ;classic ":"compiling new word marker
  361. header getlatest_1,1,":"
  362. rcall coloncode
  363. ret
  364. ;----------------------------------------
  365.  
  366. comma_1: ;classic comma. ;Put adr on stack into dictionary at myhere and bump myhere
  367. header colon_1,1,","
  368. comma:
  369. mypopa ;adr now in r16,17
  370. pushz ;save z
  371. movw zl,myhere ;z now pnts to next avail space in dic
  372. st z+,r16
  373. st z+,r17
  374. movw myhere,zl ;so that myhere is updated as ptr
  375. popz ;bring z back
  376. ret
  377. ;------------------------------------
  378.  
  379. tic_1: ;clasic tic('). Put cfa of next word on stack
  380. header comma_1,1, "'"
  381. tic:
  382. rcall word ;point to next word in input
  383. rcall findword ;leaving cfa in z
  384. mypush2 zl,zh
  385. rcall two ;but it's in bytes. Need words so / by 2
  386. rcall slashmod
  387. rcall drop ;that's the remainder dropped
  388. ;now have cfa of word after ' on stack in word-units.
  389. ret
  390. ;-----------------------
  391.  
  392. dummy_1: ;handy debugging place to put a break point
  393. header tic_1,$85,"dummy" ;first immediate word
  394. dummy:
  395. nop
  396. ret
  397. ;--------------------------------
  398.  
  399. compstackme_2_1: ;needed infront of every number compiled
  400. header dummy_1, $0d,"compstackme_2"
  401. compstackme_2:
  402. ldi r16,low(stackme_2)
  403. ldi r17,high(stackme_2)
  404. mypush2 r16,r17 ;in words need to *2 to convert to bytes
  405. rcall two
  406. rcall star
  407. rcall compileme
  408. ret
  409. ;-----------------------------------------
  410.  
  411. double_1: ;whatever's on stack gets doubled. Usful words-->bytes. (n...2*n)
  412. header compstackme_2_1, 6, "double"
  413. double:
  414. mypopa ;stk to r16,17
  415. clc ;going to do shifts
  416. rol r16
  417. rol r17 ;r16,17 now doubled
  418. mypush2 r16,r17
  419. ret ;with 2*n on my stk
  420. ;--------------------------------------
  421.  
  422. semi_1: ;classic ";". Immediate TODO compile a final ret
  423. header double_1,$81,";"
  424. semi:
  425. nop
  426. rcall insertret ;compile ret
  427. rcall burnbuf2and3
  428. rcall rbrac ;after semi w'got back to executing
  429. rcall updatevars ;update HERE and LATEST in eeprom
  430. ret
  431. ;---------------------------------------
  432.  
  433. rbrac_1: ;classic "]" ,immediate
  434. header semi_1,$81,"]"
  435. rbrac:
  436. clr STATE ;go to executing
  437. ret
  438. ;------------------------------------------------
  439.  
  440. immediate_1: ;classic IMMEDIATE. Redo len byte so MSbit =1
  441. header rbrac_1,$89,"immediate"
  442. immediate:
  443. mypush2 r2,r3 ;this is mylatest. pnts to link of new word
  444. rcall two
  445. rcall plus ;jmp over link to pnt to len byte
  446. pushx ;better save x
  447. mypop2 xh,xl ;x now pnts to len byte
  448. ld r16,x ; and put it into r6
  449. ldi r18,$80 ;mask
  450. or r16,r18 ;eg 03 --> 83 in hex
  451. st x,r16 ;put len byte back
  452. popx ;back where it was
  453. ret ;done now newly created word is immediate
  454. ;-------------------------------------------------
  455.  
  456. emit_1: ;(n8 --) classic emit
  457.  
  458. header immediate_1, 4, "emit"
  459. emit:
  460. rcall emitcode
  461. ret
  462. ;--------------------------------------
  463.  
  464. getline_1: ;rx a line of chars from serialin. eol = $0d
  465. ;this is the line that gets interpreted
  466. header emit_1,7, "getline"
  467. getline:
  468. rcall rxStrEndCR ;write 64 TODO 128? bytes into buf1 from serial io
  469. .ifdef testing
  470. rcall dumpbuf1
  471. .endif
  472. ret ;with buf1 ready to interpret
  473. ;-------------------------------------------------
  474.  
  475. zero_1: ;stack a zero
  476. header getline_1,4,"zero"
  477. zero:
  478. rcall stackme_2
  479. .db 0,0
  480. ret
  481. ;----------------------------------------
  482.  
  483. equal_1: ;(n1 n2 -- flag)
  484. header zero_1,1,"="
  485. equal:
  486. rcall equalcode
  487. ret
  488. ;----------------------------------------
  489.  
  490. zeroequal_1: ;(n -- flag)
  491. header equal_1,2,"0="
  492. zeroequal:
  493. rcall zero
  494. rcall equal
  495. ret
  496. ;-------------------------
  497.  
  498. over_1: ;(n1 n2 --n1 n2 n1)
  499. header zero_1,4,"over"
  500. over:
  501. mypopa
  502. mypopb
  503. mypush2 r18,r19 ;n1
  504. mypush2 r16,r17 ;n2
  505. mypush2 r18,r19 ;n1. so end up with (n1,n2,n1
  506. ret
  507. ;-----------------------------------
  508.  
  509. rot_1: ;classic (n1 n2 n3 -- n2 n3 n1)
  510. header over_1,3,"rot"
  511. rot:
  512. mypopa
  513. push r17
  514. push r16 ;save n3
  515. rcall swapp ; n2 n1
  516. pop r16
  517. pop r17
  518. mypush2 r16,r17 ;n2 n1 n3
  519. rcall swapp ;n2 n3 n1
  520. ret
  521. ;------------------------------------
  522.  
  523. reverse3_1: ;PB (n1 n2 n3 -- n3 n2 n1). Reverses top 3 order
  524. header rot_1,8,"reverse3"
  525. reverse3:
  526. rcall swapp ; n1 n3 n2
  527. rcall rot ; n3 n2 n1
  528. ret ;so (n1 n2 n3 -- n3 n2 n1)
  529. ;--------------------------------------------
  530.  
  531. unrot_1: ;PB (n1 n2 n3 -- n3 n1 n2) Buries topitem two down
  532. header reverse3_1,5,"unrot"
  533. unrot:
  534. rcall reverse3 ; (n1 n2 n3 -- n3 n2 n1)
  535. rcall swapp ; n3 n1 n2
  536. ret
  537. ;--------------------------------
  538.  
  539. andd_1: ;classic AND
  540. header unrot_1,4,"andd" ; two d's otherwise asm problems
  541. andd:
  542. mypopa
  543. mypopb
  544. and r16,r18
  545. and r17,r19
  546. mypush2 r16,r17
  547. ret
  548. ;----------------------------------------
  549.  
  550.  
  551. orr_1: ;classic OR
  552. header andd_1,3,"orr" ; two r's otherwise asm problems
  553. orr:
  554. mypopa
  555. mypopb
  556. or r16,r18
  557. or r17,r19
  558. mypush2 r16,r17
  559. ret
  560. ;------------------------
  561.  
  562. calcjump_1: ;(to from -- opcode)
  563. header orr_1,$88, "calcjump"
  564. calcjump:
  565. rcall calcjumpcode
  566. ret ;with opcode on stack
  567. ;-----------------------
  568.  
  569. begin_1: ;( -- adr) classic BEGIN. Used in most loops
  570. header calcjump_1,$85,"begin"
  571. begin:
  572. rcall stackmyhere ;put next adr on stack. For AGAIN etc
  573. ret ;with adr on stack
  574. ;---------------------------
  575. again_1: ; (to_adr -- ) classic AGAIN cts loop back to BEGIN
  576. header begin_1, $85,"again"
  577. rcall stackmyhere ; to_adr fr_adr
  578. rcall minus ;rel_adr_distance eg $ffdd
  579. rcall stackme_2
  580. .dw $0002
  581. rcall div ;now adr difference in words. Works better.
  582. rcall stackme_2
  583. .dw $0fff ;$ffdd $0fff
  584. rcall andd ;$0fdd eg.
  585. rcall stackme_2
  586. .dw $c000 ;$0fdd $c000
  587. rcall orr ;$cffdd = rjmp back_to_again
  588. rcall one
  589. rcall minus ;t0-fr-1 = the jump part of rjmp
  590. rcall comma ;insert into dic
  591. ret ;with rjmp opcode in next pos in dic
  592. ;------------------------------
  593.  
  594. div_1: ; (n1 n2 -- n1/n2) classic / Could make 2 / faster with >, one right shift
  595. header again_1,1,"/"
  596. div:
  597. rcall slashMod
  598. rcall drop
  599. ret
  600. ;---------------------------------
  601. LATEST:
  602. halve_1: ; (n -- n/2) use shifts to halve num on stack. Handy
  603. header div_1,5,"halve"
  604. halve:
  605. mypopa
  606. clc
  607. ror r17
  608. ror r16
  609. mypush2 r16,r17 ;now num on stack has been halved
  610. ret ;with n/2 on stk
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618. ;-----------------------------------------------
  619. HERE:
  620. .db "444444444444444444444444444444"
  621. rcall stackme_2
  622. .dw $1234
  623. rcall two
  624. rcall stackme_2
  625. .dw $2468
  626.  
  627. rcall one
  628. rcall plus
  629. rcall dummy
  630. .org $0a14
  631. stad0:
  632. rcall one
  633. rcall drop
  634. rjmp stad0
  635.  
  636.  
  637.  
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652. ;---------------stackme_2 used to live here----------------------------------
  653.  
  654.  
  655.  
  656.  
  657. ;====================================================================================================
  658.  
  659. .ORG 0
  660. rjmp quit
  661. ; rjmp mainloop
  662. ; rjmp start
  663. ;typein: .db "11bb 0014 %! getlatest",$0d, "0013 %@",0x0d
  664.  
  665. typein: .db " gethere : qqq begin one drop again ; " ,$0d
  666. ;"11bb 0014 %! ", $0d ;%! getlatest",$0d, "0013 %@",0x0d
  667. ;" one 0010 00ab %c! 0012 cdef %! 0013 %c@ 0013 %@ 0987 drop ", 0x0d
  668.  
  669. ;stackme dropx onex stackme swap drop",0x0d
  670. ;-----------------------------------------------------
  671. ;start:
  672. quit:
  673. ldi r16, low(RAMEND)
  674. out SPL, r16
  675.  
  676.  
  677. ldi r16,high(RAMEND)
  678. out SPH, r16
  679.  
  680. ldi YL,low(myStackStart)
  681. ldi YH,high(myStackStart)
  682. ldi r16, 0xf9 ;PORTB setup
  683. out DDRB,r16 ;
  684. nop
  685. ldi r16, $ff
  686. out PORTB,r16
  687. .IFDEF testing ;testing = simulating on avrstudio4
  688. nop
  689. rcall burneepromvars
  690.  
  691. .ENDIF
  692. forthloop:
  693. ldi r16, low(RAMEND)
  694. out SPL, r16
  695.  
  696.  
  697. ldi r16,high(RAMEND)
  698. out SPH, r16
  699.  
  700. ldi YL,low(myStackStart)
  701. ldi YH,high(myStackStart)
  702.  
  703.  
  704. rcall getline0 ;This is FORTH
  705. rcall interpretLine
  706. .ifdef testing
  707. nop
  708. quithere:
  709. rjmp quithere ;only want one line interpreted when testing
  710. .else
  711. rjmp forthloop
  712. .endif
  713. ;-------------------------------------------------------
  714.  
  715.  
  716. ;rjmp test_interpretLine
  717. ;rjmp test_cfetch
  718. ;rjmp test_store
  719. ;rjmp test_cstore
  720. ;rjmp test_mpy16s
  721. ;rjmp test_mpy16s0
  722. ;rjmp test_star
  723. ;rjmp test_div16s
  724. ;rjmp test_slashMod
  725. ;rjmp test_Hex4ToBin2
  726. rjmp test_interpretLine
  727. ;rjmp setupforflashin
  728. ;rcall coloncode
  729. ;rjmp test_buf2ToFlashBuffer
  730. ;rjmp serialTest0
  731. ;zzz
  732.  
  733. stopper: rjmp stopper
  734. ; rjmp start
  735. ;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
  736. mainloop: ;this is forth. This is run continuously. Needs two versions: live and simulation.
  737. ; rcall quit
  738. rcall getline0
  739. rcall interpretLine
  740. ret
  741. ;--------------------------------------------------------------
  742. getline0: ;force a line into buf1 via flash string. Simulates GETLINE
  743. ldi zl, low(typein<<1)
  744. ldi zh, high(typein<<1)
  745. ldi xl, low(buf1)
  746. ldi xh, high(buf1)
  747. type0:
  748. lpm r16,Z+
  749. st x+,r16
  750. cpi r16,0x0d ;have we got to the end of the line?
  751. brne type0
  752. ret
  753. ;--------------------------------------------
  754. ;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20
  755. ;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char
  756. word: ;maybe give it a header later
  757. ld r16,x+ ;get char
  758. ld SECONDLETTER, x ;for debugging
  759.  
  760. cpi r16,0x20 ;is it a space?
  761. breq word ;if so get next char
  762. ;if here we're point to word start. so save this adr in w
  763. mov r24,xl
  764. mov r25,xh ;wordstart now saved in w
  765.  
  766.  
  767. clr r20 ;length initially 0
  768. nextchar:
  769. inc r20 ;r20 = word length
  770. ld r16,x+ ;get next char
  771. cpi r16,0x20
  772. brne nextchar
  773. dec r24 ;adjust start of word
  774. ;if here we've found a word.Starting at w length in r20.x points to space just past word
  775. ret
  776. ;----------------------------------------
  777.  
  778. 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.
  779. ; and the word in buf1 is pointed to by w=r24,25. len = r20. Z on entry points to the link. Needs +2 to
  780. lpm r23,z+
  781. lpm r22,z+ ;store next link in v=r22,23. z now points to len byte
  782.  
  783. startc:
  784. ;TODO save copy of flash word in r21 and also do masking of immediates
  785. push r20 ;save length
  786. lpm r16,Z+ ;length of dictionary word, first entry now in r16
  787. mov r21,r16 ;copy length-in-flash to r21. May have immediate bit (bit 7)
  788. andi r16,$0f ;mask off top nibble before comparing
  789. cp r16,r20 ;same lengths?
  790. brne outcom ;not = so bail out
  791. ;if here the words are the same length, what about the rest of the chars.First get x to point to word.
  792. mov xl,r24
  793. mov xh,r25 ;x now point to start of buf1 word
  794. upcom:
  795. lpm r16,z+
  796. ld r17,x+ ;get one corresponding char from each word
  797. cp r16,r17 ;same word?
  798. brne outcom ;bail out if chars are different
  799. dec r20 ;count chars
  800. brne upcom ;still matching and not finished so keep going
  801. ;if here r20 is 0 so match must have been perfect so FOUND = 1
  802. clr FOUND
  803. inc FOUND
  804. outcom:
  805. pop r20 ;get old lngth of buf1 word back
  806. ret
  807. ;-------------------------------------------
  808. jmpNextWord: ;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte)
  809. ; and w = r24,25 contains RAM word start with len in r20
  810. ;exit with z pointing to next word ready for next COMPARE.
  811. clc
  812. rol r22
  813. rol r23 ;above 3 instructions change word address into byte address by doubling
  814. movw r30,r22 ;z now points to next word
  815. ret
  816. ;-----------------------------------------
  817.  
  818. doLatest: ;set up so first jump in dictionary is to top=LATEST and other flags set up.
  819. ; ldi vl, low(LATEST)
  820. ; ldi vh, high(LATEST)
  821. nop
  822. rcall getlatest ;from eeprom. Now on stack
  823. mypop2 vh,vl ;this is in bytes Need to halve it.
  824. ; rcall halve
  825. clr FOUND
  826. clr BOTTOM ;not yet found the match, not yet at the bottom. Either will stop search.
  827. clr STOP ;keep parsing words til this goes to a 1
  828. ret
  829. ;---------------------------------------------
  830. interpretLine: ;given line of words in buf one, search for words one by one. Don't do code
  831. ; or compile at this stage, just find and report that and go into next one.
  832. rcall getline0 ;change later to real getline via terminal
  833. rcall pasteEOL
  834. ldi xl, low(buf1)
  835. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  836. clr FOUNDCOUNTER ;counts finds in line parsing.
  837.  
  838. nextWord:
  839. tst STOP
  840. brne stopLine
  841. rcall word
  842. rcall findWord ;not done yet
  843. rcall dealWithWord ;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le}
  844. rjmp nextWord
  845. stopLine:
  846. ret
  847. ;-----------------------------------------------------------------
  848. findWord:
  849. rcall doLatest
  850. nop
  851. upjmpf:
  852. rcall jmpNextWord
  853. rcall compare
  854. tst FOUND
  855. brne stopsearchf ;if last compare got a match (FOUND=1) then stop searching
  856. tst vl
  857. brne upjmpf ;if v=0000 then we've hit the bottom of the dictionary
  858. tst vh
  859. brne upjmpf ;not found and not at bottom so keep going
  860. ;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
  861. clr BOTTOM
  862. inc BOTTOM ;exit with FOUND=0 and BOTTOM =1
  863. stopsearchf: nop
  864. ret
  865. ;----------------------------
  866. test_interpretLine:
  867. rcall interpretLine
  868. til: rjmp til ;** with r24 pointing to 'S' and FOUND = r15 =1
  869. ;------------------------------
  870. dealWithWord: ;come here when it's time to compile or run code
  871. ;Good debugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just
  872. ; 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
  873. ; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match
  874. ;
  875. nop
  876. tst FOUND
  877. breq notfound
  878. inc FOUNDCOUNTER
  879.  
  880. ;want to hop over filler bytes,0's added to keep codes on even byte boundaries
  881. ; so if r30 is odd at this stage inc it. odd is lsbit = 1.
  882. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  883. rjmp downd
  884. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  885. inc r30
  886. brcc downd
  887. inc r31 ;add one to z before converting to bytes
  888. ;have to ask at this point, is the word immediate? If so, bit 7 of r21 will be set.
  889. downd:
  890. sbrs r21,7
  891. rjmp downdw ;not immediate so just go on with STATE test
  892. rjmp executeme ;yes, immediate so execute every time.
  893.  
  894.  
  895. downdw: tst STATE
  896. breq executeme
  897. rcall compilecode
  898. rjmp outdww
  899. executeme:
  900. clc
  901. ror zh
  902. ror zl ;put z back into word values
  903.  
  904.  
  905. rcall executeCode
  906.  
  907.  
  908.  
  909. .MESSAGE "Word found"
  910. rjmp outdww
  911. notfound:
  912. nop
  913. ; .MESSAGE "Word not found"
  914. ; clr STOP
  915. ; inc STOP ;stop parsing line
  916. rcall numberh ; word not in dict so must be a number? Form = HHHH
  917. ;now have to add 3 to x so it points past this word ready not next one
  918. clc
  919. inc r26
  920. inc r26
  921. inc r26
  922. brcc outdww
  923. inc r27 ;but only if overflow
  924. nop
  925. outdww:
  926. ret ;with STOP =1 in not a number
  927. ;------------------------------------------------------------------------
  928. pasteEOL: ;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a
  929. ; special end of line word. When the word is invoked it casues a QUIT back to the waiting for input stage.
  930. ; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 "
  931. ldi xl, low(buf1)
  932. ldi xh, high(buf1) ;pnt to start of buffer
  933. clr r17
  934. nxtChar:
  935. inc r17 ;r17 is counter. Bail out when r17 > BUF1LENGTH
  936. cpi r17, BUF1LENGTH -3
  937. breq outProb
  938. ld r16, x+
  939. cpi r16, $0d
  940. brne nxtChar
  941. ;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it.
  942. ldi r16,$20
  943. st -x, r16 ;back up. Then go forward.
  944. ; ldi r16, ']'
  945. st x+, r16
  946. ldi r16,'S'
  947. st x+, r16
  948. ; ldi r16, '}'
  949. ; st x+, r16
  950. ldi r16, $20
  951. st x, r16
  952. rjmp outpel
  953.  
  954.  
  955. outProb:
  956. nop
  957. .MESSAGE "Couldn't find $0d"
  958. outpel:
  959. ret
  960.  
  961. ;-------------------------------------
  962. executeCode: ;with Z pointing to cfa. Not sure whether to jmp or call
  963.  
  964. ijmp
  965. ret
  966. ;---------------------------------------
  967. test_fetch: ;do run thru of @
  968. rcall getline0 ;change later to real getline via terminal
  969. rcall pasteEOL
  970. ldi xl, low(buf1)
  971. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  972.  
  973. ldi r16,$62
  974. mypush r16
  975. ldi r16,$0
  976. mypush r16 ;should now have adr $0062 on mystack
  977. rcall fetch
  978. tf1:
  979. rjmp tf1
  980. ;---------------------------------
  981. test_cfetch: ;do run thru of @
  982. rcall getline0 ;change later to real getline via terminal
  983. rcall pasteEOL
  984. ldi xl, low(buf1)
  985. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  986.  
  987. ldi r16,$62
  988. mypush r16
  989. ldi r16,$0
  990. mypush r16 ;should now have adr $62 on mystack
  991. rcall cfetch
  992. tcf1:
  993. rjmp tcf1
  994. ;----------------------------
  995. test_store:
  996. rcall getline0 ;change later to real getline via terminal
  997. rcall pasteEOL
  998. ldi xl, low(buf1)
  999. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1000. ldi r16,$62
  1001. ldi r17,$0
  1002. mypush2 r16,r17 ;should now have adr $62 on mystack
  1003. ldi r16, $AB
  1004. ldi r17, $CD
  1005. mypush2 r16,r17 ;now have $ABCD on mystack
  1006. rcall store
  1007. ts1:
  1008. rjmp ts1
  1009. ;------------------------
  1010. test_cstore:
  1011. rcall getline0 ;change later to real getline via terminal
  1012. rcall pasteEOL
  1013. ldi xl, low(buf1)
  1014. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1015. ldi r16,$62
  1016. ldi r17,$0
  1017. mypush2 r16,r17 ;should now have adr $62 on mystack
  1018. ldi r16, $AB
  1019. ; ldi r17, $CD
  1020. mypush r16 ;now have $ABCD on mystack
  1021. rcall cstore
  1022.  
  1023. ts11:
  1024. rjmp ts11
  1025. ;Now put arith routines here. Are from AVR200. Just using 16*16 for * but get 32bit result.
  1026.  
  1027.  
  1028. ;***************************************************************************
  1029. ;*
  1030. ;* "mpy16s" - 16x16 Bit Signed Multiplication
  1031. ;*
  1032. ;* This subroutine multiplies signed the two 16-bit register variables
  1033. ;* mp16sH:mp16sL and mc16sH:mc16sL.
  1034. ;* The result is placed in m16s3:m16s2:m16s1:m16s0.
  1035. ;* The routine is an implementation of Booth's algorithm. If all 32 bits
  1036. ;* in the result are needed, avoid calling the routine with
  1037. ;* -32768 ($8000) as multiplicand
  1038. ;*
  1039. ;* Number of words :16 + return
  1040. ;* Number of cycles :210/226 (Min/Max) + return
  1041. ;* Low registers used :None
  1042. ;* High registers used :7 (mp16sL,mp16sH,mc16sL/m16s0,mc16sH/m16s1,
  1043. ;* m16s2,m16s3,mcnt16s)
  1044. ;*
  1045. ;***************************************************************************
  1046.  
  1047. ;***** Subroutine Register Variables
  1048.  
  1049. .def mc16sL =r16 ;multiplicand low byte
  1050. .def mc16sH =r17 ;multiplicand high byte
  1051. .def mp16sL =r18 ;multiplier low byte
  1052. .def mp16sH =r19 ;multiplier high byte
  1053. .def m16s0 =r18 ;result byte 0 (LSB)
  1054. .def m16s1 =r19 ;result byte 1
  1055. .def m16s2 =r20 ;result byte 2
  1056. .def m16s3 =r21 ;result byte 3 (MSB)
  1057. .def mcnt16s =r22 ;loop counter
  1058.  
  1059. ;***** Code
  1060. mpy16s: clr m16s3 ;clear result byte 3
  1061. sub m16s2,m16s2 ;clear result byte 2 and carry
  1062. ldi mcnt16s,16 ;init loop counter
  1063. m16s_1: brcc m16s_2 ;if carry (previous bit) set
  1064. add m16s2,mc16sL ; add multiplicand Low to result byte 2
  1065. adc m16s3,mc16sH ; add multiplicand High to result byte 3
  1066. m16s_2: sbrc mp16sL,0 ;if current bit set
  1067. sub m16s2,mc16sL ; sub multiplicand Low from result byte 2
  1068. sbrc mp16sL,0 ;if current bit set
  1069. sbc m16s3,mc16sH ; sub multiplicand High from result byte 3
  1070. asr m16s3 ;shift right result and multiplier
  1071. ror m16s2
  1072. ror m16s1
  1073. ror m16s0
  1074. dec mcnt16s ;decrement counter
  1075. brne m16s_1 ;if not done, loop more
  1076. ret
  1077. ;----------------------------------------------------------
  1078. ;***** Multiply Two Signed 16-Bit Numbers (-12345*(-4321))
  1079. test_mpy16s:
  1080. ldi mc16sL,low(-12345)
  1081. ldi mc16sH,high(-12345)
  1082. ldi mp16sL,low(-4321)
  1083. ldi mp16sH,high(-4321)
  1084. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1085. ;=$032df219 (53,342,745)
  1086. tmpy: rjmp tmpy
  1087.  
  1088. test_mpy16s0:
  1089. ldi mc16sL,low(123)
  1090. ldi mc16sH,high(123)
  1091. ldi mp16sL,low(147)
  1092. ldi mp16sH,high(147)
  1093. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1094. tmpy0: rjmp tmpy0
  1095. ;-----------------------
  1096. test_star:
  1097. ldi r16,-$7b
  1098. mypush r16
  1099. ldi r16,$00
  1100. mypush r16 ;that's decimal 123 on stack
  1101. ldi r16,$93
  1102. mypush r16
  1103. ldi r16,$00
  1104. mypush r16 ; and thats dec'147
  1105. rcall star
  1106. tsr: rjmp tsr
  1107.  
  1108. ;--------------------------
  1109. ;***************************************************************************
  1110. ;*
  1111. ;* "div16s" - 16/16 Bit Signed Division
  1112. ;*
  1113. ;* This subroutine divides signed the two 16 bit numbers
  1114. ;* "dd16sH:dd16sL" (dividend) and "dv16sH:dv16sL" (divisor).
  1115. ;* The result is placed in "dres16sH:dres16sL" and the remainder in
  1116. ;* "drem16sH:drem16sL".
  1117. ;*
  1118. ;* Number of words :39
  1119. ;* Number of cycles :247/263 (Min/Max)
  1120. ;* Low registers used :3 (d16s,drem16sL,drem16sH)
  1121. ;* High registers used :7 (dres16sL/dd16sL,dres16sH/dd16sH,dv16sL,dv16sH,
  1122. ;* dcnt16sH)
  1123. ;*
  1124. ;***************************************************************************
  1125.  
  1126. ;***** Subroutine Register Variables
  1127.  
  1128. .def d16s =r13 ;sign register
  1129. .def drem16sL=r14 ;remainder low byte
  1130. .def drem16sH=r15 ;remainder high byte
  1131. .def dres16sL=r16 ;result low byte
  1132. .def dres16sH=r17 ;result high byte
  1133. .def dd16sL =r16 ;dividend low byte
  1134. .def dd16sH =r17 ;dividend high byte
  1135. .def dv16sL =r18 ;divisor low byte
  1136. .def dv16sH =r19 ;divisor high byte
  1137. .def dcnt16s =r20 ;loop counter
  1138.  
  1139. ;***** Code
  1140.  
  1141. div16s: ;push r13 ;PB !!
  1142. ;push r14 ;PB !!
  1143. mov d16s,dd16sH ;move dividend High to sign register
  1144. eor d16s,dv16sH ;xor divisor High with sign register
  1145. sbrs dd16sH,7 ;if MSB in dividend set
  1146. rjmp d16s_1
  1147. com dd16sH ; change sign of dividend
  1148. com dd16sL
  1149. subi dd16sL,low(-1)
  1150. sbci dd16sL,high(-1)
  1151. d16s_1: sbrs dv16sH,7 ;if MSB in divisor set
  1152. rjmp d16s_2
  1153. com dv16sH ; change sign of divisor
  1154. com dv16sL
  1155. subi dv16sL,low(-1)
  1156. sbci dv16sL,high(-1)
  1157. d16s_2: clr drem16sL ;clear remainder Low byte
  1158. sub drem16sH,drem16sH;clear remainder High byte and carry
  1159. ldi dcnt16s,17 ;init loop counter
  1160.  
  1161. d16s_3: rol dd16sL ;shift left dividend
  1162. rol dd16sH
  1163. dec dcnt16s ;decrement counter
  1164. brne d16s_5 ;if done
  1165. sbrs d16s,7 ; if MSB in sign register set
  1166. rjmp d16s_4
  1167. com dres16sH ; change sign of result
  1168. com dres16sL
  1169. subi dres16sL,low(-1)
  1170. sbci dres16sH,high(-1)
  1171. d16s_4: ;pop r14 ;PB!!
  1172. ;pop r13 ;PB!!
  1173. ret ; return
  1174. d16s_5: rol drem16sL ;shift dividend into remainder
  1175. rol drem16sH
  1176. sub drem16sL,dv16sL ;remainder = remainder - divisor
  1177. sbc drem16sH,dv16sH ;
  1178. brcc d16s_6 ;if result negative
  1179. add drem16sL,dv16sL ; restore remainder
  1180. adc drem16sH,dv16sH
  1181. clc ; clear carry to be shifted into result
  1182. rjmp d16s_3 ;else
  1183. d16s_6: sec ; set carry to be shifted into result
  1184. rjmp d16s_3
  1185.  
  1186. ;-----------------------------------------------
  1187.  
  1188. test_div16s:
  1189. ;***** Divide Two Signed 16-Bit Numbers (-22,222/10)
  1190. ldi dd16sL,low(-22222)
  1191. ldi dd16sH,high(-22222)
  1192. ldi dv16sL,low(10)
  1193. ldi dv16sH,high(10)
  1194. rcall div16s ;result: $f752 (-2222)
  1195. ;remainder: $0002 (2)
  1196.  
  1197. forever:rjmp forever
  1198. ;----------------------------------
  1199. test_slashMod:
  1200. ldi r16,$12
  1201. mypush r16
  1202. ldi r16,$34
  1203. mypush r16
  1204. ldi r16,$56 ;NB this is $3412 not $1234
  1205. mypush r16
  1206. ldi r16,$00
  1207. mypush r16
  1208. rcall slashMod ;$3412 / $56 = $9b rem 0 works
  1209. tslm: rjmp tslm
  1210.  
  1211. ;---------------------------------------
  1212. ;From http://www.avr-asm-tutorial.net/avr_en/calc/CONVERT.html#hex2bin
  1213. ; Hex4ToBin2
  1214. ; converts a 4-digit-hex-ascii to a 16-bit-binary
  1215. ; In: Z points to first digit of a Hex-ASCII-coded number
  1216. ; Out: T-flag has general result:
  1217. ; T=0: rBin1H:L has the 16-bit-binary result, Z points
  1218. ; to the first digit of the Hex-ASCII number
  1219. ; T=1: illegal character encountered, Z points to the
  1220. ; first non-hex-ASCII character
  1221. ; Used registers: rBin1H:L (result), R0 (restored after
  1222. ; use), rmp
  1223. ; Called subroutines: Hex2ToBin1, Hex1ToBin1
  1224.  
  1225. .def rBin1H =r17
  1226. .def rBin1L = r16
  1227. .def rmp = r18
  1228. ;
  1229. Hex4ToBin2:
  1230. clt ; Clear error flag
  1231. rcall Hex2ToBin1 ; convert two digits hex to Byte
  1232. brts Hex4ToBin2a ; Error, go back
  1233. mov rBin1H,rmp ; Byte to result MSB
  1234. rcall Hex2ToBin1 ; next two chars
  1235. brts Hex4ToBin2a ; Error, go back
  1236. mov rBin1L,rmp ; Byte to result LSB
  1237. sbiw ZL,4 ; result ok, go back to start
  1238. Hex4ToBin2a:
  1239. ret
  1240. ;
  1241. ; Hex2ToBin1 converts 2-digit-hex-ASCII to 8-bit-binary
  1242. ; Called By: Hex4ToBin2
  1243. ;
  1244. Hex2ToBin1:
  1245. push R0 ; Save register
  1246. rcall Hex1ToBin1 ; Read next char
  1247. brts Hex2ToBin1a ; Error
  1248. swap rmp; To upper nibble
  1249. mov R0,rmp ; interim storage
  1250. rcall Hex1ToBin1 ; Read another char
  1251. brts Hex2ToBin1a ; Error
  1252. or rmp,R0 ; pack the two nibbles together
  1253. Hex2ToBin1a:
  1254. pop R0 ; Restore R0
  1255. ret ; and return
  1256. ;
  1257. ; Hex1ToBin1 reads one char and converts to binary
  1258. ;
  1259. Hex1ToBin1:
  1260. ld rmp,z+ ; read the char
  1261. subi rmp,'0' ; ASCII to binary
  1262. brcs Hex1ToBin1b ; Error in char
  1263. cpi rmp,10 ; A..F
  1264. brcs Hex1ToBin1c ; not A..F
  1265. cpi rmp,$30 ; small letters?
  1266. brcs Hex1ToBin1a ; No
  1267. subi rmp,$20 ; small to capital letters
  1268. Hex1ToBin1a:
  1269. subi rmp,7 ; A..F
  1270. cpi rmp,10 ; A..F?
  1271. brcs Hex1ToBin1b ; Error, is smaller than A
  1272. cpi rmp,16 ; bigger than F?
  1273. brcs Hex1ToBin1c ; No, digit ok
  1274. Hex1ToBin1b: ; Error
  1275. sbiw ZL,1 ; one back
  1276. set ; Set flag
  1277. Hex1ToBin1c:
  1278. ret ; Return
  1279. ;--------------------------------------
  1280. test_Hex4ToBin2:
  1281. pushz
  1282. ldi zl,$60
  1283. clr zh ;z now points to start of buf1
  1284. ldi r16,'0'
  1285. st z+,r16
  1286. ldi r16,'f'
  1287. st z+,r16
  1288. ldi r16,'2'
  1289. st z+,r16
  1290. ldi r16,'3'
  1291. st z+,r16
  1292. ldi zl,$60
  1293. clr zh ;z now points back to start of buf1
  1294. rcall Hex4ToBin2
  1295. popz
  1296. th4: rjmp th4
  1297. ;-------------------------------------
  1298. numberh: ;word not in dictionary. Try to convert it to hex.
  1299. pushz ;algorithm uses z, pity
  1300. movw zl,r24 ;r4,25 = w holds start of current word
  1301. ;z now points eg to '12ab'start. If t=0 then it coverts to real hex
  1302. rcall hex4ToBin2 ;try to convert
  1303. ;above call needs 4 hex digits to emerge with t=0 and binary in r16,17
  1304. ;want this. If t=0 stack r16,17 and carry on interpreting, else emerge with
  1305. ; t=1 and zpointing to first problem char
  1306. brtc gotHex
  1307. ; if here there's a problem that z is pointing to. Bail out of interpret line
  1308. clr STOP
  1309. inc STOP
  1310. rjmp outnh
  1311.  
  1312. gotHex: ;sucess.Real hex in r16,17
  1313. mypush2 r16,r17 ; so push num onto mystack
  1314. ;maybe we're compiling. If so, push num into dic preceded by a call to stackme_2
  1315. tst STATE
  1316. breq outnh ;STATE =0 means executing
  1317. ; rcall tic
  1318. ; .db "stackme_2" ;has to be in dic before a number. cfa of stackme_2 on stack
  1319. rcall compstackme_2
  1320. ; rcall compileme ;insert "rcall stackme_2"opcode into dic
  1321. rcall comma ;there's the number going in
  1322.  
  1323. outnh:
  1324. popz ; but will it be pointing to "right"place in buf1? Yes now OK
  1325.  
  1326. ret
  1327. ; numberh not working fully, ie doesn't point to right place after action.
  1328. ; also no action if not a number? DONE better save this first.
  1329. ;---------------------------------
  1330. ;eeroutines
  1331. eewritebyte: ;write what's in r16 to eeprom adr in r18,19
  1332. sbic EECR,EEPE
  1333. rjmp eewritebyte ;keep looping til ready to write
  1334. ;if here the previous write is all done and we can write the next byte to eeprom
  1335. out EEARH,r19
  1336. out EEARL,r18 ;adr done
  1337. out EEDR,r16 ;byte in right place now
  1338. sbi EECR,EEMPE
  1339. sbi EECR,EEPE ;last 2 instruc write eprom. Takes 3.4 ms
  1340. ret
  1341. ;test with %!
  1342. ;---------------------------------
  1343. eereadbyte: ; read eeprom byte at adr in r18,19 into r16
  1344. ; Wait for completion of previous write
  1345. sbic EECR,EEPE
  1346. rjmp eereadbyte
  1347. ; Set up address (r18:r17) in address register
  1348. out EEARH, r19
  1349. out EEARL, r18
  1350. ; Start eeprom read by writing EERE
  1351. sbi EECR,EERE
  1352. ; Read data from data register
  1353. in r16,EEDR
  1354. ret
  1355. ;------------------------------
  1356. setupforflashin: ;using here etc get appropriate page, offset,myhere values.
  1357. ldi r16,low(HERE)
  1358. ldi r17,high(HERE) ;get here, but from eeprom better?
  1359. mypush2 r16,r17
  1360. rcall stackme_2
  1361. .dw 0002
  1362. rcall star ;now have current HERE in bytes in flash. But what is myhere?
  1363. rcall stackme_2
  1364. .db $0040 ;64 bytes per page
  1365. rcall slashMod
  1366. ;offset on top pagenum under. eg pg 0047, offset 0012
  1367. mypop2 r9,r8 ;store offset (in bytes)
  1368. rcall stackme_2
  1369. .db $0040
  1370. rcall star ;pgnum*64 = byte adr of start of flash page
  1371. mypop2 r7,r6
  1372. mypush2 r8,r9 ;push back offset
  1373. rcall stackme_2
  1374. .dw buf2
  1375. nop
  1376. ;at this stage we have offset in r8,r9 (0012). Also byte adr of flash page
  1377. ; start in r6,r7.(11c0) Stk is (offset buf2Start --) (0012 00E0 --). Need to
  1378. ; add these two together to get myhere, the pointer to RAM here position.
  1379. rcall plus ;add offset to buf2 start to get myhere (00f2)
  1380. ; put my here in r4,r5 for time being.
  1381. mypop2 r5,r4 ;contains eg 00f2 <--myhere
  1382. pushz ;going to use z so save it
  1383. movw zl,r6 ;r6,7 have byte adr of flsh pg strt
  1384. pushx ;save x
  1385. ldi xl,low(buf2)
  1386. ldi xh,high(buf2) ;point x to start of buf2
  1387. ldi r18,128 ;r18=ctr. Two flash pages = 128 bytes
  1388. upflash:
  1389. lpm r16,z+ ;get byte from flash page
  1390. st x+, r16 ; and put into buf2
  1391. dec r18
  1392. brne upflash
  1393. ;done. Now have two flash pages in ram in buf2. Myhere points to where next
  1394. ; entry will go. Where's page num?
  1395. popx
  1396. popz ;as if nothing happened
  1397.  
  1398.  
  1399. ret
  1400.  
  1401.  
  1402.  
  1403. ;outsufi: rjmp outsufi
  1404. ;-----------------------------------
  1405. burneepromvars: ;send latest versions of eHERE and eLATEST to eeprom
  1406. ldi r16,low(HERE)
  1407. ldi r17,high(HERE)
  1408. mypush2 r16,r17
  1409. ;up top we have .equ eHERE = $0010
  1410. ldi r16,low(eHERE)
  1411. ldi r17,high(eHERE)
  1412. mypush2 r16,r17
  1413. ;now have n16 eadr on stack ready for e!
  1414. rcall percentstore
  1415.  
  1416. ;send latest versions of eLATEST to eeprom
  1417. ldi r16,low(LATEST)
  1418. ldi r17,high(LATEST)
  1419. mypush2 r16,r17
  1420. ;up top we have .equ eLATEST = $0010
  1421. ldi r16,low(eLATEST)
  1422. ldi r17,high(eLATEST)
  1423. mypush2 r16,r17
  1424. ;now have n16 eadr on stack ready for e!
  1425. rcall percentstore
  1426. ret
  1427. ;-------------------------------------------
  1428. coloncode: ;this is the classic colon defining word.
  1429. rcall setupforflashin ;get all the relevant vars and bring in flash to buf2
  1430. rcall relinkcode ; insert link into first cell
  1431. rcall create ;compile word preceeded by length
  1432. rcall leftbrac ;set state to 1, we're compiling
  1433. ret ;now every word gets compiled until we hit ";"
  1434. ;-------------------------
  1435. relinkcode: ;put LATEST into where myhere is pointing and update ptr = myhere
  1436. ;also create mylatest
  1437. rcall getlatest ;now on stack
  1438. mypopa ;latest in r16,17
  1439. pushz ;better save z
  1440. movw mylatest,myhere ;mylatest <-- myhere
  1441. movw zl,myhere ;z now points to next available spot in buf2
  1442. st z+,r17 ;problem. Don't work unless highbye first in mem.Why?
  1443. st z+,r16 ;now have new link in start of dic word
  1444. movw myhere,zl ;update myhere to point to length byte. (Not yet there.)
  1445. popz ;restore z
  1446. ret
  1447. ;-------------------------------------------------
  1448. create: ;put word after ":" into dictionary, aftyer link, preceeded by len
  1449. rcall word ;start with x pnting just after ":".End with len in r20, x pointing to
  1450. ; space just after word and start of word in w=r24,25
  1451. pushz ;save z. It's going to be used on ram dictionary
  1452. movw zl,myhere ;z now pnts to next spot in ram dic
  1453. st z+,r20 ; put len byte into ram dic
  1454. mov r18,r20 ;use r18 as ctr, don't wreck r20
  1455. pushx ;save x. It's going to be word ptr in buf1
  1456. movw xl,wl ;x now points to start of word. Going to be sent to buf2
  1457. sendbytes:
  1458. ld r16,x+ ;tx byte from buf1 to
  1459. st z+,r16 ; buf2
  1460. dec r18 ;repeat r20=r18=len times
  1461. brne sendbytes
  1462.  
  1463. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  1464. rjmp downcr
  1465. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  1466. clr r16
  1467. st z+,r16 ;insert padding byte
  1468. ;inc r30
  1469. ;brcc downcr
  1470. ;inc r31 ;add one to z before converting to bytes
  1471.  
  1472. downcr:
  1473. movw myhere,zl ;myhere now points to beyond word in dic
  1474. popx
  1475. popz
  1476. ret ;with word in dic
  1477. ;----------------------------------------------
  1478. leftbrac: ;classic turn on compiling
  1479. clr STATE
  1480. inc STATE ;state =1 ==> now compiling
  1481. ret
  1482. ;------------------------
  1483. compilecode: ;come here with STATE =1 ie compile, not execute. Want to put
  1484. ; eg rcall dup in code in dictionary but not to execute dup. If here
  1485. ; z points to byte address of word
  1486. mypush2 zl,zh
  1487. compileme:
  1488. mypush2 myhere,r5 ;push ptr to RAM dic
  1489. ;next is entry point for eg ' stackme2 already on stack and have to compile
  1490.  
  1491. ldi r16,low(buf2)
  1492. ldi r17,high(buf2) ;start of buf that conatins flash pg in RAM
  1493. mypush2 r16,r17
  1494. rcall minus ; myhere - buf2-start = offset in page
  1495. mypush2 SOFPG,r7 ;push start of flash page address
  1496. rcall plus ;SOFPG + offset = adr of next rcall in dic
  1497. ;if here we have two flash addresses on the stack. TOS = here. Next is there.
  1498. ;want to insert code for "rcall there w"hen I'm at here. eg current debugging indicates
  1499. ; here = $11EB and there is $1012 (cfa of "two"). First compute
  1500. ; relative branch "there - here -2". Then fiddle this val into the rcall opcode
  1501. rcall minus ;that;s there - here. Usu negative.
  1502. ;I got fffffffff..ffe27 for above vals. First mask off all those f's
  1503. rcall two ;stack a 2
  1504. rcall minus ;now have there-here -2 = fe24. When there,here in bytes.
  1505. mypopa ;bring fe26 into r16,17
  1506. clc
  1507. ror r17
  1508. ror r16 ;now a:= a/2
  1509. ldi r18,$ff
  1510. ldi r19,$0f ;mask
  1511. and r16,r18
  1512. and r17,r19
  1513. ; mypush2 r16,r17 ;now fe26 --> 0e26
  1514. ;the rcall opcode is Dxxx where xxx is the branch
  1515. ; mypopa ;bring fe26 into r16,17
  1516. ldi r19, $d0 ;mask
  1517. or r17,r19
  1518. mypush2 r16,r17 ;now have $de26 on stack which is (?) rcall two
  1519. rcall comma ;store this opcode into dic. myhere is ptr
  1520. ret
  1521. ;---------------------------
  1522. stackme_2: ;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack
  1523. ; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack.
  1524. pop r17
  1525. pop r16 ; they now contain eg 0x0804 which contain the 16bit num
  1526. movw zl,r16 ;z now points to cell that cobtains the number
  1527. clc
  1528. rol zl
  1529. rol zh ;double word address for z. lpm coming up
  1530.  
  1531.  
  1532.  
  1533. lpm r16,z+
  1534. lpm r17,z+ ;now have 16bit number in r16,17
  1535.  
  1536. st y+,r16
  1537. st y+, r17 ;mystack now contains the number
  1538.  
  1539. clc
  1540. ror zh
  1541. ror zl ;halve the z pointer to step past the number to return at the right place
  1542.  
  1543. push zl
  1544. push zh
  1545.  
  1546. ret
  1547. ;------------------------------flash write section--------------------
  1548.  
  1549. do_spm:
  1550. ;lds r16,SPMCSR
  1551. in r16,SPMCSR
  1552. andi r16,1
  1553. cpi r16,1
  1554. breq do_spm
  1555. mov r16,spmcsr_val
  1556. out SPMCSR,r16
  1557. spm
  1558. ret
  1559. ;-------------------------------------------------------------------
  1560. buf2ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1561. push r30 ;save for later spm work.
  1562. push r19
  1563. push xl
  1564. push xh ;used as buf_ctr but may interfere with other uses
  1565. ldi XL,low(buf2) ;X pnts to buf1 that contains the 64 bytes.
  1566. ldi XH, high(buf2)
  1567. ;assume Z is already pointing to correct flash start of page.
  1568. flashbuf:
  1569. ldi buf_ctr,32 ;send 32 words
  1570. sendr0r1:
  1571. ld r16, x+ ;get first byte
  1572. mov r0,r16 ; into r0
  1573. ld r16, x+ ; and get the second of the pair into
  1574. mov r1,r16 ; into r1
  1575. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1576. rcall do_spm ;that's r0,r1 gone in.
  1577. inc r30
  1578. inc r30
  1579. dec buf_ctr ;done 32 times?
  1580. brne sendr0r1
  1581. pop xh
  1582. pop xl
  1583. pop r19 ;dont need buf_ctr any more.
  1584. pop r30 ;for next spm job
  1585.  
  1586. ret
  1587. ;--------------------------------------------------------------------------
  1588. ;TODO just have 1 burn routine with buf different
  1589. buf3ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1590. push r30 ;save for later spm work.
  1591. push r19 ;used as buf_ctr but may interfere with other uses
  1592. push xl
  1593. push xh
  1594. ldi XL,low(buf2+64) ;X pnts to buf1 that contains the 64 bytes.
  1595. ldi XH, high(buf2+64)
  1596. ;assume Z is already pointing to correct flash start of page.
  1597. rjmp flashbuf
  1598. ldi buf_ctr,32 ;send 32 words
  1599. sendr0r3:
  1600. ld r16, x+ ;get first byte
  1601. mov r0,r16 ; into r0
  1602. ld r16, x+ ; and get the second of the pair into
  1603. mov r1,r16 ; into r1
  1604. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1605. rcall do_spm ;that's r0,r1 gone in.
  1606. inc r30
  1607. inc r30
  1608. dec buf_ctr ;done 32 times?
  1609. brne sendr0r3
  1610. pop r19 ;dont need buf_ctr any more.
  1611. pop r30 ;for next spm job
  1612. ret
  1613.  
  1614. erasePage: ; assume Z points to start of a flash page. Erase it.
  1615. ldi spmcsr_val,0x03 ;this is the page erase command
  1616. rcall do_spm
  1617. ret
  1618. ;------------------------------------------------------------------
  1619. writePage:
  1620. ldi spmcsr_val, 0x05 ;command that writes temp buffer to flash. 64 bytes
  1621. rcall do_spm
  1622. nop ; page now written. z still points to start of this page
  1623. ret
  1624. ;---------------------------------------------------------------
  1625. test_buf2ToFlashBuffer: ;(adr_flashbufstartinBytes -- )
  1626. ; rcall fillBuf
  1627. ; ldi ZH, $10
  1628. ; ldi ZL,$c0 ;z=$01c0. Start of page 67.
  1629. rcall gethere
  1630. rcall double ;want bytes not words for flash adr
  1631. mypopa ;flashPgStart byte adr now in r16,17
  1632.  
  1633.  
  1634. movw zl,r16 ;z <--start of flash buffer
  1635. rcall erasePage
  1636. rcall buf2ToFlashBuffer
  1637. rcall writePage
  1638. herettt:
  1639. rjmp herettt
  1640. ;----------------------
  1641. ; burnbuf2. Come here from ";". The pair r6,r7 point to start of flash pg (bytes)
  1642. burnbuf2and3:
  1643. movw zl,r6 ;z now pnts to start of flash buf
  1644. rcall erasePage
  1645. rcall buf2ToFlashBuffer
  1646. rcall writePage
  1647. ;now going to burn next ram buffer to next flash page. Bump Z by 64 bytes.
  1648. adiw zh:zl,63 ;z now points to start of next flash buffer
  1649. lpm r16,z+ ;advance z pointer by one.adiw only lets max of 63 to be added.
  1650. ;now z points to start of next 64 byte buffer. Time to put buf3 into it.
  1651. rcall erasePage
  1652. rcall buf3ToFlashBuffer
  1653. rcall writePage
  1654. ret
  1655. heret:
  1656. rjmp heret
  1657. ;-------------------------------------------------------------
  1658. updatevars: ;after doing a colon def we have to update sys vars
  1659. ;TODO new version of LATEST is just old version of HERE.
  1660. ; just shif HERE into LATEST in eeprom to update. Gen. tidy required.
  1661. mypush2 r4,r5 ;put myhere on stack (E8)
  1662. ldi r16,low(buf2)
  1663. ldi r17,high(buf2)
  1664. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1665. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1666. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1667. rcall plus ;SOFG + offset = new HERE
  1668. ;now put also on stack new version of LATEST
  1669. mypush2 r2,r3 ;that's mylatest on stack
  1670. ldi r16,low(buf2)
  1671. ldi r17,high(buf2)
  1672. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1673. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1674. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1675. rcall plus ;SOFG + offset = new LATEST
  1676. ; now have both LATEST (tos) and HERE on stack. Burn these into eeprom
  1677. ;up top we have .equ eLATEST = $0010
  1678. ;But it's too big. In bytes and causing probs. Solution=covert to words
  1679. rcall halve
  1680. ldi r16,low(eLATEST)
  1681. ldi r17,high(eLATEST)
  1682. mypush2 r16,r17
  1683. ;now have n16 eadr on stack ready for e!
  1684. rcall percentstore
  1685. ; TODO the value for HERE is prob in bytes too. Convert to words.
  1686. ;up top we have .equ eLATEST = $0010
  1687. ldi r16,low(eHERE)
  1688. ldi r17,high(eHERE)
  1689. mypush2 r16,r17
  1690. ;now have n16 eadr on stack ready for e!
  1691. rcall halve ;TODO check this
  1692. rcall percentstore
  1693. ret ;with stack clear and new vals for HERE and LATEST in eeprom
  1694. ;----------
  1695. ;;;;;;;;;;;;;;;;;;;;;;;;;;;Now serial stuff starts;;;;;;;;;;;;;;;;;;;;;;;;;
  1696. halfBitTime: ;better name for this delay. Half of 1/600
  1697. ;myDelay1200:
  1698. ;ldi r21,13 ; 13 works for m328 at 16Mhz
  1699. ldi r21,7 ;try 7 for tiny85 at 8Hmz
  1700. ldi r20,130 ;r20,21 at 130,7 give 833uS. Good for 600baud at 8Mhz
  1701. starthbt:
  1702. inc r20
  1703. nop
  1704. brne starthbt
  1705. dec r21
  1706. brne starthbt
  1707. ret
  1708. ;--------------------------------------------------
  1709. oneBitTime:
  1710. rcall halfBitTime
  1711. rcall halfBitTime
  1712. ret
  1713. ;-------------------------------------------------
  1714. sendAZero:
  1715. ;output 0 on Tx pin
  1716. cbi PORTB,TX_PIN ; send a zero out PB0
  1717. ret
  1718. ;-----------------------------------------------------
  1719.  
  1720. sendAOne:
  1721. ;output 1 on Tx pin
  1722. sbi PORTB,TX_PIN ; send a zero out PB0
  1723. ret
  1724. ;-----------------------------------------------------
  1725. sendStartBit:
  1726. ; send a 0 for one bit time
  1727. rcall sendAZero
  1728. rcall oneBitTime
  1729. ret
  1730. ;-------------------------------------------------------
  1731. sendNextDataBit: ;main output routine for serial tx
  1732. lsr serialByteReg ;push high bit into carry flag then inspect it
  1733. ;originally did lsl but found lsb first.
  1734. brcc gotzero ;if it's a 0 do nothing
  1735. rcall sendAOne ;must have been a 1 in carry
  1736. rjmp down
  1737. gotzero:
  1738. rcall sendAZero ;if here carry was a zero
  1739. down:
  1740. rcall oneBitTime ;so that 1 or 0 lasts 1/600 sec
  1741. ret
  1742. ;-------------------------------------------------------------
  1743. send8DataBits: ; send all bits in serialByteReg
  1744. ldi counterReg,8 ;8 data bits
  1745. sendBit:
  1746. rcall sendNextDataBit
  1747. dec counterReg
  1748. brne sendBit
  1749. ret
  1750. ;--------------------------------------------------------
  1751. sendStopBit:
  1752. ; send a 1 for one bit time
  1753. rcall sendAOne
  1754. rcall oneBitTime
  1755. ret
  1756. ;--------------------------------------------------------
  1757. sendSerialByte: ;main routine. Byte in serialByteReg = r16
  1758. push counterReg
  1759. rcall sendStartBit
  1760. rcall send8DataBits
  1761. rcall sendStopBit
  1762. rcall sendStopBit ;two stops
  1763. pop counterReg
  1764. ret
  1765. ;**************************************************************
  1766. serialTest0: ;output series of 'AAAA..'s
  1767. ldi serialByteReg, 0x43 ;0x41
  1768. rcall sendSerialByte
  1769. rcall oneBitTime ; take a rest
  1770. ldi r16,$44
  1771. mypush r16
  1772. rcall emitcode
  1773.  
  1774. rjmp serialTest0 ;continue forever
  1775. ;---------------------------------------------------------
  1776. ;---------Now do SerialRx routines-------------------
  1777. waitForHigh: ;loop til RX is high
  1778. sbis PINB,RX_PIN ;test that pin for set (PB2)
  1779. rjmp waitForHigh ; loop if rx pin is low
  1780. ret
  1781. ;-----------------------------------------------
  1782. waitForLow: ;PRONBLEMs loop til RX is low. FIXED.
  1783. sbic PINB,2 ;test that pin for set (PB2)
  1784. rjmp waitForLow ; loop if rx pin is high
  1785. ret
  1786. ;---------------------------------------------------
  1787. waitForStartBit: ;loop til get a real start bit
  1788. rcall waitForHigh ;should be marking at start
  1789. rcall waitForLow ;gone low. might be noise
  1790. rcall halfBitTime ;is it still low in middle of bit time
  1791. sbic PINB,RX_PIN ;..well, is it?
  1792. rjmp waitForStartBit ;loop if level gone back high. Not a start bit.
  1793. ret ;we've got our start bit
  1794. ;----------------------------------------------------
  1795. checkForStopBit: ;at end, get carry flag to reflect level. Prob if c=0
  1796. rcall oneBitTime ; go into stop bit frame, halfway
  1797. sec ;should stay a 1 in C if stop bit OK
  1798. sbis PINB,RX_PIN ;don't clc if bit is high
  1799. clc ;but only if we have a weird low stop bit
  1800. ret ;with carry flag = stop bit. Should be a 1
  1801. ;-------------------------------------------------------------
  1802. get8Bits: ;get the 8 data bits. No frame stuff
  1803. clr rxbyte ;this will fill up with bits read from RX_PIN
  1804. push counterReg ;going to use this so save contents for later
  1805. ldi counterReg,8 ;because we're expecting 8 databits
  1806. nextBit:
  1807. rcall oneBitTime ;first enter here when mid-startbit
  1808. rcall rxABit ;get one bit
  1809. dec counterReg ;done?
  1810. brne nextBit ;no, round again
  1811. pop counterReg ;yes, finished, restor counter and get out
  1812. ret
  1813. ;---------------------------------------------------------------
  1814. rxABit: ;big serial input routine for one bit
  1815. clc ;assume a 0
  1816. sbic PINB,RX_PIN ; skip nxt if pin low
  1817. sec ;rx pin was high
  1818. ror rxbyte ;carry flag rolls into msb first
  1819. ret
  1820. ;********************************
  1821. getSerialByte: ;big routine. Serial ends up in rxByte
  1822. push counterReg
  1823. rcall waitForStartBit ;**change
  1824. rcall get8Bits
  1825. rcall checkForStopBit
  1826. pop counterReg
  1827. ret ;with rxByte containing serial bye
  1828. ;----------------------------------------------------
  1829. serialTest1: ;output A then reflect input. Worked OK
  1830. ldi serialByteReg, 0x36 ;0x41
  1831. rcall sendSerialByte
  1832. rcall oneBitTime ; take a rest
  1833. rcall getSerialByte
  1834. mov serialByteReg,rxByte ;output what's been read
  1835. rcall sendSerialByte
  1836. rjmp serialTest1
  1837. ;--------------------------------------------------------
  1838. ;----------Now doing buffer work. Want to and from 64 bytes----------
  1839. fillBuf:
  1840. ldi ZL,low(buf1) ;buf1 is my buffer
  1841. ldi ZH, high(buf1) ;Z now points to buf1
  1842. ldi counterReg,64 ;64 bytes in buffer
  1843. ldi r16,$30
  1844. storeB0:
  1845. st z+,r16
  1846. inc r16
  1847. dec counterReg
  1848. brne storeB0
  1849. herefb:
  1850. ; rjmp herefb
  1851. ret
  1852. ;----------------------------------------------------------
  1853. serialStrOut: ;X points to start of string,r17 has length
  1854. ld serialByteReg, x+
  1855.  
  1856. rcall sendSerialByte
  1857. dec r17 ;got to end of string?
  1858. brne serialStrOut
  1859. ret
  1860. ;----------------------------------
  1861. test_serialStrOut:
  1862. rcall fillBuf
  1863. ldi XL,low(buf1) ;buf1 start of str
  1864. ldi XH, high(buf1)
  1865. ldi r17,64 ;going to send len=r17 bytes
  1866. rcall serialStrOut
  1867. here2:
  1868. rjmp here2
  1869. ;--------------------------------------
  1870. waitForCharD: ;wait til eg a 'D' is pressed then do something.
  1871. ldi serialByteReg, '>' ;0x41
  1872. rcall sendSerialByte
  1873. rcall oneBitTime ; take a rest
  1874. rcall getSerialByte
  1875. mov serialByteReg,rxByte ;output what's been read
  1876. cpi rxByte, 'D'
  1877. brne waitForCharD
  1878. ldi serialByteReg, '*'
  1879. rcall sendSerialByte
  1880. rjmp waitForCharD
  1881. ;-----------------------------------------------------------
  1882. dumpbuf1:
  1883. ldi XL,low(buf1) ;buf1 start of str
  1884. ldi XH, high(buf1)
  1885. ldi r17,64 ;going to send len=r17 bytes
  1886. rcall serialStrOut
  1887. ret
  1888. ;-------------------------------------------------------------
  1889. test_dumpbuf1:
  1890. rcall fillBuf
  1891. rcall getSerialByte ;any one will do.
  1892. rcall dumpbuf1
  1893. rjmp test_dumpbuf1
  1894. ;----------------------------------------------------------
  1895. waitForDDump: ;wait til eg a 'D' is pressed then dump buf1
  1896. ldi serialByteReg, '>' ;0x41
  1897. rcall sendSerialByte
  1898. rcall oneBitTime ; take a rest
  1899. rcall getSerialByte
  1900. mov serialByteReg,rxByte ;output what's been read
  1901. cpi rxByte, 'D'
  1902. brne waitForDDump
  1903. rcall dumpbuf1
  1904. rjmp waitForCharD
  1905. ;---------------------------------------------------------------
  1906. rxStrEndCR: ;get a serial string that ends with CR
  1907. clr counterReg
  1908. ldi XL,low(buf1) ;buf1 is where str will go
  1909. ldi XH, high(buf1)
  1910. upsec:
  1911. rcall getSerialByte
  1912. cpi rxByte,$0d ;is it CR = end of string?
  1913. breq fin
  1914. st x+, rxByte ;char goes into buffer="buf1"
  1915. inc counterReg ;don't go over 64 bytes
  1916. cpi counterReg,64
  1917. brne upsec ;not too long and not CR so keep going
  1918. fin:
  1919. ret
  1920. ;---------------------------------------------
  1921. test_rxStrEndCR: ;just a test of above
  1922. rcall rxStrEndCR
  1923. rcall waitForDDump
  1924. rjmp test_rxStrEndCR
  1925. ;------------------------------------------------------
  1926. test2_rxStrEndCR: ;want a diagnostic dump if testing. Works with .IFDEF
  1927. rcall rxStrEndCR
  1928. .IFDEF testing
  1929. rcall dumpbuf1
  1930. .ENDIF
  1931. rjmp test2_rxStrEndCR
  1932. ;------------------------------------------------------------
  1933. rxStrWithLen: ;expect len char char char.. for len chars
  1934. push counterReg
  1935. ldi XL,low(buf1) ;buf1 is where str will go
  1936. ldi XH, high(buf1)
  1937. rcall getSerialByte ; get length bye Must be less than 65
  1938. mov counterReg, rxByte ;save len in counter
  1939. cpi counterReg,65 ;
  1940. brlo allOK ;less than 65 so carry on. Branch if Lower
  1941. ldi counterReg,64 ; if len>64 then len=64. Buffer = buf1 only 64 bytes
  1942. allOK:
  1943. tst counterReg ;zero yet?
  1944. breq finrs
  1945. rcall getSerialByte ;next serial input byte
  1946. st x+, rxByte ;put into buffer
  1947. dec counterReg ;have we done len=counterReg bytes?
  1948. rjmp allOK
  1949. finrs:
  1950. pop counterReg
  1951. ret
  1952. ;---------------------------------------------------------------
  1953. test_rsStrWithLen: ;works ok with macro $05GHIJKLM. Sends GHIJK
  1954. ldi r16, '#'
  1955. rcall sendSerialByte
  1956. rcall rxStrWithLen
  1957. rcall dumpbuf1
  1958. rjmp test_rsStrWithLen
  1959. ;-----------------------------now start forth i/o words like emit------------------
  1960. emitcode: ; (n8 --)classic emit
  1961. mypop r16
  1962. rcall sendserialbyte
  1963. ret
  1964. ;------------------------------------------------
  1965. insertret: ;semi has to end new word with ret = $9508 opcode
  1966. pushx ;both xl,xh saved for later
  1967. movw xl,myhere ;myhere points to next available spot in ram dic
  1968. ldi r16,$08
  1969. st x+,r16 ;$08 part goes first
  1970. ldi r16,$95
  1971. st x+,r16 ;ret now in ram. Just tidy pointers
  1972. movw myhere,xl
  1973. popx ;so x back where it was and ret inserted.
  1974. ret
  1975. ;--------------------------------
  1976. equalcode: ;(n1 n2 -- flag) if n1 = n2 flag = 0001 else 0000
  1977. mypopa
  1978. mypopb ; now have TOS in r16,17, underneath that in r18,19
  1979. cp r16,r18 ;low bytes =?
  1980. brne zout ;not equal so go out
  1981. cp r17,r19 ;hi bytes =?
  1982. brne zout ;no, so out
  1983. ;if here both n16's are equal so push a 0001
  1984. rcall one
  1985. rjmp aout ;done
  1986. zout:
  1987. rcall zero ;not = so push a zero
  1988. aout:
  1989. ret ;with a flag on stack replacing to n16's
  1990. ;------------------------------
  1991. ;TODO eliminate below and replace with simpler RAM jmp code.
  1992. calcjumpcode: ;(to from -- opcode_for_rjmp to at from)
  1993. ;used when compiling. What is the rjmp opcode if
  1994. ; we know the from and to adr on stack. ( to fr --)
  1995. ldi r16, low(buf2)
  1996. ldi r17, high(buf2)
  1997. mypush2 r16,r17 ; (to fr $e0 --)
  1998. rcall dup ;t f $e0 $eo
  1999. rcall unrot ;t $e0 fr $e0
  2000. rcall minus ;t $e0 frOffset
  2001. rcall unrot ;frOffset t $e0
  2002. rcall minus ;frOffset toOffset
  2003. ;now apply these offsets in flash buffer. Add them to start of flash buffer adr
  2004. mypush2 SOFPG,r7 ; frOffset toOffset SOFPG
  2005. rcall dup ;frOffset toOffset SOFPG SOFPG
  2006. rcall unrot ;frOffset SOFPG toOffset SOFPG
  2007. rcall plus ;frOffset SOFPG toFlashAdr
  2008. rcall unrot ;toFlashAdr frOffset SOFPG
  2009. rcall plus ;toFlashAdr frFlashAdr
  2010. rcall minus ;to -from give last 3 nibbles in rjmp opcode +1
  2011. rcall one
  2012. rcall minus ; now have to - from -1
  2013. rcall stackme_2
  2014. .dw $0fff
  2015. rcall andd ; now have eg. 0f20. Want Cf20
  2016. rcall stackme_2
  2017. .dw $c000 ;should now have right opcode eg cf20
  2018. ret ;with correct rjmp kkk on stack. Ready to insert into RAM dic.
  2019. ;-------------------
  2020. stackmyhere: ;( --- adr) put RAM ptr myhere on stack
  2021. mypush2 myhere, r5
  2022. ret
  2023. ;---------------------------
  2024. begincode: ;when using BEGIN just stack current address.No dic entry
  2025. rcall stackmyhere ;put next adr on stack
  2026. ret
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!