API tools faq
paste
prjbrook

forth85_27A. Some attempts at IF. (unstable)

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