API tools faq
paste
prjbrook

forth85_24. Input line problems. Messy

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