API tools faq
paste
prjbrook

forth85_23 Nearly live. buf1 input probs

prjbrook
Aug 12th, 2014
274
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 69.25 KB | None | 0 0
raw download clone embed print report
  1. ;this is forth85_23 Tidies up forth85_22
  2. ;Going live is next step.
  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. takemeout '('
  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. .ifdef testing
  780. nop
  781. quithere:
  782. rjmp quithere ;only want one line interpreted when testing
  783. .else
  784. rjmp forthloop
  785. .endif
  786. ;-------------------------------------------------------
  787.  
  788.  
  789. ;rjmp test_interpretLine
  790. ;rjmp test_cfetch
  791. ;rjmp test_store
  792. ;rjmp test_cstore
  793. ;rjmp test_mpy16s
  794. ;rjmp test_mpy16s0
  795. ;rjmp test_star
  796. ;rjmp test_div16s
  797. ;rjmp test_slashMod
  798. ;rjmp test_Hex4ToBin2
  799. rjmp test_interpretLine
  800. ;rjmp setupforflashin
  801. ;rcall coloncode
  802. ;rjmp test_buf2ToFlashBuffer
  803. ;rjmp serialTest0
  804. ;zzz
  805.  
  806. stopper: rjmp stopper
  807. ; rjmp start
  808. ;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
  809. mainloop: ;this is forth. This is run continuously. Needs two versions: live and simulation.
  810. ; rcall quit
  811. rcall getline0
  812. rcall interpretLine
  813. ret
  814. ;--------------------------------------------------------------
  815. getline0: ;force a line into buf1 via flash string. Simulates GETLINE
  816. ldi zl, low(typein<<1)
  817. ldi zh, high(typein<<1)
  818. ldi xl, low(buf1)
  819. ldi xh, high(buf1)
  820. type0:
  821. lpm r16,Z+
  822. st x+,r16
  823. cpi r16,0x0d ;have we got to the end of the line?
  824. brne type0
  825. ret
  826. ;--------------------------------------------
  827. ;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20
  828. ;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char
  829. word: ;maybe give it a header later
  830. ld SECONDLETTER, x ;for debugging. TODO. Should be firstletter?
  831.  
  832. ld r16,x+ ;get char
  833.  
  834. cpi r16,0x20 ;is it a space?
  835. breq word ;if so get next char
  836. ;if here we're point to word start. so save this adr in w
  837. mov r24,xl
  838. mov r25,xh ;wordstart now saved in w
  839.  
  840.  
  841. clr r20 ;length initially 0
  842. nextchar:
  843. inc r20 ;r20 = word length
  844. ld r16,x+ ;get next char
  845. cpi r16,0x20
  846. brne nextchar
  847. dec r24 ;adjust start of word
  848. ;if here we've found a word.Starting at w length in r20.x points to space just past word
  849. ret
  850. ;----------------------------------------
  851.  
  852. 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.
  853. ; and the word in buf1 is pointed to by w=r24,25. len = r20. Z on entry points to the link. Needs +2 to
  854. lpm r23,z+
  855. lpm r22,z+ ;store next link in v=r22,23. z now points to len byte
  856.  
  857. startc:
  858. ;TODO save copy of flash word in r21 and also do masking of immediates
  859. push r20 ;save length
  860. lpm r16,Z+ ;length of dictionary word, first entry now in r16
  861. mov r21,r16 ;copy length-in-flash to r21. May have immediate bit (bit 7)
  862. andi r16,$0f ;mask off top nibble before comparing
  863. cp r16,r20 ;same lengths?
  864. brne outcom ;not = so bail out
  865. ;if here the words are the same length, what about the rest of the chars.First get x to point to word.
  866. mov xl,r24
  867. mov xh,r25 ;x now point to start of buf1 word
  868. upcom:
  869. lpm r16,z+
  870. ld r17,x+ ;get one corresponding char from each word
  871. cp r16,r17 ;same word?
  872. brne outcom ;bail out if chars are different
  873. dec r20 ;count chars
  874. brne upcom ;still matching and not finished so keep going
  875. ;if here r20 is 0 so match must have been perfect so FOUND = 1
  876. clr FOUND
  877. inc FOUND
  878. outcom:
  879. pop r20 ;get old lngth of buf1 word back
  880. ret
  881. ;-------------------------------------------
  882. jmpNextWord: ;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte)
  883. ; and w = r24,25 contains RAM word start with len in r20
  884. ;exit with z pointing to next word ready for next COMPARE.
  885. clc
  886. rol r22
  887. rol r23 ;above 3 instructions change word address into byte address by doubling
  888. movw r30,r22 ;z now points to next word
  889. ret
  890. ;-----------------------------------------
  891.  
  892. doLatest: ;set up so first jump in dictionary is to top=LATEST and other flags set up.
  893. ; ldi vl, low(LATEST)
  894. ; ldi vh, high(LATEST)
  895. nop
  896. rcall getlatest ;from eeprom. Now on stack
  897. mypop2 vh,vl ;this is in bytes Need to halve it.
  898. ; rcall halve
  899. clr FOUND
  900. clr BOTTOM ;not yet found the match, not yet at the bottom. Either will stop search.
  901. clr STOP ;keep parsing words til this goes to a 1
  902. ret
  903. ;---------------------------------------------
  904. interpretLine: ;given line of words in buf one, search for words one by one. Don't do code
  905. ; or compile at this stage, just find and report that and go into next one.
  906. ; rcall getline0 ;change later to real getline via terminal
  907. rcall pasteEOL
  908. ldi xl, low(buf1)
  909. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  910. clr FOUNDCOUNTER ;counts finds in line parsing.
  911.  
  912. nextWord:
  913. tst STOP
  914. brne stopLine
  915. rcall word
  916. rcall findWord ;not done yet
  917. rcall dealWithWord ;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le}
  918. rjmp nextWord
  919. stopLine:
  920. ret
  921. ;-----------------------------------------------------------------
  922. findWord:
  923. rcall doLatest
  924. nop
  925. upjmpf:
  926. rcall jmpNextWord
  927. rcall compare
  928. tst FOUND
  929. brne stopsearchf ;if last compare got a match (FOUND=1) then stop searching
  930. tst vl
  931. brne upjmpf ;if v=0000 then we've hit the bottom of the dictionary
  932. tst vh
  933. brne upjmpf ;not found and not at bottom so keep going
  934. ;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
  935. clr BOTTOM
  936. inc BOTTOM ;exit with FOUND=0 and BOTTOM =1
  937. stopsearchf: nop
  938. ret
  939. ;----------------------------
  940. test_interpretLine:
  941. rcall interpretLine
  942. til: rjmp til ;** with r24 pointing to 'S' and FOUND = r15 =1
  943. ;------------------------------
  944. dealWithWord: ;come here when it's time to compile or run code
  945. ;Good debugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just
  946. ; 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
  947. ; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match
  948. ;
  949. nop
  950. tst FOUND
  951. breq notfound
  952. inc FOUNDCOUNTER
  953.  
  954. ;want to hop over filler bytes,0's added to keep codes on even byte boundaries
  955. ; so if r30 is odd at this stage inc it. odd is lsbit = 1.
  956. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  957. rjmp downd
  958. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  959. inc r30
  960. brcc downd
  961. inc r31 ;add one to z before converting to bytes
  962. ;have to ask at this point, is the word immediate? If so, bit 7 of r21 will be set.
  963. downd:
  964. sbrs r21,7
  965. rjmp downdw ;not immediate so just go on with STATE test
  966. rjmp executeme ;yes, immediate so execute every time.
  967.  
  968.  
  969. downdw: tst STATE
  970. breq executeme
  971. rcall compilecode
  972. rjmp outdww
  973. executeme:
  974. clc
  975. ror zh
  976. ror zl ;put z back into word values
  977.  
  978.  
  979. rcall executeCode
  980.  
  981.  
  982.  
  983. .MESSAGE "Word found"
  984. rjmp outdww
  985. notfound:
  986. nop
  987. ; .MESSAGE "Word not found"
  988. ; clr STOP
  989. ; inc STOP ;stop parsing line
  990. rcall numberh ; word not in dict so must be a number? Form = HHHH
  991. ;now have to add 3 to x so it points past this word ready not next one
  992. clc
  993. inc r26
  994. inc r26
  995. inc r26
  996. brcc outdww
  997. inc r27 ;but only if overflow
  998. nop
  999. outdww:
  1000. ret ;with STOP =1 in not a number
  1001. ;------------------------------------------------------------------------
  1002. pasteEOL: ;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a
  1003. ; special end of line word. When the word is invoked it casues a QUIT back to the waiting for input stage.
  1004. ; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 "
  1005. ldi xl, low(buf1)
  1006. ldi xh, high(buf1) ;pnt to start of buffer
  1007. clr r17
  1008. nxtChar:
  1009. inc r17 ;r17 is counter. Bail out when r17 > BUF1LENGTH
  1010. cpi r17, BUF1LENGTH -3
  1011. breq outProb
  1012. ld r16, x+
  1013. cpi r16, $0d
  1014. brne nxtChar
  1015. ;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it.
  1016. ldi r16,$20
  1017. st -x, r16 ;back up. Then go forward.
  1018. ; ldi r16, ']'
  1019. st x+, r16
  1020. ldi r16,'S'
  1021. st x+, r16
  1022. ; ldi r16, '}'
  1023. ; st x+, r16
  1024. ldi r16, $20
  1025. st x, r16
  1026. rjmp outpel
  1027.  
  1028.  
  1029. outProb:
  1030. nop
  1031. .MESSAGE "Couldn't find $0d"
  1032. outpel:
  1033. ret
  1034.  
  1035. ;-------------------------------------
  1036. executeCode: ;with Z pointing to cfa. Not sure whether to jmp or call
  1037.  
  1038. ijmp
  1039. ret
  1040. ;---------------------------------------
  1041. test_fetch: ;do run thru of @
  1042. rcall getline0 ;change later to real getline via terminal
  1043. rcall pasteEOL
  1044. ldi xl, low(buf1)
  1045. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1046.  
  1047. ldi r16,$62
  1048. mypush r16
  1049. ldi r16,$0
  1050. mypush r16 ;should now have adr $0062 on mystack
  1051. rcall fetch
  1052. tf1:
  1053. rjmp tf1
  1054. ;---------------------------------
  1055. test_cfetch: ;do run thru of @
  1056. rcall getline0 ;change later to real getline via terminal
  1057. rcall pasteEOL
  1058. ldi xl, low(buf1)
  1059. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1060.  
  1061. ldi r16,$62
  1062. mypush r16
  1063. ldi r16,$0
  1064. mypush r16 ;should now have adr $62 on mystack
  1065. rcall cfetch
  1066. tcf1:
  1067. rjmp tcf1
  1068. ;----------------------------
  1069. test_store:
  1070. rcall getline0 ;change later to real getline via terminal
  1071. rcall pasteEOL
  1072. ldi xl, low(buf1)
  1073. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1074. ldi r16,$62
  1075. ldi r17,$0
  1076. mypush2 r16,r17 ;should now have adr $62 on mystack
  1077. ldi r16, $AB
  1078. ldi r17, $CD
  1079. mypush2 r16,r17 ;now have $ABCD on mystack
  1080. rcall store
  1081. ts1:
  1082. rjmp ts1
  1083. ;------------------------
  1084. test_cstore:
  1085. rcall getline0 ;change later to real getline via terminal
  1086. rcall pasteEOL
  1087. ldi xl, low(buf1)
  1088. ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop.
  1089. ldi r16,$62
  1090. ldi r17,$0
  1091. mypush2 r16,r17 ;should now have adr $62 on mystack
  1092. ldi r16, $AB
  1093. ; ldi r17, $CD
  1094. mypush r16 ;now have $ABCD on mystack
  1095. rcall cstore
  1096.  
  1097. ts11:
  1098. rjmp ts11
  1099. ;Now put arith routines here. Are from AVR200. Just using 16*16 for * but get 32bit result.
  1100.  
  1101.  
  1102. ;***************************************************************************
  1103. ;*
  1104. ;* "mpy16s" - 16x16 Bit Signed Multiplication
  1105. ;*
  1106. ;* This subroutine multiplies signed the two 16-bit register variables
  1107. ;* mp16sH:mp16sL and mc16sH:mc16sL.
  1108. ;* The result is placed in m16s3:m16s2:m16s1:m16s0.
  1109. ;* The routine is an implementation of Booth's algorithm. If all 32 bits
  1110. ;* in the result are needed, avoid calling the routine with
  1111. ;* -32768 ($8000) as multiplicand
  1112. ;*
  1113. ;* Number of words :16 + return
  1114. ;* Number of cycles :210/226 (Min/Max) + return
  1115. ;* Low registers used :None
  1116. ;* High registers used :7 (mp16sL,mp16sH,mc16sL/m16s0,mc16sH/m16s1,
  1117. ;* m16s2,m16s3,mcnt16s)
  1118. ;*
  1119. ;***************************************************************************
  1120.  
  1121. ;***** Subroutine Register Variables
  1122.  
  1123. .def mc16sL =r16 ;multiplicand low byte
  1124. .def mc16sH =r17 ;multiplicand high byte
  1125. .def mp16sL =r18 ;multiplier low byte
  1126. .def mp16sH =r19 ;multiplier high byte
  1127. .def m16s0 =r18 ;result byte 0 (LSB)
  1128. .def m16s1 =r19 ;result byte 1
  1129. .def m16s2 =r20 ;result byte 2
  1130. .def m16s3 =r21 ;result byte 3 (MSB)
  1131. .def mcnt16s =r22 ;loop counter
  1132.  
  1133. ;***** Code
  1134. mpy16s: clr m16s3 ;clear result byte 3
  1135. sub m16s2,m16s2 ;clear result byte 2 and carry
  1136. ldi mcnt16s,16 ;init loop counter
  1137. m16s_1: brcc m16s_2 ;if carry (previous bit) set
  1138. add m16s2,mc16sL ; add multiplicand Low to result byte 2
  1139. adc m16s3,mc16sH ; add multiplicand High to result byte 3
  1140. m16s_2: sbrc mp16sL,0 ;if current bit set
  1141. sub m16s2,mc16sL ; sub multiplicand Low from result byte 2
  1142. sbrc mp16sL,0 ;if current bit set
  1143. sbc m16s3,mc16sH ; sub multiplicand High from result byte 3
  1144. asr m16s3 ;shift right result and multiplier
  1145. ror m16s2
  1146. ror m16s1
  1147. ror m16s0
  1148. dec mcnt16s ;decrement counter
  1149. brne m16s_1 ;if not done, loop more
  1150. ret
  1151. ;----------------------------------------------------------
  1152. ;***** Multiply Two Signed 16-Bit Numbers (-12345*(-4321))
  1153. test_mpy16s:
  1154. ldi mc16sL,low(-12345)
  1155. ldi mc16sH,high(-12345)
  1156. ldi mp16sL,low(-4321)
  1157. ldi mp16sH,high(-4321)
  1158. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1159. ;=$032df219 (53,342,745)
  1160. tmpy: rjmp tmpy
  1161.  
  1162. test_mpy16s0:
  1163. ldi mc16sL,low(123)
  1164. ldi mc16sH,high(123)
  1165. ldi mp16sL,low(147)
  1166. ldi mp16sH,high(147)
  1167. rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0
  1168. tmpy0: rjmp tmpy0
  1169. ;-----------------------
  1170. test_star:
  1171. ldi r16,-$7b
  1172. mypush r16
  1173. ldi r16,$00
  1174. mypush r16 ;that's decimal 123 on stack
  1175. ldi r16,$93
  1176. mypush r16
  1177. ldi r16,$00
  1178. mypush r16 ; and thats dec'147
  1179. rcall star
  1180. tsr: rjmp tsr
  1181.  
  1182. ;--------------------------
  1183. ;***************************************************************************
  1184. ;*
  1185. ;* "div16s" - 16/16 Bit Signed Division
  1186. ;*
  1187. ;* This subroutine divides signed the two 16 bit numbers
  1188. ;* "dd16sH:dd16sL" (dividend) and "dv16sH:dv16sL" (divisor).
  1189. ;* The result is placed in "dres16sH:dres16sL" and the remainder in
  1190. ;* "drem16sH:drem16sL".
  1191. ;*
  1192. ;* Number of words :39
  1193. ;* Number of cycles :247/263 (Min/Max)
  1194. ;* Low registers used :3 (d16s,drem16sL,drem16sH)
  1195. ;* High registers used :7 (dres16sL/dd16sL,dres16sH/dd16sH,dv16sL,dv16sH,
  1196. ;* dcnt16sH)
  1197. ;*
  1198. ;***************************************************************************
  1199.  
  1200. ;***** Subroutine Register Variables
  1201.  
  1202. .def d16s =r13 ;sign register
  1203. .def drem16sL=r14 ;remainder low byte
  1204. .def drem16sH=r15 ;remainder high byte
  1205. .def dres16sL=r16 ;result low byte
  1206. .def dres16sH=r17 ;result high byte
  1207. .def dd16sL =r16 ;dividend low byte
  1208. .def dd16sH =r17 ;dividend high byte
  1209. .def dv16sL =r18 ;divisor low byte
  1210. .def dv16sH =r19 ;divisor high byte
  1211. .def dcnt16s =r20 ;loop counter
  1212.  
  1213. ;***** Code
  1214.  
  1215. div16s: ;push r13 ;PB !!
  1216. ;push r14 ;PB !!
  1217. mov d16s,dd16sH ;move dividend High to sign register
  1218. eor d16s,dv16sH ;xor divisor High with sign register
  1219. sbrs dd16sH,7 ;if MSB in dividend set
  1220. rjmp d16s_1
  1221. com dd16sH ; change sign of dividend
  1222. com dd16sL
  1223. subi dd16sL,low(-1)
  1224. sbci dd16sL,high(-1)
  1225. d16s_1: sbrs dv16sH,7 ;if MSB in divisor set
  1226. rjmp d16s_2
  1227. com dv16sH ; change sign of divisor
  1228. com dv16sL
  1229. subi dv16sL,low(-1)
  1230. sbci dv16sL,high(-1)
  1231. d16s_2: clr drem16sL ;clear remainder Low byte
  1232. sub drem16sH,drem16sH;clear remainder High byte and carry
  1233. ldi dcnt16s,17 ;init loop counter
  1234.  
  1235. d16s_3: rol dd16sL ;shift left dividend
  1236. rol dd16sH
  1237. dec dcnt16s ;decrement counter
  1238. brne d16s_5 ;if done
  1239. sbrs d16s,7 ; if MSB in sign register set
  1240. rjmp d16s_4
  1241. com dres16sH ; change sign of result
  1242. com dres16sL
  1243. subi dres16sL,low(-1)
  1244. sbci dres16sH,high(-1)
  1245. d16s_4: ;pop r14 ;PB!!
  1246. ;pop r13 ;PB!!
  1247. ret ; return
  1248. d16s_5: rol drem16sL ;shift dividend into remainder
  1249. rol drem16sH
  1250. sub drem16sL,dv16sL ;remainder = remainder - divisor
  1251. sbc drem16sH,dv16sH ;
  1252. brcc d16s_6 ;if result negative
  1253. add drem16sL,dv16sL ; restore remainder
  1254. adc drem16sH,dv16sH
  1255. clc ; clear carry to be shifted into result
  1256. rjmp d16s_3 ;else
  1257. d16s_6: sec ; set carry to be shifted into result
  1258. rjmp d16s_3
  1259.  
  1260. ;-----------------------------------------------
  1261.  
  1262. test_div16s:
  1263. ;***** Divide Two Signed 16-Bit Numbers (-22,222/10)
  1264. ldi dd16sL,low(-22222)
  1265. ldi dd16sH,high(-22222)
  1266. ldi dv16sL,low(10)
  1267. ldi dv16sH,high(10)
  1268. rcall div16s ;result: $f752 (-2222)
  1269. ;remainder: $0002 (2)
  1270.  
  1271. forever:rjmp forever
  1272. ;----------------------------------
  1273. test_slashMod:
  1274. ldi r16,$12
  1275. mypush r16
  1276. ldi r16,$34
  1277. mypush r16
  1278. ldi r16,$56 ;NB this is $3412 not $1234
  1279. mypush r16
  1280. ldi r16,$00
  1281. mypush r16
  1282. rcall slashMod ;$3412 / $56 = $9b rem 0 works
  1283. tslm: rjmp tslm
  1284.  
  1285. ;---------------------------------------
  1286. ;From http://www.avr-asm-tutorial.net/avr_en/calc/CONVERT.html#hex2bin
  1287. ; Hex4ToBin2
  1288. ; converts a 4-digit-hex-ascii to a 16-bit-binary
  1289. ; In: Z points to first digit of a Hex-ASCII-coded number
  1290. ; Out: T-flag has general result:
  1291. ; T=0: rBin1H:L has the 16-bit-binary result, Z points
  1292. ; to the first digit of the Hex-ASCII number
  1293. ; T=1: illegal character encountered, Z points to the
  1294. ; first non-hex-ASCII character
  1295. ; Used registers: rBin1H:L (result), R0 (restored after
  1296. ; use), rmp
  1297. ; Called subroutines: Hex2ToBin1, Hex1ToBin1
  1298.  
  1299. .def rBin1H =r17
  1300. .def rBin1L = r16
  1301. .def rmp = r18
  1302. ;
  1303. Hex4ToBin2:
  1304. clt ; Clear error flag
  1305. rcall Hex2ToBin1 ; convert two digits hex to Byte
  1306. brts Hex4ToBin2a ; Error, go back
  1307. mov rBin1H,rmp ; Byte to result MSB
  1308. rcall Hex2ToBin1 ; next two chars
  1309. brts Hex4ToBin2a ; Error, go back
  1310. mov rBin1L,rmp ; Byte to result LSB
  1311. sbiw ZL,4 ; result ok, go back to start
  1312. Hex4ToBin2a:
  1313. ret
  1314. ;
  1315. ; Hex2ToBin1 converts 2-digit-hex-ASCII to 8-bit-binary
  1316. ; Called By: Hex4ToBin2
  1317. ;
  1318. Hex2ToBin1:
  1319. push R0 ; Save register
  1320. rcall Hex1ToBin1 ; Read next char
  1321. brts Hex2ToBin1a ; Error
  1322. swap rmp; To upper nibble
  1323. mov R0,rmp ; interim storage
  1324. rcall Hex1ToBin1 ; Read another char
  1325. brts Hex2ToBin1a ; Error
  1326. or rmp,R0 ; pack the two nibbles together
  1327. Hex2ToBin1a:
  1328. pop R0 ; Restore R0
  1329. ret ; and return
  1330. ;
  1331. ; Hex1ToBin1 reads one char and converts to binary
  1332. ;
  1333. Hex1ToBin1:
  1334. ld rmp,z+ ; read the char
  1335. subi rmp,'0' ; ASCII to binary
  1336. brcs Hex1ToBin1b ; Error in char
  1337. cpi rmp,10 ; A..F
  1338. brcs Hex1ToBin1c ; not A..F
  1339. cpi rmp,$30 ; small letters?
  1340. brcs Hex1ToBin1a ; No
  1341. subi rmp,$20 ; small to capital letters
  1342. Hex1ToBin1a:
  1343. subi rmp,7 ; A..F
  1344. cpi rmp,10 ; A..F?
  1345. brcs Hex1ToBin1b ; Error, is smaller than A
  1346. cpi rmp,16 ; bigger than F?
  1347. brcs Hex1ToBin1c ; No, digit ok
  1348. Hex1ToBin1b: ; Error
  1349. sbiw ZL,1 ; one back
  1350. set ; Set flag
  1351. Hex1ToBin1c:
  1352. ret ; Return
  1353. ;--------------------------------------
  1354. test_Hex4ToBin2:
  1355. pushz
  1356. ldi zl,$60
  1357. clr zh ;z now points to start of buf1
  1358. ldi r16,'0'
  1359. st z+,r16
  1360. ldi r16,'f'
  1361. st z+,r16
  1362. ldi r16,'2'
  1363. st z+,r16
  1364. ldi r16,'3'
  1365. st z+,r16
  1366. ldi zl,$60
  1367. clr zh ;z now points back to start of buf1
  1368. rcall Hex4ToBin2
  1369. popz
  1370. th4: rjmp th4
  1371. ;-------------------------------------
  1372. numberh: ;word not in dictionary. Try to convert it to hex.
  1373. pushz ;algorithm uses z, pity
  1374. movw zl,r24 ;r4,25 = w holds start of current word
  1375. ;z now points eg to '12ab'start. If t=0 then it coverts to real hex
  1376. rcall hex4ToBin2 ;try to convert
  1377. ;above call needs 4 hex digits to emerge with t=0 and binary in r16,17
  1378. ;want this. If t=0 stack r16,17 and carry on interpreting, else emerge with
  1379. ; t=1 and zpointing to first problem char
  1380. brtc gotHex
  1381. ; if here there's a problem that z is pointing to. Bail out of interpret line
  1382. clr STOP
  1383. inc STOP
  1384. rjmp outnh
  1385.  
  1386. gotHex: ;sucess.Real hex in r16,17
  1387. mypush2 r16,r17 ; so push num onto mystack
  1388. ;maybe we're compiling. If so, push num into dic preceded by a call to stackme_2
  1389. tst STATE
  1390. breq outnh ;STATE =0 means executing
  1391. ; rcall tic
  1392. ; .db "stackme_2" ;has to be in dic before a number. cfa of stackme_2 on stack
  1393. rcall compstackme_2
  1394. ; rcall compileme ;insert "rcall stackme_2"opcode into dic
  1395. rcall comma ;there's the number going in
  1396.  
  1397. outnh:
  1398. popz ; but will it be pointing to "right"place in buf1? Yes now OK
  1399.  
  1400. ret
  1401. ; numberh not working fully, ie doesn't point to right place after action.
  1402. ; also no action if not a number? DONE better save this first.
  1403. ;---------------------------------
  1404. ;eeroutines
  1405. eewritebyte: ;write what's in r16 to eeprom adr in r18,19
  1406. sbic EECR,EEPE
  1407. rjmp eewritebyte ;keep looping til ready to write
  1408. ;if here the previous write is all done and we can write the next byte to eeprom
  1409. out EEARH,r19
  1410. out EEARL,r18 ;adr done
  1411. out EEDR,r16 ;byte in right place now
  1412. sbi EECR,EEMPE
  1413. sbi EECR,EEPE ;last 2 instruc write eprom. Takes 3.4 ms
  1414. ret
  1415. ;test with %!
  1416. ;---------------------------------
  1417. eereadbyte: ; read eeprom byte at adr in r18,19 into r16
  1418. ; Wait for completion of previous write
  1419. sbic EECR,EEPE
  1420. rjmp eereadbyte
  1421. ; Set up address (r18:r17) in address register
  1422. out EEARH, r19
  1423. out EEARL, r18
  1424. ; Start eeprom read by writing EERE
  1425. sbi EECR,EERE
  1426. ; Read data from data register
  1427. in r16,EEDR
  1428. ret
  1429. ;------------------------------
  1430. setupforflashin: ;using here etc get appropriate page, offset,myhere values.
  1431. ldi r16,low(HERE)
  1432. ldi r17,high(HERE) ;get here, but from eeprom better?
  1433. mypush2 r16,r17
  1434. rcall stackme_2
  1435. .dw 0002
  1436. rcall star ;now have current HERE in bytes in flash. But what is myhere?
  1437. rcall stackme_2
  1438. .db $0040 ;64 bytes per page
  1439. rcall slashMod
  1440. ;offset on top pagenum under. eg pg 0047, offset 0012
  1441. mypop2 r9,r8 ;store offset (in bytes)
  1442. rcall stackme_2
  1443. .db $0040
  1444. rcall star ;pgnum*64 = byte adr of start of flash page
  1445. mypop2 r7,r6
  1446. mypush2 r8,r9 ;push back offset
  1447. rcall stackme_2
  1448. .dw buf2
  1449. nop
  1450. ;at this stage we have offset in r8,r9 (0012). Also byte adr of flash page
  1451. ; start in r6,r7.(11c0) Stk is (offset buf2Start --) (0012 00E0 --). Need to
  1452. ; add these two together to get myhere, the pointer to RAM here position.
  1453. rcall plus ;add offset to buf2 start to get myhere (00f2)
  1454. ; put my here in r4,r5 for time being.
  1455. mypop2 r5,r4 ;contains eg 00f2 <--myhere
  1456. pushz ;going to use z so save it
  1457. movw zl,r6 ;r6,7 have byte adr of flsh pg strt
  1458. pushx ;save x
  1459. ldi xl,low(buf2)
  1460. ldi xh,high(buf2) ;point x to start of buf2
  1461. ldi r18,128 ;r18=ctr. Two flash pages = 128 bytes
  1462. upflash:
  1463. lpm r16,z+ ;get byte from flash page
  1464. st x+, r16 ; and put into buf2
  1465. dec r18
  1466. brne upflash
  1467. ;done. Now have two flash pages in ram in buf2. Myhere points to where next
  1468. ; entry will go. Where's page num?
  1469. popx
  1470. popz ;as if nothing happened
  1471.  
  1472.  
  1473. ret
  1474.  
  1475.  
  1476.  
  1477. ;outsufi: rjmp outsufi
  1478. ;-----------------------------------
  1479. burneepromvars: ;send latest versions of eHERE and eLATEST to eeprom
  1480. ldi r16,low(HERE)
  1481. ldi r17,high(HERE)
  1482. mypush2 r16,r17
  1483. ;up top we have .equ eHERE = $0010
  1484. ldi r16,low(eHERE)
  1485. ldi r17,high(eHERE)
  1486. mypush2 r16,r17
  1487. ;now have n16 eadr on stack ready for e!
  1488. rcall percentstore
  1489.  
  1490. ;send latest versions of eLATEST to eeprom
  1491. ldi r16,low(LATEST)
  1492. ldi r17,high(LATEST)
  1493. mypush2 r16,r17
  1494. ;up top we have .equ eLATEST = $0010
  1495. ldi r16,low(eLATEST)
  1496. ldi r17,high(eLATEST)
  1497. mypush2 r16,r17
  1498. ;now have n16 eadr on stack ready for e!
  1499. rcall percentstore
  1500. ret
  1501. ;-------------------------------------------
  1502. coloncode: ;this is the classic colon defining word.
  1503. rcall setupforflashin ;get all the relevant vars and bring in flash to buf2
  1504. rcall relinkcode ; insert link into first cell
  1505. rcall create ;compile word preceeded by length
  1506. rcall leftbrac ;set state to 1, we're compiling
  1507. ret ;now every word gets compiled until we hit ";"
  1508. ;-------------------------
  1509. relinkcode: ;put LATEST into where myhere is pointing and update ptr = myhere
  1510. ;also create mylatest
  1511. rcall getlatest ;now on stack
  1512. mypopa ;latest in r16,17
  1513. pushz ;better save z
  1514. movw mylatest,myhere ;mylatest <-- myhere
  1515. movw zl,myhere ;z now points to next available spot in buf2
  1516. st z+,r17 ;problem. Don't work unless highbye first in mem.Why?
  1517. st z+,r16 ;now have new link in start of dic word
  1518. movw myhere,zl ;update myhere to point to length byte. (Not yet there.)
  1519. popz ;restore z
  1520. ret
  1521. ;-------------------------------------------------
  1522. create: ;put word after ":" into dictionary, aftyer link, preceeded by len
  1523. rcall word ;start with x pnting just after ":".End with len in r20, x pointing to
  1524. ; space just after word and start of word in w=r24,25
  1525. pushz ;save z. It's going to be used on ram dictionary
  1526. movw zl,myhere ;z now pnts to next spot in ram dic
  1527. st z+,r20 ; put len byte into ram dic
  1528. mov r18,r20 ;use r18 as ctr, don't wreck r20
  1529. pushx ;save x. It's going to be word ptr in buf1
  1530. movw xl,wl ;x now points to start of word. Going to be sent to buf2
  1531. sendbytes:
  1532. ld r16,x+ ;tx byte from buf1 to
  1533. st z+,r16 ; buf2
  1534. dec r18 ;repeat r20=r18=len times
  1535. brne sendbytes
  1536.  
  1537. sbrs r30,0 ;skip next instruction if final bit lsb = 1
  1538. rjmp downcr
  1539. ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary
  1540. clr r16
  1541. st z+,r16 ;insert padding byte
  1542. ;inc r30
  1543. ;brcc downcr
  1544. ;inc r31 ;add one to z before converting to bytes
  1545.  
  1546. downcr:
  1547. movw myhere,zl ;myhere now points to beyond word in dic
  1548. popx
  1549. popz
  1550. ret ;with word in dic
  1551. ;----------------------------------------------
  1552. leftbrac: ;classic turn on compiling
  1553. clr STATE
  1554. inc STATE ;state =1 ==> now compiling
  1555. ret
  1556. ;------------------------
  1557. compilecode: ;come here with STATE =1 ie compile, not execute. Want to put
  1558. ; eg rcall dup in code in dictionary but not to execute dup. If here
  1559. ; z points to byte address of word
  1560. mypush2 zl,zh
  1561. compileme:
  1562. mypush2 myhere,r5 ;push ptr to RAM dic
  1563. ;next is entry point for eg ' stackme2 already on stack and have to compile
  1564.  
  1565. ldi r16,low(buf2)
  1566. ldi r17,high(buf2) ;start of buf that conatins flash pg in RAM
  1567. mypush2 r16,r17
  1568. rcall minus ; myhere - buf2-start = offset in page
  1569. mypush2 SOFPG,r7 ;push start of flash page address
  1570. rcall plus ;SOFPG + offset = adr of next rcall in dic
  1571. ;if here we have two flash addresses on the stack. TOS = here. Next is there.
  1572. ;want to insert code for "rcall there w"hen I'm at here. eg current debugging indicates
  1573. ; here = $11EB and there is $1012 (cfa of "two"). First compute
  1574. ; relative branch "there - here -2". Then fiddle this val into the rcall opcode
  1575. rcall minus ;that;s there - here. Usu negative.
  1576. ;I got fffffffff..ffe27 for above vals. First mask off all those f's
  1577. rcall two ;stack a 2
  1578. rcall minus ;now have there-here -2 = fe24. When there,here in bytes.
  1579. mypopa ;bring fe26 into r16,17
  1580. clc
  1581. ror r17
  1582. ror r16 ;now a:= a/2
  1583. ldi r18,$ff
  1584. ldi r19,$0f ;mask
  1585. and r16,r18
  1586. and r17,r19
  1587. ; mypush2 r16,r17 ;now fe26 --> 0e26
  1588. ;the rcall opcode is Dxxx where xxx is the branch
  1589. ; mypopa ;bring fe26 into r16,17
  1590. ldi r19, $d0 ;mask
  1591. or r17,r19
  1592. mypush2 r16,r17 ;now have $de26 on stack which is (?) rcall two
  1593. rcall comma ;store this opcode into dic. myhere is ptr
  1594. ret
  1595. ;---------------------------
  1596. stackme_2: ;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack
  1597. ; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack.
  1598. pop r17
  1599. pop r16 ; they now contain eg 0x0804 which contain the 16bit num
  1600. movw zl,r16 ;z now points to cell that cobtains the number
  1601. clc
  1602. rol zl
  1603. rol zh ;double word address for z. lpm coming up
  1604.  
  1605.  
  1606.  
  1607. lpm r16,z+
  1608. lpm r17,z+ ;now have 16bit number in r16,17
  1609.  
  1610. st y+,r16
  1611. st y+, r17 ;mystack now contains the number
  1612.  
  1613. clc
  1614. ror zh
  1615. ror zl ;halve the z pointer to step past the number to return at the right place
  1616.  
  1617. push zl
  1618. push zh
  1619.  
  1620. ret
  1621. ;------------------------------flash write section--------------------
  1622.  
  1623. do_spm:
  1624. ;lds r16,SPMCSR
  1625. in r16,SPMCSR
  1626. andi r16,1
  1627. cpi r16,1
  1628. breq do_spm
  1629. mov r16,spmcsr_val
  1630. out SPMCSR,r16
  1631. spm
  1632. ret
  1633. ;-------------------------------------------------------------------
  1634. buf2ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1635. push r30 ;save for later spm work.
  1636. push r19
  1637. push xl
  1638. push xh ;used as buf_ctr but may interfere with other uses
  1639. ldi XL,low(buf2) ;X pnts to buf1 that contains the 64 bytes.
  1640. ldi XH, high(buf2)
  1641. ;assume Z is already pointing to correct flash start of page.
  1642. flashbuf:
  1643. ldi buf_ctr,32 ;send 32 words
  1644. sendr0r1:
  1645. ld r16, x+ ;get first byte
  1646. mov r0,r16 ; into r0
  1647. ld r16, x+ ; and get the second of the pair into
  1648. mov r1,r16 ; into r1
  1649. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1650. rcall do_spm ;that's r0,r1 gone in.
  1651. inc r30
  1652. inc r30
  1653. dec buf_ctr ;done 32 times?
  1654. brne sendr0r1
  1655. pop xh
  1656. pop xl
  1657. pop r19 ;dont need buf_ctr any more.
  1658. pop r30 ;for next spm job
  1659.  
  1660. ret
  1661. ;--------------------------------------------------------------------------
  1662. ;TODO just have 1 burn routine with buf different
  1663. buf3ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there.
  1664. push r30 ;save for later spm work.
  1665. push r19 ;used as buf_ctr but may interfere with other uses
  1666. push xl
  1667. push xh
  1668. ldi XL,low(buf2+64) ;X pnts to buf1 that contains the 64 bytes.
  1669. ldi XH, high(buf2+64)
  1670. ;assume Z is already pointing to correct flash start of page.
  1671. rjmp flashbuf
  1672. ldi buf_ctr,32 ;send 32 words
  1673. sendr0r3:
  1674. ld r16, x+ ;get first byte
  1675. mov r0,r16 ; into r0
  1676. ld r16, x+ ; and get the second of the pair into
  1677. mov r1,r16 ; into r1
  1678. ldi spmcsr_val,01 ;set up for write into spare buffer flash page
  1679. rcall do_spm ;that's r0,r1 gone in.
  1680. inc r30
  1681. inc r30
  1682. dec buf_ctr ;done 32 times?
  1683. brne sendr0r3
  1684. pop r19 ;dont need buf_ctr any more.
  1685. pop r30 ;for next spm job
  1686. ret
  1687.  
  1688. erasePage: ; assume Z points to start of a flash page. Erase it.
  1689. ldi spmcsr_val,0x03 ;this is the page erase command
  1690. rcall do_spm
  1691. ret
  1692. ;------------------------------------------------------------------
  1693. writePage:
  1694. ldi spmcsr_val, 0x05 ;command that writes temp buffer to flash. 64 bytes
  1695. rcall do_spm
  1696. nop ; page now written. z still points to start of this page
  1697. ret
  1698. ;---------------------------------------------------------------
  1699. test_buf2ToFlashBuffer: ;(adr_flashbufstartinBytes -- )
  1700. ; rcall fillBuf
  1701. ; ldi ZH, $10
  1702. ; ldi ZL,$c0 ;z=$01c0. Start of page 67.
  1703. rcall gethere
  1704. rcall double ;want bytes not words for flash adr
  1705. mypopa ;flashPgStart byte adr now in r16,17
  1706.  
  1707.  
  1708. movw zl,r16 ;z <--start of flash buffer
  1709. rcall erasePage
  1710. rcall buf2ToFlashBuffer
  1711. rcall writePage
  1712. herettt:
  1713. rjmp herettt
  1714. ;----------------------
  1715. ; burnbuf2. Come here from ";". The pair r6,r7 point to start of flash pg (bytes)
  1716. burnbuf2and3:
  1717. movw zl,r6 ;z now pnts to start of flash buf
  1718. rcall erasePage
  1719. rcall buf2ToFlashBuffer
  1720. rcall writePage
  1721. ;now going to burn next ram buffer to next flash page. Bump Z by 64 bytes.
  1722. adiw zh:zl,63 ;z now points to start of next flash buffer
  1723. lpm r16,z+ ;advance z pointer by one.adiw only lets max of 63 to be added.
  1724. ;now z points to start of next 64 byte buffer. Time to put buf3 into it.
  1725. rcall erasePage
  1726. rcall buf3ToFlashBuffer
  1727. rcall writePage
  1728. ret
  1729. heret:
  1730. rjmp heret
  1731. ;-------------------------------------------------------------
  1732. updatevars: ;after doing a colon def we have to update sys vars
  1733. ;TODO new version of LATEST is just old version of HERE.
  1734. ;TODO rplace all this code with updatevars2
  1735. ; just shif HERE into LATEST in eeprom to update. Gen. tidy required.
  1736. mypush2 r4,r5 ;put myhere on stack (E8)
  1737. ldi r16,low(buf2)
  1738. ldi r17,high(buf2)
  1739. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1740. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1741. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1742. rcall plus ;SOFG + offset = new HERE
  1743. ;now put also on stack new version of LATEST
  1744. mypush2 r2,r3 ;that's mylatest on stack
  1745. ldi r16,low(buf2)
  1746. ldi r17,high(buf2)
  1747. mypush2 r16,r17 ;start of buf2 on stack (E0)
  1748. rcall minus ;myhere-buf2 = offset. (e8-e0 = 08)
  1749. mypush2 SOFPG,r7 ; push onto stk start adr of flash page
  1750. rcall plus ;SOFG + offset = new LATEST
  1751. ; now have both LATEST (tos) and HERE on stack. Burn these into eeprom
  1752. ;up top we have .equ eLATEST = $0010
  1753. ;But it's too big. In bytes and causing probs. Solution=covert to words
  1754. rcall halve
  1755. ldi r16,low(eLATEST)
  1756. ldi r17,high(eLATEST)
  1757. mypush2 r16,r17
  1758. ;now have n16 eadr on stack ready for e!
  1759. rcall percentstore
  1760. ; TODO the value for HERE is prob in bytes too. Convert to words.
  1761. ;up top we have .equ eLATEST = $0010
  1762. ldi r16,low(eHERE)
  1763. ldi r17,high(eHERE)
  1764. mypush2 r16,r17
  1765. ;now have n16 eadr on stack ready for e!
  1766. rcall halve ;TODO check this
  1767. rcall percentstore
  1768. ret ;with stack clear and new vals for HERE and LATEST in eeprom
  1769. ;----------
  1770. ;;;;;;;;;;;;;;;;;;;;;;;;;;;Now serial stuff starts;;;;;;;;;;;;;;;;;;;;;;;;;
  1771. halfBitTime: ;better name for this delay. Half of 1/600
  1772. ;myDelay1200:
  1773. ;ldi r21,13 ; 13 works for m328 at 16Mhz
  1774. ldi r21,7 ;try 7 for tiny85 at 8Hmz
  1775. ldi r20,130 ;r20,21 at 130,7 give 833uS. Good for 600baud at 8Mhz
  1776. starthbt:
  1777. inc r20
  1778. nop
  1779. brne starthbt
  1780. dec r21
  1781. brne starthbt
  1782. ret
  1783. ;--------------------------------------------------
  1784. oneBitTime:
  1785. rcall halfBitTime
  1786. rcall halfBitTime
  1787. ret
  1788. ;-------------------------------------------------
  1789. sendAZero:
  1790. ;output 0 on Tx pin
  1791. cbi PORTB,TX_PIN ; send a zero out PB0
  1792. ret
  1793. ;-----------------------------------------------------
  1794.  
  1795. sendAOne:
  1796. ;output 1 on Tx pin
  1797. sbi PORTB,TX_PIN ; send a zero out PB0
  1798. ret
  1799. ;-----------------------------------------------------
  1800. sendStartBit:
  1801. ; send a 0 for one bit time
  1802. rcall sendAZero
  1803. rcall oneBitTime
  1804. ret
  1805. ;-------------------------------------------------------
  1806. sendNextDataBit: ;main output routine for serial tx
  1807. lsr serialByteReg ;push high bit into carry flag then inspect it
  1808. ;originally did lsl but found lsb first.
  1809. brcc gotzero ;if it's a 0 do nothing
  1810. rcall sendAOne ;must have been a 1 in carry
  1811. rjmp down
  1812. gotzero:
  1813. rcall sendAZero ;if here carry was a zero
  1814. down:
  1815. rcall oneBitTime ;so that 1 or 0 lasts 1/600 sec
  1816. ret
  1817. ;-------------------------------------------------------------
  1818. send8DataBits: ; send all bits in serialByteReg
  1819. ldi counterReg,8 ;8 data bits
  1820. sendBit:
  1821. rcall sendNextDataBit
  1822. dec counterReg
  1823. brne sendBit
  1824. ret
  1825. ;--------------------------------------------------------
  1826. sendStopBit:
  1827. ; send a 1 for one bit time
  1828. rcall sendAOne
  1829. rcall oneBitTime
  1830. ret
  1831. ;--------------------------------------------------------
  1832. sendSerialByte: ;main routine. Byte in serialByteReg = r16
  1833. push counterReg
  1834. rcall sendStartBit
  1835. rcall send8DataBits
  1836. rcall sendStopBit
  1837. rcall sendStopBit ;two stops
  1838. pop counterReg
  1839. ret
  1840. ;**************************************************************
  1841. serialTest0: ;output series of 'AAAA..'s
  1842. ldi serialByteReg, 0x43 ;0x41
  1843. rcall sendSerialByte
  1844. rcall oneBitTime ; take a rest
  1845. ldi r16,$44
  1846. mypush r16
  1847. rcall emitcode
  1848.  
  1849. rjmp serialTest0 ;continue forever
  1850. ;---------------------------------------------------------
  1851. ;---------Now do SerialRx routines-------------------
  1852. waitForHigh: ;loop til RX is high
  1853. sbis PINB,RX_PIN ;test that pin for set (PB2)
  1854. rjmp waitForHigh ; loop if rx pin is low
  1855. ret
  1856. ;-----------------------------------------------
  1857. waitForLow: ;PRONBLEMs loop til RX is low. FIXED.
  1858. sbic PINB,2 ;test that pin for set (PB2)
  1859. rjmp waitForLow ; loop if rx pin is high
  1860. ret
  1861. ;---------------------------------------------------
  1862. waitForStartBit: ;loop til get a real start bit
  1863. rcall waitForHigh ;should be marking at start
  1864. rcall waitForLow ;gone low. might be noise
  1865. rcall halfBitTime ;is it still low in middle of bit time
  1866. sbic PINB,RX_PIN ;..well, is it?
  1867. rjmp waitForStartBit ;loop if level gone back high. Not a start bit.
  1868. ret ;we've got our start bit
  1869. ;----------------------------------------------------
  1870. checkForStopBit: ;at end, get carry flag to reflect level. Prob if c=0
  1871. rcall oneBitTime ; go into stop bit frame, halfway
  1872. sec ;should stay a 1 in C if stop bit OK
  1873. sbis PINB,RX_PIN ;don't clc if bit is high
  1874. clc ;but only if we have a weird low stop bit
  1875. ret ;with carry flag = stop bit. Should be a 1
  1876. ;-------------------------------------------------------------
  1877. get8Bits: ;get the 8 data bits. No frame stuff
  1878. clr rxbyte ;this will fill up with bits read from RX_PIN
  1879. push counterReg ;going to use this so save contents for later
  1880. ldi counterReg,8 ;because we're expecting 8 databits
  1881. nextBit:
  1882. rcall oneBitTime ;first enter here when mid-startbit
  1883. rcall rxABit ;get one bit
  1884. dec counterReg ;done?
  1885. brne nextBit ;no, round again
  1886. pop counterReg ;yes, finished, restor counter and get out
  1887. ret
  1888. ;---------------------------------------------------------------
  1889. rxABit: ;big serial input routine for one bit
  1890. clc ;assume a 0
  1891. sbic PINB,RX_PIN ; skip nxt if pin low
  1892. sec ;rx pin was high
  1893. ror rxbyte ;carry flag rolls into msb first
  1894. ret
  1895. ;********************************
  1896. getSerialByte: ;big routine. Serial ends up in rxByte
  1897. push counterReg
  1898. rcall waitForStartBit ;**change
  1899. rcall get8Bits
  1900. rcall checkForStopBit
  1901. pop counterReg
  1902. ret ;with rxByte containing serial bye
  1903. ;----------------------------------------------------
  1904. serialTest1: ;output A then reflect input. Worked OK
  1905. ldi serialByteReg, 0x36 ;0x41
  1906. rcall sendSerialByte
  1907. rcall oneBitTime ; take a rest
  1908. rcall getSerialByte
  1909. mov serialByteReg,rxByte ;output what's been read
  1910. rcall sendSerialByte
  1911. rjmp serialTest1
  1912. ;--------------------------------------------------------
  1913. ;----------Now doing buffer work. Want to and from 64 bytes----------
  1914. fillBuf:
  1915. ldi ZL,low(buf1) ;buf1 is my buffer
  1916. ldi ZH, high(buf1) ;Z now points to buf1
  1917. ldi counterReg,64 ;64 bytes in buffer
  1918. ldi r16,$30
  1919. storeB0:
  1920. st z+,r16
  1921. inc r16
  1922. dec counterReg
  1923. brne storeB0
  1924. herefb:
  1925. ; rjmp herefb
  1926. ret
  1927. ;----------------------------------------------------------
  1928. serialStrOut: ;X points to start of string,r17 has length
  1929. ld serialByteReg, x+
  1930.  
  1931. rcall sendSerialByte
  1932. dec r17 ;got to end of string?
  1933. brne serialStrOut
  1934. ret
  1935. ;----------------------------------
  1936. test_serialStrOut:
  1937. rcall fillBuf
  1938. ldi XL,low(buf1) ;buf1 start of str
  1939. ldi XH, high(buf1)
  1940. ldi r17,64 ;going to send len=r17 bytes
  1941. rcall serialStrOut
  1942. here2:
  1943. rjmp here2
  1944. ;--------------------------------------
  1945. waitForCharD: ;wait til eg a 'D' is pressed then do something.
  1946. ldi serialByteReg, '>' ;0x41
  1947. rcall sendSerialByte
  1948. rcall oneBitTime ; take a rest
  1949. rcall getSerialByte
  1950. mov serialByteReg,rxByte ;output what's been read
  1951. cpi rxByte, 'D'
  1952. brne waitForCharD
  1953. ldi serialByteReg, '*'
  1954. rcall sendSerialByte
  1955. rjmp waitForCharD
  1956. ;-----------------------------------------------------------
  1957. dumpbuf1:
  1958. ldi XL,low(buf1) ;buf1 start of str
  1959. ldi XH, high(buf1)
  1960. ldi r17,64 ;going to send len=r17 bytes
  1961. rcall serialStrOut
  1962. ret
  1963. ;-------------------------------------------------------------
  1964. test_dumpbuf1:
  1965. rcall fillBuf
  1966. rcall getSerialByte ;any one will do.
  1967. rcall dumpbuf1
  1968. rjmp test_dumpbuf1
  1969. ;----------------------------------------------------------
  1970. waitForDDump: ;wait til eg a 'D' is pressed then dump buf1
  1971. ldi serialByteReg, '>' ;0x41
  1972. rcall sendSerialByte
  1973. rcall oneBitTime ; take a rest
  1974. rcall getSerialByte
  1975. mov serialByteReg,rxByte ;output what's been read
  1976. cpi rxByte, 'D'
  1977. brne waitForDDump
  1978. rcall dumpbuf1
  1979. rjmp waitForCharD
  1980. ;---------------------------------------------------------------
  1981. rxStrEndCR: ;get a serial string that ends with CR
  1982. clr counterReg
  1983. ldi XL,low(buf1) ;buf1 is where str will go
  1984. ldi XH, high(buf1)
  1985. upsec:
  1986. rcall getSerialByte
  1987.  
  1988. st x+, rxByte ;char goes into buffer="buf1"
  1989.  
  1990. cpi rxByte,$0d ;is it CR = end of string?
  1991. breq fin
  1992. inc counterReg ;don't go over 64 bytes
  1993. cpi counterReg,64
  1994. brne upsec ;not too long and not CR so keep going
  1995. fin:
  1996. ret
  1997. ;---------------------------------------------
  1998. test_rxStrEndCR: ;just a test of above
  1999. rcall OK
  2000. rcall CR
  2001. rcall rxStrEndCR
  2002. rcall dumpbuf1
  2003. rcall CR
  2004. ; rcall waitForDDump
  2005. rjmp test_rxStrEndCR
  2006. ;------------------------------------------------------
  2007. test2_rxStrEndCR: ;want a diagnostic dump if testing. Works with .IFDEF
  2008. rcall rxStrEndCR
  2009. .IFDEF testing
  2010. rcall dumpbuf1
  2011. .ENDIF
  2012. rjmp test2_rxStrEndCR
  2013. ;------------------------------------------------------------
  2014. rxStrWithLen: ;expect len char char char.. for len chars
  2015. push counterReg
  2016. ldi XL,low(buf1) ;buf1 is where str will go
  2017. ldi XH, high(buf1)
  2018. rcall getSerialByte ; get length bye Must be less than 65
  2019. mov counterReg, rxByte ;save len in counter
  2020. cpi counterReg,65 ;
  2021. brlo allOK ;less than 65 so carry on. Branch if Lower
  2022. ldi counterReg,64 ; if len>64 then len=64. Buffer = buf1 only 64 bytes
  2023. allOK:
  2024. tst counterReg ;zero yet?
  2025. breq finrs
  2026. rcall getSerialByte ;next serial input byte
  2027. st x+, rxByte ;put into buffer
  2028. dec counterReg ;have we done len=counterReg bytes?
  2029. rjmp allOK
  2030. finrs:
  2031. pop counterReg
  2032. ret
  2033. ;---------------------------------------------------------------
  2034. test_rsStrWithLen: ;works ok with macro $05GHIJKLM. Sends GHIJK
  2035. ldi r16, '#'
  2036. rcall sendSerialByte
  2037. rcall rxStrWithLen
  2038. rcall dumpbuf1
  2039. rjmp test_rsStrWithLen
  2040. ;-----------------------------now start forth i/o words like emit------------------
  2041. emitcode: ; (n8 --)classic emit
  2042. mypop r16
  2043. rcall sendserialbyte
  2044. ret
  2045. ;------------------------------------------------
  2046. insertret: ;semi has to end new word with ret = $9508 opcode
  2047. pushx ;both xl,xh saved for later
  2048. movw xl,myhere ;myhere points to next available spot in ram dic
  2049. ldi r16,$08
  2050. st x+,r16 ;$08 part goes first
  2051. ldi r16,$95
  2052. st x+,r16 ;ret now in ram. Just tidy pointers
  2053. movw myhere,xl
  2054. popx ;so x back where it was and ret inserted.
  2055. ret
  2056. ;--------------------------------
  2057. equalcode: ;(n1 n2 -- flag) if n1 = n2 flag = 0001 else 0000
  2058. mypopa
  2059. mypopb ; now have TOS in r16,17, underneath that in r18,19
  2060. cp r16,r18 ;low bytes =?
  2061. brne zout ;not equal so go out
  2062. cp r17,r19 ;hi bytes =?
  2063. brne zout ;no, so out
  2064. ;if here both n16's are equal so push a 0001
  2065. rcall one
  2066. rjmp aout ;done
  2067. zout:
  2068. rcall zero ;not = so push a zero
  2069. aout:
  2070. ret ;with a flag on stack replacing to n16's
  2071. ;------------------------------
  2072. ;TODO eliminate below and replace with simpler RAM jmp code.
  2073. calcjumpcode: ;(to from -- opcode_for_rjmp to at from)
  2074. ;used when compiling. What is the rjmp opcode if
  2075. ; we know the from and to adr on stack. ( to fr --)
  2076. ldi r16, low(buf2)
  2077. ldi r17, high(buf2)
  2078. mypush2 r16,r17 ; (to fr $e0 --)
  2079. rcall dup ;t f $e0 $eo
  2080. rcall unrot ;t $e0 fr $e0
  2081. rcall minus ;t $e0 frOffset
  2082. rcall unrot ;frOffset t $e0
  2083. rcall minus ;frOffset toOffset
  2084. ;now apply these offsets in flash buffer. Add them to start of flash buffer adr
  2085. mypush2 SOFPG,r7 ; frOffset toOffset SOFPG
  2086. rcall dup ;frOffset toOffset SOFPG SOFPG
  2087. rcall unrot ;frOffset SOFPG toOffset SOFPG
  2088. rcall plus ;frOffset SOFPG toFlashAdr
  2089. rcall unrot ;toFlashAdr frOffset SOFPG
  2090. rcall plus ;toFlashAdr frFlashAdr
  2091. rcall minus ;to -from give last 3 nibbles in rjmp opcode +1
  2092. rcall one
  2093. rcall minus ; now have to - from -1
  2094. rcall stackme_2
  2095. .dw $0fff
  2096. rcall andd ; now have eg. 0f20. Want Cf20
  2097. rcall stackme_2
  2098. .dw $c000 ;should now have right opcode eg cf20
  2099. ret ;with correct rjmp kkk on stack. Ready to insert into RAM dic.
  2100. ;-------------------
  2101. stackmyhere: ;( --- adr) put RAM ptr myhere on stack
  2102. mypush2 myhere, r5
  2103. ret
  2104. ;---------------------------
  2105. begincode: ;when using BEGIN just stack current address.No dic entry
  2106. rcall stackmyhere ;put next adr on stack
  2107. ret
  2108. ;----------------------------
  2109. stkmyhere: ;put myhere on the stack, handy
  2110. mypush2 myhere,r5
  2111. ret
  2112. ;-----------------------------------
  2113. stkSOBuf2: ;stack start of buf2. Handy.
  2114. ldi r16,low(buf2)
  2115. ldi r17,high(buf2)
  2116. mypush2 r16,r17
  2117. ret ;with adr of buf2 on stk
  2118. ;--------------------------
  2119. stkSOFPG: ;put start of flash page on stack, In bytes.
  2120. mypush2 SOFPG,r7
  2121. ret ;with start of current flash page's adr on stack.
  2122. ;-------------------------------
  2123. stklatestadr: ;put e-adr of eLatest. Currently 012 in eeprom
  2124. ldi r16,low(eLATEST)
  2125. ldi r17,high(eLATEST)
  2126. mypush2 r16,r17
  2127. ret ;with 012 or adr of eLatest on stk
  2128. ;-------------------------------------
  2129. stkhereadr: ;same as above but for HERE
  2130. ldi r16,low(eHERE)
  2131. ldi r17,high(eHERE)
  2132. mypush2 r16,r17
  2133. ret ;with adr of ehere,current eeprom adr = $010
  2134. ;-------------------------------------------
  2135. updatevars2: ;better version of update vars. Come here after ";"
  2136. ;TODO check this version.DONE and eliminate other one.
  2137. rcall gethere ;the HERE val now on stack. It's a pointer to flash.
  2138. rcall stklatestadr ;usually 012
  2139. rcall percentstore
  2140. ;now with LATEST now containing old HERE. Next fix HERE
  2141. rcall stkmyhere ;current ptr to RAM dic's next free byte
  2142. rcall stkSOBuf2 ;start of buf2 adr
  2143. rcall minus ;gives distance into the buffer
  2144. rcall stkSOFPG ;will add distance to start of flashbuf
  2145. rcall plus ;got flash adr, but in bytes
  2146. rcall halve ;now adr in words
  2147. rcall stkhereadr ;usually %010 in eeprom
  2148. rcall percentstore ;eHERE now updated
  2149. ret ;with vals for HERE and LATEST in eeprom updated after ";"
  2150. ;--------------------
  2151. testOKCR:
  2152. rcall OK
  2153. rcall OK
  2154. rcall CR
  2155. rjmp testOKCR
  2156. ;--------------------
  2157. serialFill: ;main input routine from terminal. Output OK} then
  2158. ; wait until buf1 has string of words ( <64 chars?) ending in $0d
  2159. rcall CR
  2160. rcall OK
  2161. rcall rxStrEndCR
  2162. ret ; buf1 now filled with words from terminal
  2163.  
  2164. ;---------
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!