;this is forth85_27 Tidies up forth85_26. Pleased to go a bit live with ver 25. ;Had big probs with _26 getting two consecutive colon defs going. HERE reading probs. fixed, I think ;Issues below still on table. Need more debugging tools. Have got d16, d1617, dlowR, ddhighR, dxyz. All dumps. ;today going to try .S , show stack in non-destructive way. DONE ; Don't do st -x,r16 then st x+,r16. MYSTERY ;do and test BRANCH and 0 BRANCH NOT DONE ; Also calcjump for rjmp opcodes needs tsting. NOT DONE ;could try (begin .... again) loop. Kind of dione. Needs live run ;Prob need livetesting flag like "testing". DONE ;.equ testing = 1 ;makes io verbose. comment out later ;.equ livetesting = 1 ;comment out to take out the little dumps and diagnostics. .NOLIST .include "tn85def.inc" .LIST ;.LISTMAC ;sometimes macro code gets in way of clarity in listing .MACRO header .db high(@0), low(@0), @1, @2 .ENDMACRO .MACRO mypop ld @0,-y .ENDMACRO .MACRO mypush st y+, @0 .ENDMACRO .MACRO mypop2 mypop @0 mypop @1 .ENDMACRO .MACRO mypush2 mypush @0 mypush @1 .ENDMACRO .MACRO pushx push xl push xh .ENDMACRO .MACRO popx pop xh pop xl .ENDMACRO .MACRO pushz push zl push zh .ENDMACRO .MACRO popz pop zh pop zl .ENDMACRO .MACRO mypopa ;call r16,17 the accumulator a, ditto for r18,r19 for b mypop r17 mypop r16 .ENDMACRO .MACRO mypopb mypop2 r19,r18 .ENDMACRO .macro TAKEMEOUT .ifdef livetesting ldi serialByteReg, @0 rcall sendSerialByte ldi serialByteReg, @0 rcall sendSerialByte .endif .endmacro .def mylatest =r2 ;r2,r3 is mylatest .def myhere =r4 ;r4,r5 is myhere. The pointer to flash copy in buf2. .def SOFPG=r6 ;start of flash page ;r6,r7 byte adr of flash page (11c0) ;r8,r9 (0012) offset when flash comes into buf2. r8 +E0 = myhere .def SECONDLETTER =r10 ;helpful for debugging .def FOUNDCOUNTER = r11 ;dealWithWord clicks this if found =1. Counts successful finds in dictionary. .def STATE = r12 .def STOP = r13 ;stop interpreting line of words .def BOTTOM = r14 ;have hit the bottom of the dict and not found a match .def FOUND = r15 ;if found=1 we have a match of Ram word on dictionary .def spmcsr_val=r18 .def buf_ctr =r19 ;for flash section ;r20 is length of word in WORD ;r21 is the flash length of word with immediate bit 8, if any, still there .def vl = r22 .def vh = r23 ; u,v,w,x,y,z are all pointers .def wl = r24 ;w=r24,25 .def wh = r25 .equ TX_PIN = 0 .equ RX_PIN = 2 ; Tx,Rx pins are PB0 and PB2 resp .def serialByteReg = r16 .def rxByte = r18 .def counterReg = r17 .eseg .org $10 .dw HERE, LATEST , $0160 ;these should be burned into tn85 with code .DSEG .ORG 0x60 .equ BUF1LENGTH = 128 .equ eHERE = $0010 ;eeprom adr of system varial eHere .equ eLATEST = $0012 .equ eVar = $0014 ;holds next ram adr for next var declaration buf1: .byte BUF1LENGTH ;input buffer. Lines max about 125 buf2: .byte BUF1LENGTH ;this fits two flash buffers ;So buf1=060..0df,buf2=0e0..15f,varspace=160..19f,mystack=1a0..ret stack space that ends at 25f varSpace: .byte 64 ;might need more than 32 variables myStackStart: .byte 64 ;currently at $1E0.Meets return stack. .CSEG .ORG 0x800 ;dictionary starts at 4K (2K words) mark ;---------------------------------------------------- one_1: .db 0,0,3, "one" ;code for one one: ; rcall stackme rcall stackme_2 .db 01, 00 ret ;---------------------------------------------- two_1: header one_1, 3, "two" two: rcall stackme_2 .db 02,00 ret ;------------------------------------------ dup_1: header two_1,3,"dup" dup: mypop r17 mypop r16 mypush r16 mypush r17 mypush r16 mypush r17 ret ;------------------------------------------- drop_1: header dup_1,4,"drop" drop: mypop r17 mypop r16 ;TODO what if stack pointer goes thru floor? ret ;---------------------------------- swapp_1: ;twp p's becasue assembler recognizes avr opcode swap header drop_1,5, "swapp" swapp: mypop2 r17,r16 mypop2 r19,r18 mypush2 r16,r17 mypush2 r18,r19 ret ;------------------------------------------------- ;shift this later S_1: ;the EOL token that gets put into end of buf1 to stop parsing header swapp_1,$81,"S" ;NB always immediate S: ldi r16,02 mov BOTTOM,r16 ;r14 =2 means a nice stop. EOL without errors clr STOP inc STOP ;set time-to-quit flag takemeout 's' ret ;------------------------------------------ fetch_1: ;doesn't like label = @-1 ;classic fetch. (adr -- num). Only in RAM header S_1,1,"@" fetch: pushx ;going to use x to point so better save mypop xh mypop xl ld r16,x+ ld r17,x mypush r16 mypush r17 ; and put them on my stack popx ;return with x intact and RAM val on my stack ret ;dddddddddddddddddddddddddddddddddddddddddddddddd cfetch_1: ;doesn't like label = c@-1 ;classic fetch. (adr -- num). Only in RAM. Do I want y to advance just one byte on mystack header fetch_1,2,"c@" cfetch: pushx ;going to use x to point so better save mypop xh mypop xl ld r16,x+ mypush r16 clr r16 mypush r16 ;so we get a 16 bit val on stack popx ;return with x intact and RAM val on my stack ret ;dddddddddddddddddddddddddddddddddddddddddddddddd store_1: ;classic != "store"(num adr --) . Num is now at cell adr. header cfetch_1,1,"!" store: pushx mypop2 xh,xl ;there goes the address mypop2 r17,r16 ;there goes the num st x+,r16 st x,r17 ;num goes to cell with location=adr popx ret ;ddddddddddddddddddddddddddddddddddddddddddddddddddd cstore_1: ;classic c!= "store"(adr 16bit --) . Lower 8 bits Num is now at cell adr. header store_1,2,"c!" cstore: mypop r17 ;there's the high byte. Thrown away mypop r16 ;there goes the num. Just 8 bits at this stage. pushx mypop2 xh,xl ;there goes the address st x+,r16 ; st x,r17 ;num goes to cell with location=adr popx ret ;------------------------------------ star_1: ;classic 16*16 mulitply (n n -- n*n) header cstore_1,1,"*" star: mypop2 r17,r16 mypop2 r19,r18 ;now have both numbers in r16..r19 rcall mpy16s ; multiply them. Result in r18..r21. Overflow in r20,21 mypush2 r18,r19 ret ;----------------------------------------- slashMod_1: ;classic /MOD (n m -- n/m rem) header star_1,4,"/mod" slashMod: push r13 push r14 ;this is STOP but is used by div16s, so better save it mypop2 r19,r18 ; that's m mypop2 r17,r16 ;that's n rcall div16s ;the the 16 by 16 bit divsion mypush2 r16,r17 ;answer ie n/m mypush2 r14,r15 ;remainder pop r14 pop r13 ret ;dddddddddddddddddddddddddddddddddddddddddddd plus_1: ;classic + ( n n -- n+n) header slashMod_1,1,"+" plus: mypop2 r17,r16 mypop2 r19,r18 clc add r16,r18 adc r17,r19 mypush2 r16,r17 ret ;-- minus_1: ;classic - ( n m -- n-m) header plus_1,1,"-" minus: mypop2 r19,r18 mypop2 r17,r16 clc sub r16,r18 sbc r17,r19 mypush2 r16,r17 ret ;dddddddddddddddddddddddddddddddddddddddddd pstore_1: ;expects eg. 0003 PORTB P! etc, "output 3 via PORTB" header minus_1,2, "p!" pstore: mypopb ;get rid of PORTB number, not used for tiny85, just one port mypopa ; this is used. it's eg the 003 = R16 above out PORTB,r16 ret ;ddddddddddddddddddddddddd portblabel_1: header pstore_1,5,"PORTB" ; note caps just a filler that point 0b in stack for dropping portblabel: ; Extend later on to include perhaps other ports ; one: ; rcall stackme rcall stackme_2 .db $0b, 00 ret ;--------------------- datadirstore_1: ;set ddrb. invioked like this 000f PORTB dd! to make pb0..pb3 all outputs header portblabel_1, 3, "dd!" datadirstore: mypopb ; there goes useless 0b = PORTB mypopa ; 000f now in r17:16 out DDRB,r16 ret ;dddddddddddddddddddddddddddddddddddd ;sbilabel_1 ;set bit in PORTB. Just a kludge at this stage ;header datadirstore_1,3,"sbi" TODO sort out sbi and delay later. Now get on with compiler. ;first need store system vars in the eeprom. Arbitrarily 0010 is HERE and 0012 (in eeprom) is LATEST ;---------------------------------------- percentcstore_1: ;(n16 adr16 --) %c! stores stack val LSbyte to eeprom adr ; eg 10 00 1234 stores 34 to 0010 <--eeprom adr header datadirstore_1,3,"%c!" percentcstore: mypopb ;adr in r18,19 mypopa ;data. Lower byte into r16 rcall eewritebyte ;burn it into eeprom ret ;---------------------------------- percentstore_1: ; (n16 adr16 --) b16 stored at eeprom adr adr16 and adr16+1 header percentcstore_1,2, "e!" ;changed %! to e! PB!! percentstore: mypopb ;adr in b=r18,19 mypopa ;n16 into r16,17 as data rcall eewritebyte ;burn low data byte clc inc r18 brne outpcs inc r17 ;sets up adr+1 for next byte outpcs: mov r16,r17 ;r16 now conatins hi byte rcall eewritebyte ret ;------------------------------- percentcfetch_1: ;(eepromadr16--char). Fetch eeprom byte at adr on stack header percentstore_1,3,"%c@" percentcfetch: mypopb ;adr now in r18,19 rcall eereadbyte mypush r16 ; there's the char going on stack. Should be n16? Not n8? ret ;------------------- percentfetch_1: ;(adr16--n16) get 16bits at adr and adr+1 header percentcfetch_1,2,"e@" ;PB!! changed from %@ percentfetch: rcall percentcfetch ;low byte now on stack inc r18 brcc downpf inc r19 downpf: rcall eereadbyte ;there's the high byte hitting the mystack mypush r16 ret ;------------------------------- gethere_1: ; leaves current value of eHERE on stack header percentfetch_1,7,"gethere" gethere: rcall stackme_2 .dw eHere rcall percentfetch ret ;-------------------- getlatest_1: ;leaves current value of latest on stack header gethere_1,9, "getlatest" getlatest: rcall stackme_2 .dw eLATEST ;the address of the latest link lives in eeprom at address 0012 rcall percentfetch ;get the val out of eeprom ret ;------------------ colon_1: ;classic ":"compiling new word marker header getlatest_1,1,":" rcall coloncode ret ;---------------------------------------- comma_1: ;classic comma. ;Put adr on stack into dictionary at myhere and bump myhere header colon_1,1,"," comma: mypopa ;adr now in r16,17 pushz ;save z movw zl,myhere ;z now pnts to next avail space in dic st z+,r16 st z+,r17 movw myhere,zl ;so that myhere is updated as ptr popz ;bring z back ret ;------------------------------------ tic_1: ;clasic tic('). Put cfa of next word on stack header comma_1,1, "'" tic: rcall word ;point to next word in input rcall findword ;leaving cfa in z mypush2 zl,zh rcall two ;but it's in bytes. Need words so / by 2 rcall slashmod rcall drop ;that's the remainder dropped ;now have cfa of word after ' on stack in word-units. ret ;----------------------- dummy_1: ;handy debugging place to put a break point header tic_1,$85,"dummy" ;first immediate word dummy: nop ret ;-------------------------------- compstackme_2_1: ;needed infront of every number compiled header dummy_1, $0d,"compstackme_2" compstackme_2: ldi r16,low(stackme_2) ldi r17,high(stackme_2) mypush2 r16,r17 ;in words need to *2 to convert to bytes rcall two rcall star rcall compileme ret ;----------------------------------------- double_1: ;whatever's on stack gets doubled. Usful words-->bytes. (n...2*n) header compstackme_2_1, 6, "double" double: mypopa ;stk to r16,17 clc ;going to do shifts rol r16 rol r17 ;r16,17 now doubled mypush2 r16,r17 ret ;with 2*n on my stk ;-------------------------------------- semi_1: ;classic ";". Immediate TODO compile a final ret header double_1,$81,";" semi: nop rcall insertret ;compile ret rcall oneBitTime ;trying some waits to give spm time rcall burnbuf2and3 rcall oneBitTime ;ditto rcall oneBitTime ;ditto. Seems to be working. eeprom writes wreck spm's. rcall rbrac ;after semi w'got back to executing ; rcall updatevars ;update HERE and LATEST in eeprom rcall updatevars2 ;Better version. update HERE and LATEST in eeprom ret ;--------------------------------------- rbrac_1: ;classic "]" ,immediate header semi_1,$81,"]" rbrac: clr STATE ;go to executing ret ;------------------------------------------------ immediate_1: ;classic IMMEDIATE. Redo len byte so MSbit =1 header rbrac_1,$89,"immediate" immediate: mypush2 r2,r3 ;this is mylatest. pnts to link of new word rcall two rcall plus ;jmp over link to pnt to len byte pushx ;better save x mypop2 xh,xl ;x now pnts to len byte ld r16,x ; and put it into r6 ldi r18,$80 ;mask or r16,r18 ;eg 03 --> 83 in hex st x,r16 ;put len byte back popx ;back where it was ret ;done now newly created word is immediate ;------------------------------------------------- emit_1: ;(n8 --) classic emit header immediate_1, 4, "emit" emit: rcall emitcode ret ;-------------------------------------- getline_1: ;rx a line of chars from serialin. eol = $0d ;this is the line that gets interpreted header emit_1,7, "getline" getline: rcall rxStrEndCR ;write 64 TODO 128? bytes into buf1 from serial io .ifdef testing rcall dumpbuf1 .endif ret ;with buf1 ready to interpret ;------------------------------------------------- zero_1: ;stack a zero header getline_1,4,"zero" zero: rcall stackme_2 .db 0,0 ret ;---------------------------------------- equal_1: ;(n1 n2 -- flag) header zero_1,1,"=" equal: rcall equalcode ret ;---------------------------------------- zeroequal_1: ;(n -- flag) header equal_1,2,"0=" zeroequal: rcall zero rcall equal ret ;------------------------- over_1: ;(n1 n2 --n1 n2 n1) header zero_1,4,"over" over: mypopa mypopb mypush2 r18,r19 ;n1 mypush2 r16,r17 ;n2 mypush2 r18,r19 ;n1. so end up with (n1,n2,n1 ret ;----------------------------------- rot_1: ;classic (n1 n2 n3 -- n2 n3 n1) header over_1,3,"rot" rot: mypopa push r17 push r16 ;save n3 rcall swapp ; n2 n1 pop r16 pop r17 mypush2 r16,r17 ;n2 n1 n3 rcall swapp ;n2 n3 n1 ret ;------------------------------------ reverse3_1: ;PB (n1 n2 n3 -- n3 n2 n1). Reverses top 3 order header rot_1,8,"reverse3" reverse3: rcall swapp ; n1 n3 n2 rcall rot ; n3 n2 n1 ret ;so (n1 n2 n3 -- n3 n2 n1) ;-------------------------------------------- unrot_1: ;PB (n1 n2 n3 -- n3 n1 n2) Buries topitem two down header reverse3_1,5,"unrot" unrot: rcall reverse3 ; (n1 n2 n3 -- n3 n2 n1) rcall swapp ; n3 n1 n2 ret ;-------------------------------- andd_1: ;classic AND header unrot_1,4,"andd" ; two d's otherwise asm problems andd: mypopa mypopb and r16,r18 and r17,r19 mypush2 r16,r17 ret ;---------------------------------------- orr_1: ;classic OR header andd_1,3,"orr" ; two r's otherwise asm problems orr: mypopa mypopb or r16,r18 or r17,r19 mypush2 r16,r17 ret ;------------------------ calcjump_1: ;(to from -- opcode) header orr_1,$88, "calcjump" calcjump: rcall calcjumpcode ret ;with opcode on stack ;----------------------- begin_1: ;( -- adr) classic BEGIN. Used in most loops header calcjump_1,$85,"begin" begin: rcall stackmyhere ;put next adr on stack. For AGAIN etc ret ;with adr on stack ;--------------------------- again_1: ; (to_adr -- ) classic AGAIN cts loop back to BEGIN header begin_1, $85,"again" again: rcall stackmyhere ; to_adr fr_adr rcall minus ;rel_adr_distance eg $ffdd rcall stackme_2 .dw $0002 rcall div ;now adr difference in words. Works better. rcall stackme_2 .dw $0fff ;$ffdd $0fff rcall andd ;$0fdd eg. rcall stackme_2 .dw $c000 ;$0fdd $c000 rcall orr ;$cffdd = rjmp back_to_again rcall one rcall minus ;t0-fr-1 = the jump part of rjmp rcall comma ;insert into dic ret ;with rjmp opcode in next pos in dic ;------------------------------ div_1: ; (n1 n2 -- n1/n2) classic / Could make 2 / faster with >, one right shift header again_1,1,"/" div: rcall slashMod rcall drop ret ;--------------------------------- halve_1: ; (n -- n/2) use shifts to halve num on stack. Handy header div_1,5,"halve" halve: mypopa clc ror r17 ror r16 mypush2 r16,r17 ;now num on stack has been halved ret ;with n/2 on stk ;-------------------- dumpb1_1: ;dumpbuf1 to serial header halve_1,6,"dumpb1" dumpb1: rcall dumpbuf1 ret ;--------------------- OK_1: ;classic "ok" header dumpb1_1,2,"OK" OK: ldi r16,'K' ldi r17,'O' clr r18 mypush2 r16,r18 ;16bits K mypush2 r17,r18 ;'O' rcall emitcode rcall emitcode ldi r16,'}' ;try this for a cursor prompt clr r18 mypush2 r16,r18 rcall emitcode ret ;after having emitted "OK" to terminal ;------------------------------- CR_1: ;output a carriage return. Need $0d too? header OK_1,2, "CR" CR: ldi r16,$0d mypush r16 clr r16 mypush r16 ;all stack items are 16bits rcall emitcode ret ;after sending CR to terminal ;-------------------------- test1_1: ;just need some dic word to try with new serialFill header CR_1,5,"test1" test1: ldi serialByteReg, '*' rcall sendSerialByte ldi serialByteReg, 'T' rcall sendSerialByte ldi serialByteReg, 'T' rcall sendSerialByte ldi serialByteReg, '*' rcall sendSerialByte inc r1 inc r1 ;TESTING take out later TODO ret ;------------------------------------------------------- dotS_1: ;classic .S Prints stack items nondestructively header test1_1,2,".S" dotS: rcall dotScode ;TODO check there is *something* on the stack first ret ;---------------------------------------------------------- dot_1: ;( n16 -- ) classic "." that prints the num on the TOS header dotS_1,1,"." dot: push r16 push r17 mypopa ;TO_stk --> r16r17 rcall d1617 ;print it pop r17 pop r16 ret ;----------------------------- Sdot_1: ;( adr16 len16 --) classic S" Prints string from flash header dot_1,2,"S." Sdot: push r16 push r17 push r18 ; pushz mypopb ;r18 = len mypop2 zh,zl ;x gets the adr in flash of the string upsd: lpm r16,z+ ;get byte from flash rcall sendserialbyte ;rcall d16 dec r18 brne upsd ;do this for len times ; popz pop r18 pop r17 pop r16 ret ;---------------------------------------- words_1: ;classic words. All words get printed out tot the terminal. header Sdot_1,5,"words" words: rcall wordscode ret ;--------------------------------------- getvarptr_1: ;leaves current value of varptr,currently at 0012,on stack header words_1,9, "getvarptr" getvarptr: rcall stackme_2 .dw eVar ;the address of the latest link lives in eeprom at address 0012 rcall percentfetch ;get the val out of eeprom ret ;with next avaialble adr for variable on stack. Lives in buf just below mystack ;----------------------------------------------- hereadr_1: ;classic here. Puts adr of eHere on stack. Currently 010 in eeprom header getvarptr_1,7,"hereadr" hereadr: rcall stackme_2 .dw eHere ret ;with eg 010 on stack, the eeprom adr of eHere ;----------------------------------------------------- latestadr_1: ;classic latest. Puts adr of eLatest on stack. Currently 012 in eeprom header hereadr_1,9,"latestadr" latestadr: rcall stackme_2 .dw eLatest ret ;with eg 012 on stack, the current eeprom adr of elatest ;---------------------------------- varptradr_1: ; Puts adr of eVar on stack. Currently 014 in eeprom header latestadr_1,9,"varptradr" varptradr: rcall stackme_2 .dw eVar ret ;with eg 014 on stack, the eeprom adr of eVar ;---------------------------------- tx16_1: ;need easier word than "sendserialbyte" header varptradr_1,4,"tx16" tx16: rcall sendserialbyte ret ;-------------------------------------------- space_1: ;send a space header tx16_1,5,"space" space: rcall stackme_2 .dw $0020 rcall emitcode ret ;with space sent ;------------------------------------------ report_1: ;send a report at the start of the prog. Esp for system vars debugging header space_1,6,"report" report: ;.ifdef livetesting rcall gethere rcall dot rcall space rcall getlatest rcall dot rcall space rcall getvarptr rcall dot rcall space ;.endif ret ;---------------------------------------------------- variable_1: ;classic variable header report_1,8,"variable" variable: rcall variablecode takemeout '~' rcall dumpbuf1 rcall report takemeout '!' ret ;with variable's name and ram adr in word in flash dictionary ;--------------------------- LATEST: depth_1: ;classic size of stack header variable_1,5,"depth" depth: rcall depthcode ret ;with depth num on stack ;----------------------------------------------- HERE: .db "444444444444444444444444444444" rcall stackme_2 .dw $1234 rcall two rcall stackme_2 .dw $2468 ;---------------stackme_2 used to live here---------------------------------- ;==================================================================================================== .ORG 0 rjmp quit ; rjmp mainloop ; rjmp start ;typein: .db "11bb 0014 %! getlatest",$0d, "0013 %@",0x0d typein: .db "test1", $0d ;typein: .db " : qqq one two dup one ; qqq " ,$0d ;"11bb 0014 %! ", $0d ;%! getlatest",$0d, "0013 %@",0x0d ;" one 0010 00ab %c! 0012 cdef %! 0013 %c@ 0013 %@ 0987 drop ", 0x0d ;stackme dropx onex stackme swap drop",0x0d ;----------------------------------------------------- ;start: quit: ldi r16, low(RAMEND) out SPL, r16 ldi r16,high(RAMEND) out SPH, r16 ldi YL,low(myStackStart) ldi YH,high(myStackStart) ldi r16, 0xf9 ;PORTB setup out DDRB,r16 ; nop ldi r16, $ff out PORTB,r16 .IFDEF testing ;testing = simulating on avrstudio4 nop rcall burneepromvars ;not needed? .ENDIF forthloop: ldi r16, low(RAMEND) out SPL, r16 ldi r16,high(RAMEND) out SPH, r16 ldi YL,low(myStackStart) ldi YH,high(myStackStart) try: ;--------------------test these------------------ ;rcall dumpbuf1 ;rcall test_dumpbuf1 ;rcall waitForDDump ;rjmp testOKCR ;rjmp test_rxStrEndCR ;rcall test1 ;rjmp test_d16 ;rjmp test_d1617 ;rjmp test_dlowR ;rjmp test_dhighR ;rjmp test_dxyz ;rjmp test_depthcode ;rjmp test_dotScode ;rjmp try .ifdef testing rcall getline0 ;This is FORTH .else rcall serialFill clr STOP clr r1 clr SECONDLETTER clr BOTTOM rcall dlowR .endif ;TODO work out why this isn't working with test1 rcall dumpbuf1 ;TAKE OUT rcall interpretLine rcall dumpbuf1 .ifdef testing nop quithere: rjmp quithere ;only want one line interpreted when testing .else takemeout '(' rjmp forthloop .endif ;------------------------------------------------------- ;rjmp test_interpretLine ;rjmp test_cfetch ;rjmp test_store ;rjmp test_cstore ;rjmp test_mpy16s ;rjmp test_mpy16s0 ;rjmp test_star ;rjmp test_div16s ;rjmp test_slashMod ;rjmp test_Hex4ToBin2 ;rjmp test_interpretLine ;rjmp setupforflashin ;rcall coloncode ;rjmp test_buf2ToFlashBuffer ;rjmp serialTest0 ;zzz stopper: rjmp stopper ; rjmp start ;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm mainloop: ;this is forth. This is run continuously. Needs two versions: live and simulation. ; rcall quit rcall getline0 rcall interpretLine ret ;-------------------------------------------------------------- getline0: ;force a line into buf1 via flash string. Simulates GETLINE ldi zl, low(typein<<1) ldi zh, high(typein<<1) ldi xl, low(buf1) ldi xh, high(buf1) type0: lpm r16,Z+ st x+,r16 cpi r16,0x0d ;have we got to the end of the line? brne type0 ret ;-------------------------------------------- ;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20 ;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char word: ;maybe give it a header later ld SECONDLETTER, x ;for debugging. TODO. Should be firstletter? ld r16,x+ ;get char cpi r16,0x20 ;is it a space? breq word ;if so get next char ;if here we're point to word start. so save this adr in w mov r24,xl mov r25,xh ;wordstart now saved in w clr r20 ;length initially 0 nextchar: inc r20 ;r20 = word length ld r16,x+ ;get next char cpi r16,0x20 brne nextchar dec r24 ;adjust start of word ;if here we've found a word.Starting at w length in r20.x points to space just past word ret ;---------------------------------------- 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. ; and the word in buf1 is pointed to by w=r24,25. len = r20. Z on entry points to the link. Needs +2 to lpm r23,z+ lpm r22,z+ ;store next link in v=r22,23. z now points to len byte startc: ;TODO save copy of flash word in r21 and also do masking of immediates push r20 ;save length lpm r16,Z+ ;length of dictionary word, first entry now in r16 mov r21,r16 ;copy length-in-flash to r21. May have immediate bit (bit 7) andi r16,$0f ;mask off top nibble before comparing cp r16,r20 ;same lengths? brne outcom ;not = so bail out ;if here the words are the same length, what about the rest of the chars.First get x to point to word. mov xl,r24 mov xh,r25 ;x now point to start of buf1 word upcom: lpm r16,z+ ld r17,x+ ;get one corresponding char from each word cp r16,r17 ;same word? brne outcom ;bail out if chars are different dec r20 ;count chars brne upcom ;still matching and not finished so keep going ;if here r20 is 0 so match must have been perfect so FOUND = 1 clr FOUND inc FOUND outcom: pop r20 ;get old lngth of buf1 word back ret ;------------------------------------------- jmpNextWord: ;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte) ; and w = r24,25 contains RAM word start with len in r20 ;exit with z pointing to next word ready for next COMPARE. clc rol r22 rol r23 ;above 3 instructions change word address into byte address by doubling movw r30,r22 ;z now points to next word ret ;----------------------------------------- doLatest: ;set up so first jump in dictionary is to top=LATEST and other flags set up. ; ldi vl, low(LATEST) ; ldi vh, high(LATEST) nop rcall getlatest ;from eeprom. Now on stack mypop2 vh,vl ; ; rcall halve clr FOUND clr BOTTOM ;not yet found the match, not yet at the bottom. Either will stop search. clr STOP ;keep parsing words til this goes to a 1 ret ;--------------------------------------------- interpretLine: ;given line of words in buf one, search for words one by one. Don't do code ; or compile at this stage, just find and report that and go into next one. ; rcall getline0 ;change later to real getline via terminal rcall pasteEOL ; clr STOP ;can still be 1 from previous line-inputs ;takemeout '2' ldi xl, low(buf1) ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop. clr FOUNDCOUNTER ;counts finds in line parsing. nextWord: rcall dlowR tst STOP brne stopLine takemeout 'S' nop rcall word takemeout 'w' rcall findWord takemeout 'F' takemeout '.' ;not done yet rcall dealWithWord ;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le} rjmp nextWord stopLine: takemeout 'E' ret ;----------------------------------------------------------------- findWord: rcall doLatest nop ;rcall dumpbuf1 ;FIND reg values here. rcall considercode upjmpf: rcall jmpNextWord takemeout 'f' rcall compare tst FOUND brne stopsearchf ;if last compare got a match (FOUND=1) then stop searching tst vl brne upjmpf ;if v=0000 then we've hit the bottom of the dictionary tst vh brne upjmpf ;not found and not at bottom so keep going ;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary clr BOTTOM inc BOTTOM ;exit with FOUND=0 and BOTTOM =1 stopsearchf: nop ret ;---------------------------- test_interpretLine: rcall interpretLine til: rjmp til ;** with r24 pointing to 'S' and FOUND = r15 =1 ;------------------------------ dealWithWord: ;come here when it's time to compile or run code ;Good debugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just ; 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 ; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match ; nop tst FOUND breq notfound inc FOUNDCOUNTER ;want to hop over filler bytes,0's added to keep codes on even byte boundaries ; so if r30 is odd at this stage inc it. odd is lsbit = 1. sbrs r30,0 ;skip next instruction if final bit lsb = 1 rjmp downd ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary inc r30 brcc downd inc r31 ;add one to z before converting to bytes ;have to ask at this point, is the word immediate? If so, bit 7 of r21 will be set. downd: sbrs r21,7 rjmp downdw ;not immediate so just go on with STATE test rjmp executeme ;yes, immediate so execute every time. downdw: tst STATE breq executeme rcall compilecode rjmp outdww executeme: clc ror zh ror zl ;put z back into word values rcall executeCode .MESSAGE "Word found" rjmp outdww notfound: nop ; .MESSAGE "Word not found" ; clr STOP ; inc STOP ;stop parsing line takemeout 'n' rcall numberh ; word not in dict so must be a number? Form = HHHH ;now have to add 3 to x so it points past this word ready not next one clc inc r26 inc r26 inc r26 brcc outdww inc r27 ;but only if overflow nop outdww: ret ;with STOP =1 in not a number ;------------------------------------------------------------------------ pasteEOL: ;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a ; special end of line word. When the word is invoked it casues a QUIT back to the waiting for input stage. ; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 " ldi xl, low(buf1) ldi xh, high(buf1) ;pnt to start of buffer clr r17 nxtChar: inc r17 ;r17 is counter. Bail out when r17 > BUF1LENGTH cpi r17, BUF1LENGTH -3 breq outProb ld r16, x+ cpi r16, $0d brne nxtChar ;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it. ldi r16,$20 st -x, r16 ;back up. Then go forward. TAKEMEOUT 'p' ; ldi r16, ']' ldi r16,$20 ;This took about 4 day's work to insert this line. Why is it needed? st x+, r16 ldi r16,'S' st x+, r16 ; ldi r16, '}' ; st x+, r16 ldi r16, $20 st x, r16 rjmp outpel outProb: takemeout 'O' nop .MESSAGE "Couldn't find $0d" outpel: ret ;------------------------------------- executeCode: ;with Z pointing to cfa. Not sure whether to jmp or call ijmp ret ;--------------------------------------- test_fetch: ;do run thru of @ rcall getline0 ;change later to real getline via terminal rcall pasteEOL ldi xl, low(buf1) ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop. ldi r16,$62 mypush r16 ldi r16,$0 mypush r16 ;should now have adr $0062 on mystack rcall fetch tf1: rjmp tf1 ;--------------------------------- test_cfetch: ;do run thru of @ rcall getline0 ;change later to real getline via terminal rcall pasteEOL ldi xl, low(buf1) ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop. ldi r16,$62 mypush r16 ldi r16,$0 mypush r16 ;should now have adr $62 on mystack rcall cfetch tcf1: rjmp tcf1 ;---------------------------- test_store: rcall getline0 ;change later to real getline via terminal rcall pasteEOL ldi xl, low(buf1) ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop. ldi r16,$62 ldi r17,$0 mypush2 r16,r17 ;should now have adr $62 on mystack ldi r16, $AB ldi r17, $CD mypush2 r16,r17 ;now have $ABCD on mystack rcall store ts1: rjmp ts1 ;------------------------ test_cstore: rcall getline0 ;change later to real getline via terminal rcall pasteEOL ldi xl, low(buf1) ldi xh,high(buf1) ;last 3 statemnts are done onece. Now the main loop. ldi r16,$62 ldi r17,$0 mypush2 r16,r17 ;should now have adr $62 on mystack ldi r16, $AB ; ldi r17, $CD mypush r16 ;now have $ABCD on mystack rcall cstore ts11: rjmp ts11 ;Now put arith routines here. Are from AVR200. Just using 16*16 for * but get 32bit result. ;*************************************************************************** ;* ;* "mpy16s" - 16x16 Bit Signed Multiplication ;* ;* This subroutine multiplies signed the two 16-bit register variables ;* mp16sH:mp16sL and mc16sH:mc16sL. ;* The result is placed in m16s3:m16s2:m16s1:m16s0. ;* The routine is an implementation of Booth's algorithm. If all 32 bits ;* in the result are needed, avoid calling the routine with ;* -32768 ($8000) as multiplicand ;* ;* Number of words :16 + return ;* Number of cycles :210/226 (Min/Max) + return ;* Low registers used :None ;* High registers used :7 (mp16sL,mp16sH,mc16sL/m16s0,mc16sH/m16s1, ;* m16s2,m16s3,mcnt16s) ;* ;*************************************************************************** ;***** Subroutine Register Variables .def mc16sL =r16 ;multiplicand low byte .def mc16sH =r17 ;multiplicand high byte .def mp16sL =r18 ;multiplier low byte .def mp16sH =r19 ;multiplier high byte .def m16s0 =r18 ;result byte 0 (LSB) .def m16s1 =r19 ;result byte 1 .def m16s2 =r20 ;result byte 2 .def m16s3 =r21 ;result byte 3 (MSB) .def mcnt16s =r22 ;loop counter ;***** Code mpy16s: clr m16s3 ;clear result byte 3 sub m16s2,m16s2 ;clear result byte 2 and carry ldi mcnt16s,16 ;init loop counter m16s_1: brcc m16s_2 ;if carry (previous bit) set add m16s2,mc16sL ; add multiplicand Low to result byte 2 adc m16s3,mc16sH ; add multiplicand High to result byte 3 m16s_2: sbrc mp16sL,0 ;if current bit set sub m16s2,mc16sL ; sub multiplicand Low from result byte 2 sbrc mp16sL,0 ;if current bit set sbc m16s3,mc16sH ; sub multiplicand High from result byte 3 asr m16s3 ;shift right result and multiplier ror m16s2 ror m16s1 ror m16s0 dec mcnt16s ;decrement counter brne m16s_1 ;if not done, loop more ret ;---------------------------------------------------------- ;***** Multiply Two Signed 16-Bit Numbers (-12345*(-4321)) test_mpy16s: ldi mc16sL,low(-12345) ldi mc16sH,high(-12345) ldi mp16sL,low(-4321) ldi mp16sH,high(-4321) rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0 ;=$032df219 (53,342,745) tmpy: rjmp tmpy test_mpy16s0: ldi mc16sL,low(123) ldi mc16sH,high(123) ldi mp16sL,low(147) ldi mp16sH,high(147) rcall mpy16s ;result: m16s3:m16s2:m16s1:m16s0 tmpy0: rjmp tmpy0 ;----------------------- test_star: ldi r16,-$7b mypush r16 ldi r16,$00 mypush r16 ;that's decimal 123 on stack ldi r16,$93 mypush r16 ldi r16,$00 mypush r16 ; and thats dec'147 rcall star tsr: rjmp tsr ;-------------------------- ;*************************************************************************** ;* ;* "div16s" - 16/16 Bit Signed Division ;* ;* This subroutine divides signed the two 16 bit numbers ;* "dd16sH:dd16sL" (dividend) and "dv16sH:dv16sL" (divisor). ;* The result is placed in "dres16sH:dres16sL" and the remainder in ;* "drem16sH:drem16sL". ;* ;* Number of words :39 ;* Number of cycles :247/263 (Min/Max) ;* Low registers used :3 (d16s,drem16sL,drem16sH) ;* High registers used :7 (dres16sL/dd16sL,dres16sH/dd16sH,dv16sL,dv16sH, ;* dcnt16sH) ;* ;*************************************************************************** ;***** Subroutine Register Variables .def d16s =r13 ;sign register .def drem16sL=r14 ;remainder low byte .def drem16sH=r15 ;remainder high byte .def dres16sL=r16 ;result low byte .def dres16sH=r17 ;result high byte .def dd16sL =r16 ;dividend low byte .def dd16sH =r17 ;dividend high byte .def dv16sL =r18 ;divisor low byte .def dv16sH =r19 ;divisor high byte .def dcnt16s =r20 ;loop counter ;***** Code div16s: ;push r13 ;PB !! ;push r14 ;PB !! mov d16s,dd16sH ;move dividend High to sign register eor d16s,dv16sH ;xor divisor High with sign register sbrs dd16sH,7 ;if MSB in dividend set rjmp d16s_1 com dd16sH ; change sign of dividend com dd16sL subi dd16sL,low(-1) sbci dd16sL,high(-1) d16s_1: sbrs dv16sH,7 ;if MSB in divisor set rjmp d16s_2 com dv16sH ; change sign of divisor com dv16sL subi dv16sL,low(-1) sbci dv16sL,high(-1) d16s_2: clr drem16sL ;clear remainder Low byte sub drem16sH,drem16sH;clear remainder High byte and carry ldi dcnt16s,17 ;init loop counter d16s_3: rol dd16sL ;shift left dividend rol dd16sH dec dcnt16s ;decrement counter brne d16s_5 ;if done sbrs d16s,7 ; if MSB in sign register set rjmp d16s_4 com dres16sH ; change sign of result com dres16sL subi dres16sL,low(-1) sbci dres16sH,high(-1) d16s_4: ;pop r14 ;PB!! ;pop r13 ;PB!! ret ; return d16s_5: rol drem16sL ;shift dividend into remainder rol drem16sH sub drem16sL,dv16sL ;remainder = remainder - divisor sbc drem16sH,dv16sH ; brcc d16s_6 ;if result negative add drem16sL,dv16sL ; restore remainder adc drem16sH,dv16sH clc ; clear carry to be shifted into result rjmp d16s_3 ;else d16s_6: sec ; set carry to be shifted into result rjmp d16s_3 ;----------------------------------------------- test_div16s: ;***** Divide Two Signed 16-Bit Numbers (-22,222/10) ldi dd16sL,low(-22222) ldi dd16sH,high(-22222) ldi dv16sL,low(10) ldi dv16sH,high(10) rcall div16s ;result: $f752 (-2222) ;remainder: $0002 (2) forever:rjmp forever ;---------------------------------- test_slashMod: ldi r16,$12 mypush r16 ldi r16,$34 mypush r16 ldi r16,$56 ;NB this is $3412 not $1234 mypush r16 ldi r16,$00 mypush r16 rcall slashMod ;$3412 / $56 = $9b rem 0 works tslm: rjmp tslm ;--------------------------------------- ;From http://www.avr-asm-tutorial.net/avr_en/calc/CONVERT.html#hex2bin ; Hex4ToBin2 ; converts a 4-digit-hex-ascii to a 16-bit-binary ; In: Z points to first digit of a Hex-ASCII-coded number ; Out: T-flag has general result: ; T=0: rBin1H:L has the 16-bit-binary result, Z points ; to the first digit of the Hex-ASCII number ; T=1: illegal character encountered, Z points to the ; first non-hex-ASCII character ; Used registers: rBin1H:L (result), R0 (restored after ; use), rmp ; Called subroutines: Hex2ToBin1, Hex1ToBin1 .def rBin1H =r17 .def rBin1L = r16 .def rmp = r18 ; Hex4ToBin2: clt ; Clear error flag rcall Hex2ToBin1 ; convert two digits hex to Byte brts Hex4ToBin2a ; Error, go back mov rBin1H,rmp ; Byte to result MSB rcall Hex2ToBin1 ; next two chars brts Hex4ToBin2a ; Error, go back mov rBin1L,rmp ; Byte to result LSB sbiw ZL,4 ; result ok, go back to start Hex4ToBin2a: ret ; ; Hex2ToBin1 converts 2-digit-hex-ASCII to 8-bit-binary ; Called By: Hex4ToBin2 ; Hex2ToBin1: push R0 ; Save register rcall Hex1ToBin1 ; Read next char brts Hex2ToBin1a ; Error swap rmp; To upper nibble mov R0,rmp ; interim storage rcall Hex1ToBin1 ; Read another char brts Hex2ToBin1a ; Error or rmp,R0 ; pack the two nibbles together Hex2ToBin1a: pop R0 ; Restore R0 ret ; and return ; ; Hex1ToBin1 reads one char and converts to binary ; Hex1ToBin1: ld rmp,z+ ; read the char subi rmp,'0' ; ASCII to binary brcs Hex1ToBin1b ; Error in char cpi rmp,10 ; A..F brcs Hex1ToBin1c ; not A..F cpi rmp,$30 ; small letters? brcs Hex1ToBin1a ; No subi rmp,$20 ; small to capital letters Hex1ToBin1a: subi rmp,7 ; A..F cpi rmp,10 ; A..F? brcs Hex1ToBin1b ; Error, is smaller than A cpi rmp,16 ; bigger than F? brcs Hex1ToBin1c ; No, digit ok Hex1ToBin1b: ; Error sbiw ZL,1 ; one back set ; Set flag Hex1ToBin1c: ret ; Return ;-------------------------------------- test_Hex4ToBin2: pushz ldi zl,$60 clr zh ;z now points to start of buf1 ldi r16,'0' st z+,r16 ldi r16,'f' st z+,r16 ldi r16,'2' st z+,r16 ldi r16,'3' st z+,r16 ldi zl,$60 clr zh ;z now points back to start of buf1 rcall Hex4ToBin2 popz th4: rjmp th4 ;------------------------------------- numberh: ;word not in dictionary. Try to convert it to hex. pushz ;algorithm uses z, pity movw zl,r24 ;r4,25 = w holds start of current word ;z now points eg to '12ab'start. If t=0 then it coverts to real hex rcall hex4ToBin2 ;try to convert ;above call needs 4 hex digits to emerge with t=0 and binary in r16,17 ;want this. If t=0 stack r16,17 and carry on interpreting, else emerge with ; t=1 and zpointing to first problem char brtc gotHex ; if here there's a problem that z is pointing to. Bail out of interpret line clr STOP inc STOP ;TODO put routine here that notes the word can't be excuted and it's ; not a number. So output ramstring starting at adr = r24,25 and len in r20 rjmp outnh gotHex: ;sucess.Real hex in r16,17 mypush2 r16,r17 ; so push num onto mystack ;maybe we're compiling. If so, push num into dic preceded by a call to stackme_2 tst STATE breq outnh ;STATE =0 means executing ; rcall tic ; .db "stackme_2" ;has to be in dic before a number. cfa of stackme_2 on stack rcall compstackme_2 ; rcall compileme ;insert "rcall stackme_2"opcode into dic rcall comma ;there's the number going in outnh: popz ; but will it be pointing to "right"place in buf1? Yes now OK ret ; numberh not working fully, ie doesn't point to right place after action. ; also no action if not a number? DONE better save this first. ;--------------------------------- ;eeroutines eewritebyte: ;write what's in r16 to eeprom adr in r18,19 sbic EECR,EEPE rjmp eewritebyte ;keep looping til ready to write ;if here the previous write is all done and we can write the next byte to eeprom out EEARH,r19 out EEARL,r18 ;adr done out EEDR,r16 ;byte in right place now sbi EECR,EEMPE sbi EECR,EEPE ;last 2 instruc write eprom. Takes 3.4 ms ret ;test with %! ;--------------------------------- eereadbyte: ; read eeprom byte at adr in r18,19 into r16 ; Wait for completion of previous write sbic EECR,EEPE rjmp eereadbyte ; Set up address (r18:r17) in address register out EEARH, r19 out EEARL, r18 ; Start eeprom read by writing EERE sbi EECR,EERE ; Read data from data register in r16,EEDR ret ;------------------------------ setupforflashin: ;using here etc get appropriate page, offset,myhere values. ; ldi r16,low(HERE) ; ldi r17,high(HERE) ;get here, but from eeprom better? ; mypush2 r16,r17 ;above was a problem replace with one line below rcall gethere ;HERE = eg 0a12.Now on stk.Comes from eepprom each time rcall stackme_2 .dw 0002 rcall star ;now have current HERE in bytes in flash. But what is myhere? rcall stackme_2 .db $0040 ;64 bytes per page rcall slashMod ;offset on top pagenum under. eg pg 0047, offset 0012 mypop2 r9,r8 ;store offset (in bytes) rcall stackme_2 .db $0040 rcall star ;pgnum*64 = byte adr of start of flash page mypop2 r7,r6 mypush2 r8,r9 ;push back offset rcall stackme_2 .dw buf2 nop ;at this stage we have offset in r8,r9 (0012). Also byte adr of flash page ; start in r6,r7.(11c0) Stk is (offset buf2Start --) (0012 00E0 --). Need to ; add these two together to get myhere, the pointer to RAM here position. rcall plus ;add offset to buf2 start to get myhere (00f2) ; put my here in r4,r5 for time being. mypop2 r5,r4 ;contains eg 00f2 <--myhere pushz ;going to use z so save it movw zl,r6 ;r6,7 have byte adr of flsh pg strt pushx ;save x ldi xl,low(buf2) ldi xh,high(buf2) ;point x to start of buf2 ldi r18,128 ;r18=ctr. Two flash pages = 128 bytes upflash: lpm r16,z+ ;get byte from flash page st x+, r16 ; and put into buf2 dec r18 brne upflash ;done. Now have two flash pages in ram in buf2. Myhere points to where next ; entry will go. Where's page num? popx popz ;as if nothing happened ret ;outsufi: rjmp outsufi ;----------------------------------- burneepromvars: ;send latest versions of eHERE and eLATEST to eeprom ldi r16,low(HERE) ldi r17,high(HERE) mypush2 r16,r17 ;up top we have .equ eHERE = $0010 ldi r16,low(eHERE) ldi r17,high(eHERE) mypush2 r16,r17 ;now have n16 eadr on stack ready for e! rcall percentstore ;send latest versions of eLATEST to eeprom ldi r16,low(LATEST) ldi r17,high(LATEST) mypush2 r16,r17 ;up top we have .equ eLATEST = $0010 ldi r16,low(eLATEST) ldi r17,high(eLATEST) mypush2 r16,r17 ;now have n16 eadr on stack ready for e! rcall percentstore ret ;------------------------------------------- coloncode: ;this is the classic colon defining word. rcall setupforflashin ;get all the relevant vars and bring in flash to buf2 rcall relinkcode ; insert link into first cell rcall create ;compile word preceeded by length rcall leftbrac ;set state to 1, we're compiling takemeout 'c' rcall report takemeout 'c' ret ;now every word gets compiled until we hit ";" ;------------------------- relinkcode: ;put LATEST into where myhere is pointing and update ptr = myhere ;also create mylatest rcall getlatest ;now on stack mypopa ;latest in r16,17 pushz ;better save z movw mylatest,myhere ;mylatest <-- myhere movw zl,myhere ;z now points to next available spot in buf2 st z+,r17 ;problem. Don't work unless highbye first in mem.Why? st z+,r16 ;now have new link in start of dic word movw myhere,zl ;update myhere to point to length byte. (Not yet there.) popz ;restore z ret ;------------------------------------------------- create: ;put word after ":" into dictionary, aftyer link, preceeded by len rcall word ;start with x pnting just after ":".End with len in r20, x pointing to ; space just after word and start of word in w=r24,25 pushz ;save z. It's going to be used on ram dictionary movw zl,myhere ;z now pnts to next spot in ram dic st z+,r20 ; put len byte into ram dic mov r18,r20 ;use r18 as ctr, don't wreck r20 pushx ;save x. It's going to be word ptr in buf1 movw xl,wl ;x now points to start of word. Going to be sent to buf2 sendbytes: ld r16,x+ ;tx byte from buf1 to st z+,r16 ; buf2 dec r18 ;repeat r20=r18=len times brne sendbytes sbrs r30,0 ;skip next instruction if final bit lsb = 1 rjmp downcr ;if here lsb = 1 so we're on a padding byte and have to add 1 to get to a 2 byte boundary clr r16 st z+,r16 ;insert padding byte ;inc r30 ;brcc downcr ;inc r31 ;add one to z before converting to bytes downcr: movw myhere,zl ;myhere now points to beyond word in dic popx popz ret ;with word in dic ;---------------------------------------------- leftbrac: ;classic turn on compiling clr STATE inc STATE ;state =1 ==> now compiling ret ;------------------------ compilecode: ;come here with STATE =1 ie compile, not execute. Want to put ; eg rcall dup in code in dictionary but not to execute dup. If here ; z points to byte address of word mypush2 zl,zh compileme: mypush2 myhere,r5 ;push ptr to RAM dic ;next is entry point for eg ' stackme2 already on stack and have to compile ldi r16,low(buf2) ldi r17,high(buf2) ;start of buf that conatins flash pg in RAM mypush2 r16,r17 rcall minus ; myhere - buf2-start = offset in page mypush2 SOFPG,r7 ;push start of flash page address rcall plus ;SOFPG + offset = adr of next rcall in dic ;if here we have two flash addresses on the stack. TOS = here. Next is there. ;want to insert code for "rcall there w"hen I'm at here. eg current debugging indicates ; here = $11EB and there is $1012 (cfa of "two"). First compute ; relative branch "there - here -2". Then fiddle this val into the rcall opcode rcall minus ;that;s there - here. Usu negative. ;I got fffffffff..ffe27 for above vals. First mask off all those f's rcall two ;stack a 2 rcall minus ;now have there-here -2 = fe24. When there,here in bytes. mypopa ;bring fe26 into r16,17 clc ror r17 ror r16 ;now a:= a/2 ldi r18,$ff ldi r19,$0f ;mask and r16,r18 and r17,r19 ; mypush2 r16,r17 ;now fe26 --> 0e26 ;the rcall opcode is Dxxx where xxx is the branch ; mypopa ;bring fe26 into r16,17 ldi r19, $d0 ;mask or r17,r19 mypush2 r16,r17 ;now have $de26 on stack which is (?) rcall two rcall comma ;store this opcode into dic. myhere is ptr ret ;--------------------------- stackme_2: ;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack ; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack. pop r17 pop r16 ; they now contain eg 0x0804 which contain the 16bit num movw zl,r16 ;z now points to cell that cobtains the number clc rol zl rol zh ;double word address for z. lpm coming up lpm r16,z+ lpm r17,z+ ;now have 16bit number in r16,17 st y+,r16 st y+, r17 ;mystack now contains the number clc ror zh ror zl ;halve the z pointer to step past the number to return at the right place push zl push zh ret ;------------------------------flash write section-------------------- do_spm: ;lds r16,SPMCSR in r16,SPMCSR andi r16,1 cpi r16,1 breq do_spm mov r16,spmcsr_val out SPMCSR,r16 spm ret ;------------------------------------------------------------------- buf2ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there. push r30 ;save for later spm work. push r19 push xl push xh ;used as buf_ctr but may interfere with other uses ldi XL,low(buf2) ;X pnts to buf1 that contains the 64 bytes. ldi XH, high(buf2) ;assume Z is already pointing to correct flash start of page. flashbuf: ldi buf_ctr,32 ;send 32 words sendr0r1: ld r16, x+ ;get first byte mov r0,r16 ; into r0 ld r16, x+ ; and get the second of the pair into mov r1,r16 ; into r1 ldi spmcsr_val,01 ;set up for write into spare buffer flash page rcall do_spm ;that's r0,r1 gone in. inc r30 inc r30 dec buf_ctr ;done 32 times? brne sendr0r1 pop xh pop xl pop r19 ;dont need buf_ctr any more. pop r30 ;for next spm job ret ;-------------------------------------------------------------------------- ;TODO just have 1 burn routine with buf different buf3ToFlashBuffer: ;send the 64 bytes, 32 words to flash page <-- Z pnts there. push r30 ;save for later spm work. push r19 ;used as buf_ctr but may interfere with other uses push xl push xh ldi XL,low(buf2+64) ;X pnts to buf1 that contains the 64 bytes. ldi XH, high(buf2+64) ;assume Z is already pointing to correct flash start of page. rjmp flashbuf ldi buf_ctr,32 ;send 32 words sendr0r3: ld r16, x+ ;get first byte mov r0,r16 ; into r0 ld r16, x+ ; and get the second of the pair into mov r1,r16 ; into r1 ldi spmcsr_val,01 ;set up for write into spare buffer flash page rcall do_spm ;that's r0,r1 gone in. inc r30 inc r30 dec buf_ctr ;done 32 times? brne sendr0r3 pop r19 ;dont need buf_ctr any more. pop r30 ;for next spm job ret erasePage: ; assume Z points to start of a flash page. Erase it. ldi spmcsr_val,0x03 ;this is the page erase command rcall do_spm ret ;------------------------------------------------------------------ writePage: ldi spmcsr_val, 0x05 ;command that writes temp buffer to flash. 64 bytes rcall do_spm nop ; page now written. z still points to start of this page ret ;--------------------------------------------------------------- test_buf2ToFlashBuffer: ;(adr_flashbufstartinBytes -- ) ; rcall fillBuf ; ldi ZH, $10 ; ldi ZL,$c0 ;z=$01c0. Start of page 67. rcall gethere rcall double ;want bytes not words for flash adr mypopa ;flashPgStart byte adr now in r16,17 movw zl,r16 ;z <--start of flash buffer rcall erasePage rcall buf2ToFlashBuffer rcall writePage herettt: rjmp herettt ;---------------------- ; y2. Come here from ";". The pair r6,r7 point to start of flash pg (bytes) burnbuf2and3: takemeout 'U' ldi r16, 'U' clr r17 mypush2 r16,r17 rcall emitcode movw zl,r6 ;z now pnts to start of flash buf rcall erasePage rcall buf2ToFlashBuffer rcall writePage ;now going to burn next ram buffer to next flash page. Bump Z by 64 bytes. adiw zh:zl,63 ;z now points to start of next flash buffer lpm r16,z+ ;advance z pointer by one.adiw only lets max of 63 to be added. ;now z points to start of next 64 byte buffer. Time to put buf3 into it. rcall erasePage rcall buf3ToFlashBuffer rcall writePage ret heret: rjmp heret ;------------------------------------------------------------- updatevars: ;after doing a colon def we have to update sys vars ;TODO new version of LATEST is just old version of HERE. ;TODO rplace all this code with updatevars2 ; just shif HERE into LATEST in eeprom to update. Gen. tidy required. mypush2 r4,r5 ;put myhere on stack (E8) ldi r16,low(buf2) ldi r17,high(buf2) mypush2 r16,r17 ;start of buf2 on stack (E0) rcall minus ;myhere-buf2 = offset. (e8-e0 = 08) mypush2 SOFPG,r7 ; push onto stk start adr of flash page rcall plus ;SOFG + offset = new HERE ;now put also on stack new version of LATEST mypush2 r2,r3 ;that's mylatest on stack ldi r16,low(buf2) ldi r17,high(buf2) mypush2 r16,r17 ;start of buf2 on stack (E0) rcall minus ;myhere-buf2 = offset. (e8-e0 = 08) mypush2 SOFPG,r7 ; push onto stk start adr of flash page rcall plus ;SOFG + offset = new LATEST ; now have both LATEST (tos) and HERE on stack. Burn these into eeprom ;up top we have .equ eLATEST = $0010 ;But it's too big. In bytes and causing probs. Solution=covert to words rcall halve ldi r16,low(eLATEST) ldi r17,high(eLATEST) mypush2 r16,r17 ;now have n16 eadr on stack ready for e! rcall percentstore ; TODO the value for HERE is prob in bytes too. Convert to words. ;up top we have .equ eLATEST = $0010 ldi r16,low(eHERE) ldi r17,high(eHERE) mypush2 r16,r17 ;now have n16 eadr on stack ready for e! rcall halve ;TODO check this rcall percentstore ret ;with stack clear and new vals for HERE and LATEST in eeprom ;---------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;Now serial stuff starts;;;;;;;;;;;;;;;;;;;;;;;;; halfBitTime: ;better name for this delay. Half of 1/600 ;myDelay1200: ;ldi r21,13 ; 13 works for m328 at 16Mhz push r20 push r21 ldi r21,7 ;try 7 for tiny85 at 8Hmz ldi r20,130 ;r20,21 at 130,7 give 833uS. Good for 600baud at 8Mhz starthbt: inc r20 nop brne starthbt dec r21 brne starthbt pop r21 pop r20 ret ;-------------------------------------------------- oneBitTime: rcall halfBitTime rcall halfBitTime ret ;------------------------------------------------- sendAZero: ;output 0 on Tx pin cbi PORTB,TX_PIN ; send a zero out PB0 ret ;----------------------------------------------------- sendAOne: ;output 1 on Tx pin sbi PORTB,TX_PIN ; send a zero out PB0 ret ;----------------------------------------------------- sendStartBit: ; send a 0 for one bit time rcall sendAZero rcall oneBitTime ret ;------------------------------------------------------- sendNextDataBit: ;main output routine for serial tx lsr serialByteReg ;push high bit into carry flag then inspect it ;originally did lsl but found lsb first. brcc gotzero ;if it's a 0 do nothing rcall sendAOne ;must have been a 1 in carry rjmp down gotzero: rcall sendAZero ;if here carry was a zero down: rcall oneBitTime ;so that 1 or 0 lasts 1/600 sec ret ;------------------------------------------------------------- send8DataBits: ; send all bits in serialByteReg ldi counterReg,8 ;8 data bits sendBit: rcall sendNextDataBit dec counterReg brne sendBit ret ;-------------------------------------------------------- sendStopBit: ; send a 1 for one bit time rcall sendAOne rcall oneBitTime ret ;-------------------------------------------------------- sendSerialByte: ;main routine. Byte in serialByteReg = r16 .ifdef testing mov r0, r16 .else push counterReg rcall sendStartBit rcall send8DataBits rcall sendStopBit rcall sendStopBit ;two stops pop counterReg .endif ret ;************************************************************** serialTest0: ;output series of 'AAAA..'s ldi serialByteReg, 0x43 ;0x41 rcall sendSerialByte rcall oneBitTime ; take a rest ldi r16,$44 mypush r16 rcall emitcode rjmp serialTest0 ;continue forever ;--------------------------------------------------------- ;---------Now do SerialRx routines------------------- waitForHigh: ;loop til RX is high sbis PINB,RX_PIN ;test that pin for set (PB2) rjmp waitForHigh ; loop if rx pin is low ret ;----------------------------------------------- waitForLow: ;PRONBLEMs loop til RX is low. FIXED. sbic PINB,2 ;test that pin for set (PB2) rjmp waitForLow ; loop if rx pin is high ret ;--------------------------------------------------- waitForStartBit: ;loop til get a real start bit rcall waitForHigh ;should be marking at start rcall waitForLow ;gone low. might be noise rcall halfBitTime ;is it still low in middle of bit time sbic PINB,RX_PIN ;..well, is it? rjmp waitForStartBit ;loop if level gone back high. Not a start bit. ret ;we've got our start bit ;---------------------------------------------------- checkForStopBit: ;at end, get carry flag to reflect level. Prob if c=0 rcall oneBitTime ; go into stop bit frame, halfway sec ;should stay a 1 in C if stop bit OK sbis PINB,RX_PIN ;don't clc if bit is high clc ;but only if we have a weird low stop bit ret ;with carry flag = stop bit. Should be a 1 ;------------------------------------------------------------- get8Bits: ;get the 8 data bits. No frame stuff clr rxbyte ;this will fill up with bits read from RX_PIN push counterReg ;going to use this so save contents for later ldi counterReg,8 ;because we're expecting 8 databits nextBit: rcall oneBitTime ;first enter here when mid-startbit rcall rxABit ;get one bit dec counterReg ;done? brne nextBit ;no, round again pop counterReg ;yes, finished, restor counter and get out ret ;--------------------------------------------------------------- rxABit: ;big serial input routine for one bit clc ;assume a 0 sbic PINB,RX_PIN ; skip nxt if pin low sec ;rx pin was high ror rxbyte ;carry flag rolls into msb first ret ;******************************** getSerialByte: ;big routine. Serial ends up in rxByte push counterReg rcall waitForStartBit ;**change rcall get8Bits rcall checkForStopBit pop counterReg ret ;with rxByte containing serial bye ;---------------------------------------------------- serialTest1: ;output A then reflect input. Worked OK ldi serialByteReg, 0x36 ;0x41 rcall sendSerialByte rcall oneBitTime ; take a rest rcall getSerialByte mov serialByteReg,rxByte ;output what's been read rcall sendSerialByte rjmp serialTest1 ;-------------------------------------------------------- ;----------Now doing buffer work. Want to and from 64 bytes---------- fillBuf: ldi ZL,low(buf1) ;buf1 is my buffer ldi ZH, high(buf1) ;Z now points to buf1 ldi counterReg,64 ;64 bytes in buffer ldi r16,$30 storeB0: st z+,r16 inc r16 dec counterReg brne storeB0 herefb: ; rjmp herefb ret ;---------------------------------------------------------- serialStrOut: ;X points to start of string,r17 has length ld serialByteReg, x+ rcall sendSerialByte dec r17 ;got to end of string? brne serialStrOut ret ;---------------------------------- test_serialStrOut: rcall fillBuf ldi XL,low(buf1) ;buf1 start of str ldi XH, high(buf1) ldi r17,64 ;going to send len=r17 bytes rcall serialStrOut here2: rjmp here2 ;-------------------------------------- waitForCharD: ;wait til eg a 'D' is pressed then do something. ldi serialByteReg, '>' ;0x41 rcall sendSerialByte rcall oneBitTime ; take a rest rcall getSerialByte mov serialByteReg,rxByte ;output what's been read cpi rxByte, 'D' brne waitForCharD ldi serialByteReg, '*' rcall sendSerialByte rjmp waitForCharD ;----------------------------------------------------------- dumpbuf1: .ifdef livetesting ldi XL,low(buf1) ;buf1 start of str ldi XH, high(buf1) ldi r17,64 ;going to send len=r17 bytes rcall serialStrOut .endif ret ;------------------------------------------------------------- test_dumpbuf1: rcall fillBuf rcall getSerialByte ;any one will do. rcall dumpbuf1 rjmp test_dumpbuf1 ;---------------------------------------------------------- waitForDDump: ;wait til eg a 'D' is pressed then dump buf1 ldi serialByteReg, '>' ;0x41 rcall sendSerialByte rcall oneBitTime ; take a rest rcall getSerialByte mov serialByteReg,rxByte ;output what's been read cpi rxByte, 'D' brne waitForDDump rcall dumpbuf1 rjmp waitForCharD ;--------------------------------------------------------------- rxStrEndCR: ;get a serial string that ends with CR clr counterReg ldi XL,low(buf1) ;buf1 is where str will go ldi XH, high(buf1) takemeout 'A' upsec: rcall getSerialByte st x+, rxByte ;char goes into buffer="buf1" cpi rxByte,$0d ;is it CR = end of string? breq fin inc counterReg ;don't go over 64 bytes cpi counterReg,64 brne upsec ;not too long and not CR so keep going fin: ret ;--------------------------------------------- test_rxStrEndCR: ;just a test of above rcall OK rcall CR rcall rxStrEndCR rcall dumpbuf1 rcall CR ; rcall waitForDDump rjmp test_rxStrEndCR ;------------------------------------------------------ test2_rxStrEndCR: ;want a diagnostic dump if testing. Works with .IFDEF rcall rxStrEndCR .IFDEF testing rcall dumpbuf1 .ENDIF rjmp test2_rxStrEndCR ;------------------------------------------------------------ rxStrWithLen: ;expect len char char char.. for len chars push counterReg ldi XL,low(buf1) ;buf1 is where str will go ldi XH, high(buf1) rcall getSerialByte ; get length bye Must be less than 65 mov counterReg, rxByte ;save len in counter cpi counterReg,65 ; brlo allOK ;less than 65 so carry on. Branch if Lower ldi counterReg,64 ; if len>64 then len=64. Buffer = buf1 only 64 bytes allOK: tst counterReg ;zero yet? breq finrs rcall getSerialByte ;next serial input byte st x+, rxByte ;put into buffer dec counterReg ;have we done len=counterReg bytes? rjmp allOK finrs: pop counterReg ret ;--------------------------------------------------------------- test_rsStrWithLen: ;works ok with macro $05GHIJKLM. Sends GHIJK ldi r16, '#' rcall sendSerialByte rcall rxStrWithLen rcall dumpbuf1 rjmp test_rsStrWithLen ;-----------------------------now start forth i/o words like emit------------------ emitcode: ; (n8 --)classic emit mypop r16 mypop r16 ;want lower byte eg in 0041 want just the 41 rcall sendserialbyte ret ;------------------------------------------------ insertret: ;semi has to end new word with ret = $9508 opcode pushx ;both xl,xh saved for later movw xl,myhere ;myhere points to next available spot in ram dic ldi r16,$08 st x+,r16 ;$08 part goes first ldi r16,$95 st x+,r16 ;ret now in ram. Just tidy pointers movw myhere,xl popx ;so x back where it was and ret inserted. ret ;-------------------------------- equalcode: ;(n1 n2 -- flag) if n1 = n2 flag = 0001 else 0000 mypopa mypopb ; now have TOS in r16,17, underneath that in r18,19 cp r16,r18 ;low bytes =? brne zout ;not equal so go out cp r17,r19 ;hi bytes =? brne zout ;no, so out ;if here both n16's are equal so push a 0001 rcall one rjmp aout ;done zout: rcall zero ;not = so push a zero aout: ret ;with a flag on stack replacing to n16's ;------------------------------ ;TODO eliminate below and replace with simpler RAM jmp code. calcjumpcode: ;(to from -- opcode_for_rjmp to at from) ;used when compiling. What is the rjmp opcode if ; we know the from and to adr on stack. ( to fr --) ldi r16, low(buf2) ldi r17, high(buf2) mypush2 r16,r17 ; (to fr $e0 --) rcall dup ;t f $e0 $eo rcall unrot ;t $e0 fr $e0 rcall minus ;t $e0 frOffset rcall unrot ;frOffset t $e0 rcall minus ;frOffset toOffset ;now apply these offsets in flash buffer. Add them to start of flash buffer adr mypush2 SOFPG,r7 ; frOffset toOffset SOFPG rcall dup ;frOffset toOffset SOFPG SOFPG rcall unrot ;frOffset SOFPG toOffset SOFPG rcall plus ;frOffset SOFPG toFlashAdr rcall unrot ;toFlashAdr frOffset SOFPG rcall plus ;toFlashAdr frFlashAdr rcall minus ;to -from give last 3 nibbles in rjmp opcode +1 rcall one rcall minus ; now have to - from -1 rcall stackme_2 .dw $0fff rcall andd ; now have eg. 0f20. Want Cf20 rcall stackme_2 .dw $c000 ;should now have right opcode eg cf20 ret ;with correct rjmp kkk on stack. Ready to insert into RAM dic. ;------------------- stackmyhere: ;( --- adr) put RAM ptr myhere on stack mypush2 myhere, r5 ret ;--------------------------- begincode: ;when using BEGIN just stack current address.No dic entry rcall stackmyhere ;put next adr on stack ret ;---------------------------- stkmyhere: ;put myhere on the stack, handy mypush2 myhere,r5 ret ;----------------------------------- stkSOBuf2: ;stack start of buf2. Handy. ldi r16,low(buf2) ldi r17,high(buf2) mypush2 r16,r17 ret ;with adr of buf2 on stk ;-------------------------- stkSOFPG: ;put start of flash page on stack, In bytes. mypush2 SOFPG,r7 ret ;with start of current flash page's adr on stack. ;------------------------------- stklatestadr: ;put e-adr of eLatest. Currently 012 in eeprom ldi r16,low(eLATEST) ldi r17,high(eLATEST) mypush2 r16,r17 ret ;with 012 or adr of eLatest on stk ;------------------------------------- stkhereadr: ;same as above but for HERE ldi r16,low(eHERE) ldi r17,high(eHERE) mypush2 r16,r17 ret ;with adr of ehere,current eeprom adr = $010 ;------------------------------------------- updatevars2: ;better version of update vars. Come here after ";" ;TODO check this version.DONE and eliminate other one. rcall gethere ;the HERE val now on stack. It's a pointer to flash. rcall stklatestadr ;usually 012 rcall percentstore ;now with LATEST now containing old HERE. Next fix HERE rcall stkmyhere ;current ptr to RAM dic's next free byte rcall stkSOBuf2 ;start of buf2 adr rcall minus ;gives distance into the buffer rcall stkSOFPG ;will add distance to start of flashbuf rcall plus ;got flash adr, but in bytes rcall halve ;now adr in words rcall stkhereadr ;usually %010 in eeprom rcall percentstore ;eHERE now updated ret ;with vals for HERE and LATEST in eeprom updated after ";" ;-------------------- testOKCR: rcall OK rcall OK rcall CR rjmp testOKCR ;-------------------- serialFill: ;main input routine from terminal. Output OK} then ; wait until buf1 has string of words ( <64 chars?) ending in $0d rcall clrbuf1 rcall CR rcall report rcall OK rcall rxStrEndCR ret ; buf1 now filled with words from terminal ;------------------------dump routines _______________ outnib: ;given $23 in r16, output the 3 as '3' = $33 push r18 ;going to use this andi r16,$0f ; $3a --> $0a cpi r16,$0a ;more than 10? brge gothexo ;Nibble >= 10 jump down to gothex ldi r18,$30 ; add $30 to 0..9 rjmp doneon gothexo: ldi r18,$37 doneon: add r16,r18 ;now r16 nibble $03 is a '3' rcall sendserialbyte ;print it pop r18 ;used this as counter ret ;note, it wrecks r16 ;-------------------------------------------- d16: ;dump contents of r16. Good for debugging. push r16 ;keep contents for later push r16 ;need this one after swap swap r16 ;$34 wants 3 to come out first rcall outnib ;print ascii eg '3'in above if r16 = $34 pop r16 ;get nice version back eg $34 rcall outnib ;print the '4' pop r16 ;so r16 not wrecked. ret ;with r16 printed in ascii ;----------------------------------- test_d16: ldi r16,$a5 rcall d16 ldi r16,$b6 rcall d16 rjmp test_d16 ;-------------------------------- d1617: ;dump r16 and r17 for debugging purposes push r16 push r17 ; push r16 ;just one min mov r16, r17 rcall d16 ;that's r17 gone pop r16 rcall d16 ;and then r16 pop r17 pop r16 ret ;with r17:r16 output in ascii ;---------------------------------------- test_d1617: ldi r16,$34 ldi r17,$1F rcall d1617 rjmp test_d1617 ;----------------------------------- dlowR: ;dump low registers. r0..r15 for debugging .ifdef livetesting push r16 push r18 pushx ;macro clr xl clr xh ldi r18,16 ;r18 is a counter prlow: ld r16,x+ ;assume is x is 0 we'll get r0 rcall d16 rcall spacecode dec r18 cpi r18,$07 breq doeseq7 tst r18 brne prlow rjmp outprl doeseq7: ldi r16,'L' rcall sendserialbyte rcall spacecode rjmp prlow outprl: popx ;macro pop r18 pop r16 .endif ret ;with all the registers r0 ..r15 output in ascii to terminal screen ;---------------------------------- test_dlowR: rcall CR ldi r16,$02 mov r0,r16 ldi r16,$52 mov r5,r16 ldi r16,$f2 mov r15,r16 rcall dlowR rcall CR rjmp test_dlowR ;----------------------------- spacecode: ;output a space push r16 ldi r16,$20 rcall sendserialbyte pop r16 ret ;------------------------------- dhighR: ;dump high registers. r18..r25 for debugging push r16 push r17 pushx ;macro ldi xl,18 ; clr xl clr xh ldi r17,8 ;r18 is a counter prhi: ld r16,x+ ;assume is x is 18 we'll get r18 rcall d16 rcall spacecode dec r17 cpi r17,5 breq doeseq21 tst r17 brne prhi rjmp outprh doeseq21: ldi r16,'H' rcall sendserialbyte rcall spacecode rjmp prhi outprh: popx ;macro pop r17 pop r16 ret ;with all the registers r0 ..r15 output in ascii to terminal screen ;---------------------------------- test_dhighR: rcall CR ldi r18,$88 ldi r19,$19 ldi r20,$88 ; ldi r21,$88 ldi r22,$22 ldi r23,$23 ldi r24,$24 ldi r25,$25 rcall dhighR rcall CR rjmp test_dhighR ;------------------------------------ dxyz: ;dump the three pointer regs x,y,z push r16 push r17 movw r16,xl ;r17:16 gets xh:xl rcall d1617 rcall spacecode movw r16,yl rcall d1617 rcall spacecode movw r16,zl rcall d1617 rcall spacecode pop r17 pop r16 ret ;with x,y,z output in ascii as a tripple ;-------------------------------------- test_dxyz: rcall CR ldi xl,$12 ldi xh,$34 ldi yl,$56 ldi yh,$78 ldi zl,$9A ldi zh,$bc rcall CR rcall dxyz rcall CR rjmp test_dxyz ;-------------------------------- ;mystack needs a DEPTH word. depthcode: ; (--n16) ;leave on mystack the number of items on the stack by bytes. movw r16,yl ;now r16,17 has y pointer ldi r18, low(myStackStart) ; ldi r19, high(myStackStart) ;r18,19 probably contain $1A0, the start of mystack mypush2 r16,r17 mypush2 r18,r19 ;setup for eg $1a6 - $1a0 rcall minus ;difference=depth = eg 0006 as above. ret ; with depth on stack ;----------------------------------------- test_depthcode: ldi r16,$01 ldi r17,$23 mypush2 r16,r17 mypush2 r16,r17 mypush2 r16,r17 rcall depthcode uptd: mypopa ;depth now in r16,17 up2: rcall d1617 rjmp up2 ;------------------------------------ dotScode: ;classic .S, print stack non-destructively push r16 push r18 pushx ;macro rcall depthcode ;now depth = len of stk on the mystack top ; rcall drop ;stk =eg 0006 . want just len = 06 mypop2 r17,r18 ;so r18 now has length in bytes we're printing ldi xl, low(myStackStart) ldi xh, high(myStackStart) ; movw xl,yl ;use x as temp ptr. Keep y pointing to mystack top upds: ld r16,x+ ;get tos, Pre-decrement. rcall d16 ;print it rcall spacecode ; dec r18 brne upds ldi r16, ']' rcall sendserialbyte rcall spacecode popx ;macro pop r18 pop r16 ret ;with the stack items printed to term screen + ] ;----------------------------- test_dotScode: ldi r16,$A1 ldi r17,$B2 mypush2 r16,r17 mypush2 r16,r17 mypush2 r16,r17 rcall dotScode rcall drop rcall drop rcall drop uptds: rjmp uptds ;--------------------------------- wordscode: ;classic words. List all the words in the dic push r16 push r17 push r22 push r23 push r24 pushz rcall doLatest ;get first link into v upwo: rcall jmpNextWord ;pnt to link part of next word lpm r23,z+ lpm r22,z+ ;store link into v=r23,24 lpm r16,z+ ;get len andi r16,$0f ;don't want eg $85 to be len when it means immediate len 5. clr r17 ;need eg 0006 on stk not 06 later mypush2 r16,r17 ;len byte now on mystk ;at this stage z points to the start of word name mypush2 zl,zh ;flash start adr of string now on mystack rcall swapp ; but wrong way round. Want len = TOS rcall Sdot ;print the string on the term rcall spacecode ;but add space after each word tst vl brne upwo ;if vl:vh = r23,24 = 0000 finish tst vh brne upwo popz ; pop r24 pop r23 pop r22 pop r17 ;TODO macro with multiple pops & pushes pop r16 ret ;with all the words in dic printed ;----------------------------------------------- clrbuf1: ldi ZL,low(buf1) ;buf1 is my buffer ldi ZH, high(buf1) ;Z now points to buf1 ldi counterReg,64 ;64 bytes in buffer ldi r16,$30 storecl: st z+,r16 inc r16 dec counterReg brne storecl ret ;----------------------- updatevarptrcode: ;update varptr currently at eeprom's 0016. Add 2 to its contents. rcall getvarptr ;eg 0160 in ram rcall two rcall plus ;now is eg 0162 rcall varptradr ;usually 0016 in eeprom rcall percentstore ;should be called estore ie e! ret ;with ptr val = old ptrval + 2 ;------------------------- variablecode: ;big word called each time variable is declared rcall coloncode ;does all the create work in buf rcall getvarptr ;put eg 0162 on stack. Address of next RAM var place. rcall compstackme_2 ;put stackme_2 as first code when called rcall comma rcall updatevarptrcode ;add 2 to varptr rcall semi ;finish off and burn to flash ret ;with variable created. ;---------------------------------- considercode: ;having probs with findword going awol. Need another debug routine. .ifdef livetesting rcall CR takemeout '[' ;just little mark for Id rcall dhighR ; ;Used when we've found a word.Starting at w(r24,25) length in r20. x points to space just past word. ; u = r22,23 takemeout ']' ;just little mark for Id .endif ret