API tools faq
paste
prjbrook

forth85_30.asm . Block reading going.

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