A forth for LPC8xxx
Hello
Forth.s
- Committer:
- Recifarium
- Date:
- 2016-05-12
- Revision:
- 2:2f8532130cca
- Parent:
- 1:1224cf3799a5
File content as of revision 2:2f8532130cca:
; 19200/8/none/1 ;You must use the Keil µVision to assemble this source EXPORT Reset_Handler EXPORT __initial_sp AREA |.text|, CODE ; IMPORT __Vectors THUMB BuffSize EQU 64 ;---------------------------------- ; Values that can be customise ; Data stack & Return Stack are @ the begining ; of Data Memory area ReturnStackLength EQU 32 * 4 ; 32 cells DataStackLength EQU 32 * 4 ; 32 cells ; Then follow internal values ; UserVar EQU 64 * 4 ; 64 cells ;----------------------------------- ; Registers allocation | ; They are in this way to allow | ; the use of r0 r1 r2 r3 | ; to call subroutine | ;----------------------------------- ALIAS r0, WRK0 ; WoRK0 register ALIAS r1, WRK1 ; WoRK1 register ALIAS r2, WRK2 ; WoRK2 register ALIAS r3, WRK ; WoRK register ! used by the internal interpreter ALIAS r4, IPTR ; Instruction PoinTeR ; ALIAS r5, USER ; May be USER pointer in future ALIAS r6, TOS ; Top Of Stack , stack managed by sp ALIAS r7, RPTR ; Return stack PoinTeR ;----------------------------------- ; Next routine ;----------------------------------- MACRO $lab Next $lab LDMIA IPTR!, {WRK} ; Get indirect address to execute ; and update Instruction pointer LDR WRK2, [WRK] ; note that WRK point to the parameter field BX WRK2 ; it will be used later MEND ;----------------------------------- ; routines doCol/Con/Var ;----------------------------------- doCol STMIA RPTR!,{IPTR} ; Save Instruction pointer to the return Stack ; & Update Return stack pointer ADDS IPTR, WRK, #4 ; Point to parameter field Next doCon PUSH {TOS} ; LDR TOS,[WRK,#4] Next doVar PUSH {TOS} ; LDR TOS,[WRK,#4] Next ;----------------------------------- ; Exit Routine (restore IPTR) ;----------------------------------- Exit DCD xExit xExit SUBS RPTR, RPTR, #4 ; Adjust the return stack pointer LDR IPTR,[RPTR] ; Collect the value Next Lit32 DCD xLit32 xLit32 PUSH {TOS} LDM IPTR!,{TOS} ; Nearly like next but we collect the value Next Zero DCD doCon DCD 0 Ten DCD doCon DCD 10 ;----------------------------------- ;Not so usefull macro...to be change MACRO $lab LINK $p $lab DCD $p MEND ;----------------------------------- ; These macro compute the displacement ; which is store in a word MACRO $label Branch $target $label DCD Bra DCD $target ; DCD $target-. MEND MACRO $label ZBranch $target $label DCD ZBra DCD $target ; DCD $target-. MEND ;----------------------------------- Reset_Handler LDR RPTR, =Begin BL UartConfig SUBS TOS,TOS LDR WRK0, =end_data LDR WRK1, =AHERE STR WRK0, [WRK1] LDR IPTR, =test18 Next test17 DCD Zero, Dot Branch test17 test18 DCD Zero, nTib, Store DCD Zero, toIn, Store DCD Zero, State, Store ; Interpret mode DCD Dec ; Set decimal mode ; DCD Esc ; DCD Lit32, 'c', Emit, Lf ; Clear screen DCD Lit32 DCD Mess1 ; welcome message DCD Count, Type, Cr DCD Inter ; forever loop ;----------------------------------- ; Flag used in dictionary | ;----------------------------------- Cmponly EQU 0x20 ; Compile only Immed EQU 0x80 ; Indicate the word must be run immediatly ;----------------------------------- ; Dictionary start here ;-(DUP)-----------------------------(x -- x,x) LDup LINK 0 ; First word DCB 3, "DUP" Dup DCD xDup xDup PUSH {TOS} ; Push Top of stack onto the stack (sp pointing) Next ;----------------------------------- ; All specific code for a chip ; Must be put in a separate file ; see lpc8xx.s as an example ; INCLUDE yourfavoritechip.s INCLUDE lpc8xx.s ; INCLUDE QemuM0.s ;-(Plus1)---------------------------( n -- n+1 ) LPlus1 LINK LKey ; Link DCB 2, "1+" Plus1 DCD xPlus1 xPlus1 ADDS TOS, TOS, #1 ; Add 1 to TOS Next ;-(Minus1)--------------------------( n -- n-1 ) LMinus1 LINK LPlus1 ; Link DCB 2, "1-" Minus1 DCD xMinus1 xMinus1 SUBS TOS, TOS, #1 ; Substract 1 to TOS Next ;-(2DUP)----------------------------(x2,x1 -- x2,x1,x2,x1) L2Dup LINK LMinus1 ; Link DCB 4, "2DUP" TDup DCD x2Dup x2Dup PUSH {TOS} ; push x1 LDR WRK, [sp, #4] ; get x2 PUSH {WRK} ; push x2 Next ; First is still in TOS ;-(OR)------------------------------( x1 x2 -- x3 ) LOr LINK L2Dup ; Link DCB 2,"OR" Or DCD xOr xOr POP {WRK} ; Get second parameter ORRS TOS, TOS, WRK ; Or Next ;-(AND)-----------------------------( x1 x2 -- x3 ) LAnd LINK LOr ; Link DCB 3,"AND" And DCD xAnd xAnd POP {WRK} ; Get second parameter ANDS TOS, TOS, WRK ; And Next ;-(XOR)-----------------------------( x1 x2 -- x3 ) LXor LINK LAnd ; Link DCB 3, "XOR" Xor DCD xXor xXor POP {WRK} ; Get second parameter EORS TOS, TOS, WRK ; Xor Next ;-(0<)------------------------------( n -- f) LIsNeg LINK LXor ; Link DCB 2, "0<" IsNeg DCD xIsNeg xIsNeg ASRS TOS, TOS, #31 ; Extend the sign True=FFFFFFFF False=00000000 Next ;-(0=)------------------------------( n -- f ) LIsNull LINK LIsNeg ; Link DCB 2, "0=" IsNull DCD xIsNull xIsNull MOVS TOS,TOS ; test the value BEQ Isnull1 SUBS TOS, TOS ; False B IsNull2 Isnull1 SUBS TOS,TOS,#1 ; True IsNull2 Next ;-(0>)------------------------------( n -- f ) LIsPos LINK LIsNull ; Link DCB 2, "0>" IsPos DCD xIsPos xIsPos MOVS TOS,TOS LDR TOS,=0x0 ; False BMI IsPos1 BEQ IsPos1 SUBS TOS,TOS,#1 ; True IsPos1 Next LTORG ;-(EXECUTE)-------------------------( xt -- ) LExec LINK LIsPos ; Link DCB 7, "EXECUTE" Execute DCD xExec xExec MOVS WRK,TOS ; Get Code field address POP {TOS} ; Update TOS LDR WRK2,[WRK] ; Get address to be executed BX WRK2 ; And go ;-(DROP)-----------------------------(x -- ) LDrop LINK LExec ; Link DCB 4, "DROP" Drop DCD xDrop xDrop POP {TOS} ; Get previous element Next ;-(2DROP)---------------------------( x1 x2 -- ) L2Drop LINK LDrop ; Link DCB 5, "2DROP" TDrop DCD x2Drop x2Drop POP {TOS} ; Get previous element POP {TOS} ; Get previous element Next ;-(SWAP)----------------------------( x1 x2 -- x2 x1 ) LSwap LINK L2Drop ; Link DCB 4, "SWAP" Swap DCD xSwap xSwap POP {WRK} ; Get x1 PUSH {TOS} ; Put x2 MOVS TOS,WRK ; Put x1 Next ;-(OVER)----------------------------( x1 x2 -- x1 x2 x1 ) LOver LINK LSwap ; Link DCB 4, "OVER" Over DCD xOver xOver PUSH {TOS} ; Put x2 LDR TOS,[sp,#4] ; Get x1 Next ;-(ROT)-----------------------------( x1 x2 x3 -- x2 x3 x1 ) LRot LINK LOver ; Link DCB 3, "ROT" Rot DCD xRot xRot POP {WRK} ; Get x2 POP {WRK2} ; Get x1 PUSH {WRK} ; Put x2 PUSH {TOS} ; Put x3 MOV TOS,WRK2 ; Put x1 Next ;-(-ROT)-----------------------------( x1 x2 x3 -- x3 x1 x2 ) LMRot LINK LRot ; Link DCB 4, "-ROT" MRot DCD xMRot xMRot POP {WRK} ; Get x2 POP {WRK2} ; Get x1 PUSH {TOS} ; Put x3 PUSH {WRK2} ; Put x1 MOV TOS,WRK ; Put x2 Next ;-(NIP)-----------------------------( x1 x2 -- x2 ) LNip LINK LMRot ; Link DCB 3, "NIP" Nip DCD xNip xNip POP {WRK} ; Discard x1 Next ;-(TUCK)-----------------------------( x1 x2 -- x2 x1 x2 ) LTuck LINK LNip ; Link DCB 4, "TUCK" Tuck DCD xTuck xTuck POP {WRK} ; Get x1 PUSH {TOS} ; Put x2 PUSH {WRK} ; Put x1 Next ;-(+)-------------------------------( n1|u1 n2|u2 -- n3|u3 ) LPlus LINK LTuck ; Link DCB 1, "+" Plus DCD xPlus xPlus POP {WRK} ; Get n1|u1 ADDS TOS, TOS, WRK ; Add n2|u2 Next ;-(-)-------------------------------( n1|u1 n2|u2 -- n3|u3 ) LMinus LINK LPlus ; Link DCB 1, "-" Minus DCD xMinus xMinus POP {WRK} ; Get n1|u1 SUBS TOS, WRK, TOS ; Substract from TOS Next ;-(2*)------------------------------ LTwosta LINK LMinus ; Link DCB 2, "2*" TwoStar DCD xTwoStar xTwoStar LSLS TOS, TOS, #1 ; Shift right one bit Next ;-(2/)------------------------------ LTwosla LINK LTwosta ; Link DCB 2, "2/" TwoSla DCD xTwoSla xTwoSla ASRS TOS, TOS, #1 ; Shift left one bit Next ;-(4*)------------------------------ LFoursta LINK LTwosla ; Link DCB 2, "4*" Foursta DCD xFoursta xFoursta LSLS TOS, TOS, #2 ; Shift two bits Next ;-(4/)------------------------------ L4Slash LINK LFoursta ; Link DCB 2, "4/" Slash4 DCD xSlash4 xSlash4 ASRS TOS, TOS, #2 ; Shift two bits Next ;-(LSHIFT)--------------------------(x1,u --- x2) LLShift LINK L4Slash ; Link DCB 6, "LSHIFT" LShift DCD xLShift xLShift POP {WRK} ; Get x1 LSLS WRK, WRK, TOS ; Shift x1 u place to the left MOVS TOS, WRK Next ;-(RSHIFT)--------------------------(x1,u --- x2) LRShift LINK LLShift ; Link DCB 6, "RSHIFT" RShift DCD xRShift xRShift POP {WRK} ; Get x1 LSRS WRK, WRK, TOS ; Shift x1 u place to the right MOVS TOS, WRK Next ;-(@)-------------------------------( a -- x ) LAt LINK LRShift ; Link DCB 1, "@" At DCD xAt xAt LDR TOS, [TOS] ; Get the value pointed by TOS Next ;-(C@)------------------------------( a -- c ) LCAt LINK LAt ; Link DCB 2, "C@" CAt DCD xCAt xCAt LDRB TOS, [TOS] ; Get the caracter pointed by TOS Next ;-(H@)------------------------------( a -- h ) LHAt LINK LCAt ; Link DCB 2, "H@" HAt DCD xHAt xHAt LDRH TOS, [TOS] ; Get the halfword pointed by TOS Next ;-(!)-------------------------------(word,address --) LStore LINK LHAt ; Link DCB 1, "!" Store DCD xStore xStore POP {WRK} ; Get value to store STR WRK, [TOS] ; Store word where TOS point to POP {TOS} ; Update TOS Next ;-(C!)------------------------------(char,addr--) LCStore LINK LStore ; Link DCB 2, "C!" CStore DCD xCStore xCStore POP {WRK} ; Get value to store STRB WRK, [TOS] ; Store Character value where TOS point to POP {TOS} ; Update TOS Next ;-(H!)------------------------------(halfword,address --) LHStore LINK LCStore ; Link DCB 2 ; Length DCB "H!" HStore DCD xHStore xHStore POP {WRK} ; Get value to store STRH WRK, [TOS] ; Store Halfword where TOS point to POP {TOS} Next ;-(>R)------------------------------( n -- R:n) LToR LINK LHStore ; Link DCB 2+Cmponly,">R" ToR DCD xToR xToR STM RPTR!,{TOS} ; Put TOS on Nexturn stack ; & increment RPTR POP {TOS} ; update TOS Next ;-(R>)------------------------------(R:n -- n) LFromR LINK LToR ; Link DCB 2, "R>" FromR DCD xFromR xFromR PUSH {TOS} ; Make room SUBS RPTR, RPTR, #4 ; Prepare to collect LDR TOS, [RPTR] ; Collect value Next ;-(R@)------------------------------ LRAt LINK LFromR ; Link DCB 2, "R@" RAt DCD xRAt xRAt PUSH {TOS} ; Make room MOVS TOS, RPTR ; Collect pointer SUBS TOS, #4 ; Point to previous word LDR TOS,[TOS] ; Get value Next ;-(NOT)----------------------------- LNot LINK LRAt ; Link DCB 3, "NOT" Not DCD xNot xNot MVNS TOS, TOS ; move not Next ;-(branch)-------------------------- Branch & ZBranch use word address ; Headerless Bra DCD xBra xBra LDR IPTR, [IPTR] ; Get the target address Next ;-(Zbranch)------------------------- ; Headerless ZBra DCD xZBra xZBra TST TOS,TOS ; Update flags POP {TOS} ; BEQ xBra ; Take the branch if TOS = 0 ADDS IPTR, #4 ; or jump over the address Next ;-(NEGATE)--------------------------(n -- -n) LNegate LINK LNot ; Link DCB 6, "NEGATE" Neg DCD xNeg xNeg MVNS TOS, TOS ; Move NOT signed ADDS TOS, #1 ; 2's complement Next ;-(ABS)-----------------------------(n -- |n|) LAbs LINK LNegate ; Link DCB 3, "ABS" Abs DCD xAbs xAbs TST TOS, TOS ; Test TOS BPL Abs1 ; If positive do nothing MOVS WRK, #0 SUBS TOS, WRK, TOS ; TOS = 0 - TOS Abs1 Next ;-(MAX)-----------------------------(n1, n2 -- Max(n1,n2)) LMax LINK LAbs ; Link DCB 3, "MAX" Max DCD xMax xMax POP {WRK} CMP WRK, TOS BLT xMax1 MOVS TOS, WRK xMax1 Next ;-(MIN)-----------------------------(n1, n2 -- Min(n1,n2)) LMin LINK LMax ; Link DCB 3, "MIN" Min DCD xMin xMin POP {WRK} CMP WRK, TOS BGT xMin1 MOVS TOS, WRK xMin1 Next ;-(WITHIN)-------------------------- LWithin LINK LMin ; Link DCB 6, "WITHIN" Within DCD doCol DCD Over, Minus, ToR ; : Within Over - >R - R> U< ; DCD Minus, FromR, ULess ; DCD Exit ;-(=)------------------------------- LEq LINK LWithin ; Link DCB 1, "=" Eq DCD xEq xEq POP {WRK} CMP WRK,TOS LDR TOS, =0x0 ; False flag BNE xEq1 SUBS TOS, #1 ; True xEq1 Next ;-(<>)------------------------------- LNEq LINK LEq ; Link DCB 2, "<>" NEq DCD doCol DCD Eq, Not DCD Exit ;-(<)------------------------------- LLt LINK LNEq ; Link DCB 1, "<" Lt DCD xLt xLt POP {WRK} CMP WRK,TOS LDR TOS, =0x0 ; False flag BGE xLt1 SUBS TOS, #1 ; True xLt1 Next ;-(>)------------------------------- LGt LINK LLt ; Link DCB 1, ">" Gt DCD xGt xGt POP {WRK} CMP WRK,TOS LDR TOS, =0x0 ; False flag BLE xGt1 SUBS TOS, #1 ; True xGt1 Next ;-(INVERT)-------------------------- LInvert LINK LGt ; Link DCB 6, "INVERT" Invert DCD xInvert xInvert MVNS TOS, TOS Next ;-(?DUP)----------------------------(n -- n,n | 0) LDupNZ LINK LInvert ; Link DCB 4, "?DUP" DupNZ DCD xDupNZ xDupNZ TST TOS, TOS ; Test TOS BEQ DupNZ1 ; If 0 do nothing PUSH {TOS} ; Duplicate DupNZ1 Next ;-(*)------------------------------- LMul LINK LDupNZ ; Link DCB 1, "*" Mul DCD xMul xMul POP {WRK} ; Get 2nd Element MULS TOS, WRK, TOS ; Multiply Next ;-(*/)------------------------------- LMSlash LINK LMul ; Link DCB 2, "*/" MSlash DCD xMSlash xMSlash Next ;-(+!)------------------------------(n,addr --) LAddSto LINK LMSlash ; Link DCB 2, "+!" AddSto DCD xAddSto xAddSto POP {WRK} LDR WRK2, [TOS] ADDS WRK, WRK2 STR WRK, [TOS] POP {TOS} Next ;-(-!)------------------------------ LSubSto LINK LAddSto ; Link DCB 2, "-!" SubSto DCD xSubSto xSubSto POP {WRK} LDR WRK2, [TOS] SUBS WRK, WRK2 STR WRK, [TOS] POP {TOS} Next ;-(CELL)--------------------------- LCell LINK LSubSto ; Link DCB 4, "CELL" Cell DCD doCon DCD 4 ;-(SP0)--------------------------- LSP0 LINK LCell ; Link DCB 3, "SP0" Sp0 DCD xSp0 xSp0 SUBS WRK, WRK ; Cortex M0+ initial stack value @address 0 LDR WRK, [WRK] PUSH {TOS} MOV TOS, WRK Next ;-(SP@)----------------------------- LSPAt LINK LSP0 ; Link DCB 3, "SP@" SpAt DCD xSpAt xSpAt MOV WRK, sp ; Collect the value before push! PUSH {TOS} MOV TOS, WRK ; Update Next ;-(DEPTH)---------------------------: Depth SP@ SP0 - /4 ; LDepth LINK LSPAt ; Link DCB 5, "DEPTH" Depth DCD doCol DCD SpAt, Sp0, Swap DCD Minus, Slash4 ; DCD Exit ;-(STATE)--------------------------- LState LINK LDepth ; Link DCB 5, "STATE" State DCD doVar DCD AState ;-(LATEST)-------------------------- LLatest LINK LState ; Link DCB 6, "LATEST" Latest DCD doVar DCD DLatest ;-(HERE)----------------------------( - address) LHere LINK LLatest ; Link DCB 4, "HERE" Here DCD doVar DCD AHERE ;-(DHERE)----------------------------( - address) LDHere LINK LHere ; Link DCB 5, "DHERE" DHere DCD doVar DCD ADHERE ;-(CHERE)----------------------------( - address) LCHere LINK LDHere ; Link DCB 5, "CHERE" CHere DCD doVar DCD ACHERE ;-(BASE)---------------------------- LBase LINK LCHere ; Link DCB 4, "BASE" Base DCD doVar DCD VBase ;xBase PUSH {TOS} ; LDR TOS, =VBase ; Put address on TOS ; Next ;-(msec)---------------------------- Lmsec LINK LBase ; Link DCB 4, "msec" msec DCD xmsec xmsec LDR WRK, =2400 msec1 SUBS WRK, #1 ; 1 Cycle BNE msec1 ; 2 cycles (taken) 1 cycle (not taken) SUBS TOS, #1 ; 1 cycle BNE msec ; 2 cycles (taken) 1 cycle (not taken) POP {TOS} ; Update TOS Next ;-(10usec)-------------------------- Lusec LINK Lmsec ; Link DCB 6, "10usec" usec DCD xusec xusec LDR WRK, =23 usec1 SUBS WRK, #1 ; 1 Cycle BNE usec1 ; 2 cycles (taken) 1 cycle (not taken) SUBS TOS, #1 ; 1 cycle BNE xusec ; 2 cycles (taken) 1 cycle (not taken) POP {TOS} ; Update TOS Next ;-(SNAP)----------------------------; Debug helper when nothing work! LPC8xx centric ;LSnap LINK Lusec ; dump hex value of TOS ; DCB 4, "SNAP" ;xSnap PUSH {TOS} ;ESnap MOVS r0,#8 ;Snap0 PUSH {TOS} ; LSRS TOS, TOS, #28 ; CMP TOS, #0x9 ; BGT Snap1 ; ADDS TOS, #"0" ; B Snap2 ;Snap1 ADDS TOS, #("A"-0xa) ;Snap2 LDR r1,=(USART0) ;Snap3 LDR r2,[r1,#STAT] ; LSRS r2,#3 ; BCC Snap3 ; ? ready to Xmit ; STR TOS,[r1,#TXDAT] ; POP {TOS} ; LSLS TOS,#4 ; SUBS r0,#1 ; BNE Snap0 ; =0? ; POP {TOS} ; Next ;-(COUNT)---------------------------(caddr -- addr,count) LCount LINK Lusec DCB 5, "COUNT" Count DCD xCount xCount MOVS WRK, TOS ; ADDS TOS, #1 ; Point to 1st char PUSH {TOS} ; Put it on the stack LDRB TOS, [WRK] ; Get length Next ;-(FIND)----------------------------(caddr -- caddr|xt,flag ) ; flag=0 not found, =1 immediate, =-1 not immediate LFind LINK LCount DCB 4, "FIND" ; May be has to be recoded in high level ! Find DCD xFind xFind LDR WRK2, =VLatest ; Get last entry pointer field Find1 TST WRK2, WRK2 ; More words? BEQ Find4 ; No we have to leave PUSH {WRK2} ; save pointer ADDS WRK2, #4 ; WRK2 point to counted string LDRB WRK1, [WRK2] ; Get Lenght+flag from dictionnary MOVS WRK0, #0x1F ; Flag mask ANDS WRK1, WRK0 ; Discard flags LDRB WRK0, [TOS] ; Get length of searched string CMP WRK0, WRK1 ; Are they equals ? BNE Find3 ; no , we have to test next word PUSH {TOS} Find1b ADDS TOS, #1 ; point to next char in input string ADDS WRK2, #1 ; point to next char in dictionnary word LDRB WRK0, [TOS] ; Get char in input string LDRB WRK, [WRK2] ; Get char in dictionnary CMP WRK0, WRK ; Are they equal BNE Find2 ; no try another word SUBS WRK1, #1 ; we start this loop with length in WRK1. It's our char counter BNE Find1b ; We still have to compare more caracters POP {TOS} ; Yes we find it POP {WRK2} ; link fiel address of the word we have found LDRB WRK, [WRK2, #4] ; Get flag+Length byte MOVS WRK0, Immed ANDS WRK, WRK0 ; ?Immed BNE Find1c ; Immed SUBS TOS, TOS ; Not Immed SUBS TOS, #1 ; Flag=-1 not immed B Find1d Find1c MOVS TOS, #1 ; Flag= 1 immed Find1d LDRB WRK, [WRK2, #4] MOVS WRK1, #0x1f ; Flag mask ANDS WRK, WRK1 ; get length ADDS WRK2, #8 ; ADDS WRK2, WRK LSRS WRK2, #2 ; Round to a multiple LSLS WRK2, #2 ; of 2 PUSH {WRK2} ; Xt address B Find5 ; ( -- xt,1|-1) Find2 POP {TOS} ; Restore the address of counted string we are looking for Find3 POP {WRK2} ; Restore pointer of the linked chain LDR WRK2,[WRK2] ; Link to next in dictionnary B Find1 ; Try next one Find4 PUSH {TOS} ; Leave the c-address SUBS TOS, TOS ; Clear TOS (not found) Find5 Next LTORG ;-(ACCEPT)--------------------------( addr, len --- len2) LAccept LINK LFind DCB 6 DCB "ACCEPT" Accept DCD doCol DCD Zero, ToR ; Initial count=0 DCD Swap ; ( len, addr --- R:0) Accept1 DCD Key ; ( len, addr, char --- R:count) DCD Dup, Bl, Lt ; Is it a control character? ZBranch Accept3 ; No DCD Dup, Lit32, 8, Eq ; Is it a backspace? ZBranch Accept2 ; No DCD FromR, Dup, Zero DCD Eq ; Begining of line? DCD Swap, ToR ZBranch Accept1b ; No DCD Lit32,7, Emit, Drop ; Emit Bell and go to get next char Branch Accept1 Accept1b DCD Dup,Emit, Bl, Emit, Emit DCD FromR, Minus1,ToR DCD Minus1 Branch Accept1 Accept2 DCD Dup, Lit32, 13 ; Is it a Carriage Nexturn DCD Eq, Not ZBranch Accept4 ; Yes Accept3 DCD Over, Over, Swap ; ( len , addr, char, char, addr--- R:count) DCD CStore ; ( len, addr, char---R:count) DCD Emit ; ( len, addr---R:count) DCD Plus1 ; ( len, addr+1---R:count) DCD FromR,Plus1, ToR ; ( len, addr+1---R:count+1) Branch Accept1 ; go get next char Accept4 DCD TDrop, Drop, FromR ; (count) DCD Cr DCD Exit ;-(WORD)----------------------------(char --- cstring) LWord LINK LAccept DCB 4 DCB "WORD" ; May be has to be recoded in high level Word DCD xWord xWord LDR WRK, =(APAD) LDR WRK1, =(TIB) ; Get char at address MOVS WRK2, WRK1 ; save TIB LDR WRK0, =(AtoIn) LDR WRK0, [WRK0] ADDS WRK1, WRK0 ; Point current char LDR WRK0, =(AnTib) LDR WRK0, [WRK0] ADDS WRK2, WRK0 ; Point end of TIB Word1 CMP WRK1, WRK2 BEQ Word3 LDRB WRK0,[WRK1] ; Get char ADDS WRK1, #1 ; point to next char CMP WRK0, TOS ; is it the delimiter? BEQ Word1 Word2 ADDS WRK, #1 ; avance 1 byte in PAD STRB WRK0, [WRK] CMP WRK1, WRK2 BEQ Word3 LDRB WRK0,[WRK1] ; Get char ADDS WRK1, #1 ; point to next char CMP WRK0, TOS ; is it the delimiter? BNE Word2 ; Word3 MOVS WRK0, #' ' ; Put a blank STRB WRK0, [WRK, #1] ; at the end of string in pad LDR TOS, =(APAD) SUBS WRK, WRK, TOS ; Compute length STRB WRK, [TOS] ; Put length at the beginning ; of PAD LDR WRK, =(TIB) SUBS WRK1, WRK LDR WRK, =(AtoIn) STR WRK1, [WRK] Next LTORG ;-(WORDS)----------------------------() LWords LINK LWord DCB 5 DCB "WORDS" Words DCD doCol DCD Lit32 DCD VLatest ; ?????????????????????????????????????????????????????????????????? Words1 DCD Dup, ToR DCD Lit32, 4, Plus DCD Count, Lit32, 0x1f, And DCD Type, Bl, Emit DCD FromR, At, Dup ZBranch Words2 Branch Words1 Words2 DCD Drop, Cr DCD Exit ;-(TYPE)----------------------------(addr,number --) LType LINK LWords DCB 4 DCB "TYPE" Type DCD doCol Type1 DCD Dup ; (addr,number,number) ZBranch Type2 DCD Swap, Dup, CAt ; (number, addr, char) DCD Emit DCD Plus1, Swap, Minus1 ; (addr+1, number-1) Branch Type1 Type2 DCD TDrop ; () DCD Exit ;-(UM+)-----------------------------(number,number -- sum,carry) LUMPlus LINK LType DCB 3, "UM+" UMPlus DCD xUMPlus xUMPlus POP {WRK} SUBS WRK2, WRK2 ADDS WRK,WRK,TOS BCC UMPlus1 ADDS WRK2, #1 UMPlus1 MOVS TOS, WRK2 PUSH {WRK} Next ;-(D+)------------------------------(double,double -- double) LDPlus LINK LUMPlus DCB 2, "D+" DPlus DCD xDPlus xDPlus POP {WRK} ; low1 POP {WRK1} ; high2 POP {WRK2} ; low2 ADDS WRK, WRK2 ; low1 + low2 ADCS TOS, WRK1 ; high1+ high2 +carry PUSH {WRK} Next ;-(D-)------------------------------(double,double -- double) LDMinus LINK LDPlus DCB 2, "D-" DMinus DCD doCol DCD DNeg, DPlus DCD Exit ;-(DNEGATE)-------------------------(double -- -double) LDNeg LINK LDMinus DCB 7, "DNEGATE" DNeg DCD xDNeg xDNeg POP {WRK0} SUBS WRK1, WRK1 MVNS WRK0, WRK0 MVNS TOS, TOS ADDS WRK0, #1 ADCS TOS, WRK1 PUSH {WRK0} Next ;-(S>D)-----------------------------(number -- double) LStoD LINK LDNeg DCB 3 DCB "S>D" StoD DCD xStoD xStoD PUSH {TOS} ASRS TOS, #32 ; Extend sign Next ;-(U<)------------------------------(u1, u2 -- flag) LULess LINK LStoD DCB 2 DCB "U<" ULess DCD doCol DCD TDup, Xor, IsNeg ZBranch ULess1 DCD Swap, Drop, IsNeg Branch ULess2 ULess1 DCD Minus, IsNeg ULess2 DCD Exit ;-(U/MOD)---------------------------(ud, u -- ur , uq) LUmod LINK LULess DCB 6 DCB "UM/MOD" UMSMod DCD xUMSMod ; From Pygmy Forth ; divide 64 bit r1:r2 by 32 bit TOS xUMSMod POP {WRK1} ; Hi reg from ud POP {WRK2} ; low reg from ud MOVS WRK, #32 ; Loop Index USMod1 ADDS WRK2, WRK2 ADCS WRK1, WRK1 CMP WRK1, TOS BCC USMod2 ADDS WRK2, #1 SUBS WRK1, TOS USMod2 SUBS WRK, #1 BNE USMod1 PUSH {WRK1} MOV TOS, WRK2 Next ;-(LF)------------------------------; : LF 10 EMIT ; LLinF LINK LUmod DCB 2, "LF" Lf DCD doCol DCD Ten, Emit DCD Exit ;-(CR)------------------------------; : CR 13 EMIT LF ; LCr LINK LLinF DCB 2, "CR" Cr DCD doCol DCD Lit32, 0x0d, Emit, Lf DCD Exit ;-(BL)------------------------------ LBl LINK LCr DCB 2, "BL" Bl DCD xBl xBl PUSH {TOS} MOVS TOS, #' ' Next ;-(Esc)------------------------------; Escape char LEsc LINK LBl DCB 3, "ESC" Esc DCD doCol DCD Lit32, 0x1b, Emit DCD Exit ;-(SPACE)------------------------------ LSpace LINK LEsc DCB 5,"SPACE" Space DCD doCol DCD Bl, Emit DCD Exit ;-(SPACES)--------------------------;(n --) LSpaces LINK LSpace DCB 6,"SPACES" Spaces DCD doCol Spaces1 DCD DupNZ ZBranch Spaces2 DCD Space, Minus1 Branch Spaces1 Spaces2 DCD Exit ;-(DIGIT)---------------------------;(n -- char) LDigit LINK LSpaces DCB 5, "DIGIT" Digit DCD doCol ; : Digit 9 Over < 7 And + 48 + ; DCD Lit32, 9, Over, Lt DCD Lit32, 7, And, Plus DCD Lit32, '0', Plus DCD Exit ;-(FILL)----------------------------( addr,u,char -- ) LFill LINK LDigit DCB 4 DCB "FILL" Fill DCD xFill xFill POP {WRK} ; Get u POP {WRK2} ; Get addr Fill1 CMP WRK, #0 BEQ Fill2 ; Finish? STRB TOS, [WRK2] ; Put char ADDS WRK2, #1 ; addr= addr+1 SUBS WRK, #1 ; u = u-1 B Fill1 ; One more time Fill2 POP {TOS} ; Update TOS Next ;-(CODE:)---------------------------?Future?????????????? LBCode LINK LFill DCB 5+Cmponly ; CODE: CANNOT be Inline ! DCB "CODE:" BCode DCD xBCode xBCode ADDS IPTR, #1 ; to align at LSRS IPTR, IPTR, #1 ; the next halfword LSLS IPTR, IPTR, #1 ; boundary ADDS IPTR, #1 ; Because of Thumb boundary MOV PC, IPTR ; Jump to code itself Next ;-(;CODE)---------------------------?Future?????????????? LECode LINK LBCode DCB 5+Cmponly ; It MUST be inline ???? DCB ";CODE" ECode DCD xECode+1 xECode BL THere ; Where are we ? Collect address in lr THere MOV IPTR, lr ; ADDS IPTR, #5 ; To point after the RET Next ;-(TOUPPER)-------------------------(char -- upchar) LToupp LINK LECode DCB 7 DCB "TOUPPER" ToUpp DCD xToUpp xToUpp CMP TOS, #'a'-1 BLE Toupp1 CMP TOS, #'z'+1 BGE Toupp1 SUBS TOS, #'a'-'A' Toupp1 Next ;-(NOOP)----------------------------() LNoop LINK LToupp DCB 4 DCB "NOOP" Noop DCD xNoop xNoop Next ;-(UPPER)---------------------------(addr, count --) LUpper LINK LNoop DCB 5 DCB "UPPER" Upper DCD xUpper xUpper POP {WRK} ; Get addr Upper1 CMP TOS, #0 ; count=0? BEQ Upper3 ; yes LDRB WRK2, [WRK] CMP WRK2, #'a'-1 BLE Upper2 CMP WRK2, #'z'+1 BGE Upper2 SUBS WRK2, #'a'-'A' STRB WRK2, [WRK] Upper2 ADDS WRK, #1 SUBS TOS, #1 B Upper1 Upper3 POP {TOS} Next ;xUpper doCol ;Upper1 DCB DupNZ ; (addr, count, count) ; ZBranch Upper2 ; DCB Minus1, ToR ; DCB Dup, Dup, CAt ; DCB Toupp, Swap, Store ; DCB Plus1, FromR ; Branch Upper1 ;Upper2 DCB TDrop, Exit ; ( ) ;-(FALSE)---------------------------(--Fflag) LFalse LINK LUpper DCB 5, "FALSE" False DCD doCon DCD 0 ;-(TRUE)----------------------------(--Tflag) LTrue LINK LFalse DCB 4, "TRUE" True DCD doCon DCD 0xffffffff ;-(DECIMAL)-------------------------() LDecim LINK LTrue DCB 7, "DECIMAL" Dec DCD xDec xDec MOVS WRK2, #10 B SetBase ;-(BINARY)--------------------------() LBin LINK LDecim DCB 6, "BINARY" Bin DCD xBin xBin MOVS WRK2, #2 B SetBase ;-(HEX)------------------------------() LHex LINK LBin DCB 3, "HEX" Hex DCD xHex xHex MOVS WRK2, #16 SetBase LDR WRK1, =VBase STR WRK2, [WRK1] Next ;-(HLD)-----------------------------() LHld LINK LHex DCB 3, "HLD" Hld DCD doVar DCD AHLD ;-(<#)------------------------------() LStrPic LINK LHld DCB 2, "<#" StrPic DCD doCol DCD Pad , Lit32, 127, Plus DCD Hld, Store DCD Exit ;-(HOLD)----------------------------() LHold LINK LStrPic DCB 4, "HOLD" Hold DCD doCol DCD Hld, At, Minus1 DCD Dup, Hld, Store, CStore DCD Exit ;-(#)------------------------------() LNumb LINK LHold DCB 1, "#" Numb DCD doCol DCD Base, At DCD Extract DCD Hold DCD Exit ;-(#S)------------------------------() LNumStr LINK LNumb DCB 2, "#S" NumStr DCD doCol NumStr1 DCD Numb, Dup DCD IsNull ZBranch NumStr1 DCD Exit ;-(SIGN)----------------------------() LSign LINK LNumStr DCB 4, "SIGN" Sign DCD doCol DCD IsNeg ZBranch Sign1 DCD Lit32, '-', Hold Sign1 DCD Exit ;-(#>)------------------------------() LEndPic LINK LSign DCB 2, "#>" EndPic DCD doCol DCD Drop, Hld, At DCD Pad, Lit32, 127, Plus DCD Over, Minus DCD Exit ;-(STR)-----------------------------() LStr LINK LEndPic DCB 3, "STR" Str DCD doCol DCD Dup, ToR, Abs, StrPic DCD NumStr, FromR, Sign, EndPic DCD Exit ;-(DotR)----------------------------() LDotR LINK LStr DCB 2, ".R" DotR DCD doCol DCD ToR, Str, FromR DCD Over, Minus, Spaces DCD Type DCD Exit ;-(UdR)----------------------------() LUdR LINK LDotR DCB 3, "U.R" UDotR DCD doCol DCD ToR, StrPic, NumStr DCD EndPic, FromR, Over DCD Minus, Spaces, Type DCD Exit ;-(U.)------------------------------() LUDot LINK LUdR DCB 2, "U." UDot DCD doCol DCD StrPic, NumStr, EndPic DCD Space, Type DCD Exit ;-(.)------------------------------() LDot LINK LUDot DCB 1, "." Dot DCD doCol DCD Base, At, Ten DCD Xor ZBranch Dot1 DCD UDot Branch Dot2 Dot1 DCD Str, Space, Type Dot2 DCD Exit ;-(.S)------------------------------() LDotS LINK LDot DCB 2, ".S" DotS DCD doCol DCD Depth ; (depth) DCD Sp0, Lit32,8, Minus ; (depth, Sp) DCD Swap ; (Sp, depth) DCD Dup ; (Sp, depth, depth) ZBranch DotS3 ; Stack empty at the beginning DotS1 DCD DupNZ ; (Sp, depth, depth) ZBranch DotS4 ; No more in stack ; (Sp, depth) DotS2 DCD Swap, Dup, At ; (Depth,Sp,@Sp) DCD Dot, Cr ; (Depth,Sp) DCD Lit32, 4, Minus ; (Depth,Sp-4) DCD Swap, Minus1 ; (Sp-4,Depth-1) Branch DotS1 ; next item DotS3 DCD Drop DCD Lit32 DCD Mess6 ; Stack empty DCD Count, Type DotS4 DCD Drop ; () DCD Exit ;(C,)-------------------------------(char--) LCComa LINK LDotS DCB 2, "C," CComa DCD doCol ;............................... DCD Exit ;(H,)-------------------------------(halfword--) LHComa LINK LCComa DCB 2, "H," HComa DCD doCol DCD Lit32 DCD Transit DCD Dup, MRot ; DCD Hstore ; DCD Dup, At, CComa ; DCD PlusOne, At, CComa DCD Exit ;(,)--------------------------------(word--) LComa LINK LHComa DCB 1, "," Coma DCD doCol DCD Lit32 DCD Transit DCD Dup, MRot ;(TRansaddr, word, Transaddr) DCD Store ;(Transaddr) ; DCD Dup, At, HComa ; DCD TwoPlus, At, HComa DCD Exit ;(>IN)------------------------------(--address) LtoIn LINK LComa DCB 3, ">IN" toIn DCD doVar DCD AtoIn ;(PAD)-----------------------------(--address) LPad LINK LtoIn DCB 3, "PAD" Pad DCD doVar DCD APAD ;(#TIB)-----------------------------(--address) LnTib LINK LPad DCB 4, "#TIB" nTib DCD doVar DCD AnTib LTORG ;(RS0)------------------------------ Headerless RS0 DCD xRS0 xRS0 LDR RPTR, =Begin Next ;(QUIT)-----------------------------(word--) LQuit LINK LnTib DCB 4, "QUIT" Quit DCD doCol DCD Lit32 DCD Begin ; Set RPTR Return Stack Pointer to DCD RS0 ; beginning of RAM DCD False, State, Store ; Set Interpret Mode ; ........... DCD Exit LTORG ;(ABORT)----------------------------(word--) LAbort LINK LQuit DCB 5, "ABORT" ;................... DCD Exit ;(>NUMBER)--------------------------( u11 c-addr1 u12 -- u21 c-addr2 u22 ) LTNumber LINK LAbort DCB 7, ">NUMBER" TNbr DCD doCol ; DCD DotS ; (0,addr, n) Debug DCD ToR ; (0,addr R:n) DCD Dup, CAt ; (0,addr, char R:n) DCD Dup ; (0,addr, char, char R:n) DCD Lit32, '-' DCD Eq ZBranch TNumbr1 DCD Lit32, -1, MRot ; DCD DotS DCD FromR, Minus1,ToR ; (0,-1, addr, char R: n-1) DCD Drop, Plus1 DCD Dup, CAt ; (0,-1, addr+1, char R: n-1) ; DCD DotS Branch TNumbr2 TNumbr1 DCD Lit32, 1, MRot ; (0,1, addr, char R:n) TNumbr2 DCD ToR, ToR, Swap DCD FromR, FromR TNumbr3 DCD Base, At, isDigit ; (-1|1, cumul, addr, u,f R:n ) ZBranch TNumbr4 ; It's not a number DCD Rot, Base, At, Mul ; DCD Plus, Swap ; (-1|1, cumul, addr R:n ) DCD FromR, Minus1 DCD DupNZ ZBranch TNumbr5 DCD ToR, Plus1, Dup, CAt Branch TNumbr3 TNumbr4 DCD Drop, MRot, TDrop DCD FromR, False DCD Exit TNumbr5 DCD Drop, Mul, True ; DCD Exit ;(INTERPRET)------------------------(word--) Still to be cleaned LInterp LINK LTNumber DCB 9, "INTERPRET" Inter DCD doCol Interp DCD nTib, At ; Get # of char entered DCD toIn, At ; Get # of char processed DCD Eq ZBranch Intrp5 ; Still some char to process Intrp2 DCD Lit32 DCD Mess4 DCD Count, Type ; DCD Lit32, '>', Emit ; Prompt DCD Lit32 DCD TIB DCD Lit32, 50, Accept ; Refill with a new line ; DCD DotS ; Debug <<<<<<<<<<<<<<< DCD Dup, Zero, Eq ; Is it a null line? ZBranch Intrp4 ; No Intrp3 DCD Drop ; Discard length Branch Intrp2 ; and retry Intrp4 DCD Lit32, AnTib, Store ; Update #TIB DCD Zero, toIn, Store ; Point to the beginning Intrp5 DCD Bl ; space is the separator DCD Word ; Try to find a WORD DCD Dup, CAt ; Get length DCD Zero, Eq, Not ; Not a blank line? ZBranch Intrp3 ; no! get new one ; here we have a string ! DCD Dup, Count DCD Upper ; Convert to uppercase DCD Find ; try to find it in dictionary DCD Dup ; Duplicate flag from Find: 0 mean not found ZBranch Intrp8 ; Not a Word may be a number ; It's in dictionary DCD Dup DCD Lit32, 1, Eq ; Immed? ZBranch Intrp6 DCD DotS, Key, Drop ; Debug <<<<<<<<<<<<<<< DCD State, At DCD Eq ; Are we compiling? ZBranch Intrp7 ; if not execute it ; ; compile DCD Lit32, Mess7 DCD Count, Type DCD Dot, Cr DCD Key, Drop Branch Intrp10 Intrp6 DCD Drop Intrp7 DCD Execute ; Do the job and continue Branch Interp Intrp8 ; Try to convert as a number DCD Swap, Count DCD TNbr ZBranch Intrp11 Intrp10 Branch Interp Intrp11 DCD Type, Bl, Emit DCD Lit32 DCD Mess3 DCD Count, Type, Cr Branch Interp ;(CallR0)---------------------------(word--) LCallR0 LINK LInterp DCB 6 DCB "CallR0" CallR0 DCD doCol ;...............; DCD Exit ;(DIGIT?)---------------------------(char, base --u,f) LisDigit LINK LCallR0 DCB 6, "DIGIT?" isDigit DCD doCol DCD ToR ;(char) DCD Lit32, '0', Minus ;(num) DCD Dup ;(num,num) DCD Lit32, 9, Gt ;(num, flag) ZBranch isDigit1 DCD Lit32, ('A'-'9'-1) DCD Minus isDigit1 ;(num) DCD Dup, FromR, ULess DCD Exit ;(CHAR)-----------------------------( -- char) LChar LINK LisDigit DCB 4, "CHAR" Char DCD doCol DCD Bl, Word, Plus1, CAt DCD Exit ;(EXTRACT)--------------------------( n base -- n c) LExtract LINK LChar DCB 7, "EXTRACT" Extract DCD doCol DCD Zero, Swap, UMSMod, Swap, Digit DCD Exit ;(')--------------------------------( -- address) LTick LINK LExtract DCB 1, "'" Tick DCD doCol DCD Bl, Word DCD Dup, Count, Upper DCD Find, Not ZBranch Tick1 DCD Count, Type, Bl, Emit DCD Lit32 DCD Mess3 DCD Count, Type, Cr Tick1 DCD Exit ;( ( )------------------------------( -- ) LParan LINK LTick DCB 1, "(" Paran DCD doCol DCD Lit32, ')' , Word DCD Drop DCD Exit ;(M/MOD)----------------------------( d, n -- r, q) LMSMod LINK LParan DCB 5, "M/MOD" MSMod DCD doCol DCD Dup, IsNeg, Dup, ToR ZBranch UMSMod1 DCD Neg, ToR, DNeg, FromR UMSMod1 DCD ToR, Dup, IsNeg ZBranch UMSMod2 DCD RAt, Plus UMSMod2 DCD FromR, UMSMod, FromR ZBranch UMSMod3 DCD Swap, Neg, Swap UMSMod3 DCD Exit ;( /MOD )---------------------------( n, n -- r, q) LSMod LINK LMSMod DCB 4, "/MOD" SMod DCD doCol DCD Over, IsNeg, Swap, MSMod DCD Exit LTORG ;( MOD )----------------------------(n, n -- r ) LMod LINK LSMod DCB 3, "MOD" Mod DCD doCol DCD SMod, Drop DCD Exit ;( / )------------------------------( n, n -- q ) LDiv LINK LMod DCB 1, "/" Div DCD doCol DCD SMod, Swap, Drop DCD Exit ;( [ )------------------------------( ) LOBrtk LINK LDiv DCB 1, "[" OBrtk DCD doCol DCD False, State, Store ; Set to Interpret mode DCD Exit ;( ] )------------------------------( ) LCBrtk LINK LOBrtk DCB 1, "]" CBrtk DCD doCol DCD True, State, Store ; Set to Compile mode DCD Exit LTORG ;( DMP )---------------------------(addr-- ) LDump LINK LCBrtk DCB 3,"DMP" Dump DCD doCol DCD Base, At, ToR ;(addr R:oldbase) DCD Hex DCD Lit32, -4, And ; word align Dump2 DCD Dup,Lit32,9,DotR DCD Dup, At ;(addr,word R:oldbase) DCD StrPic, Numb, Numb DCD Numb, Numb DCD Numb, Numb DCD Numb, Numb, EndPic DCD Space, Type, Cr DCD Key DCD Lit32,0x1b, Eq, Not ; Esc key ? ZBranch Dump3 DCD Cell, Plus Branch Dump2 Dump3 DCD Drop DCD FromR, Base, Store DCD Exit ;( ALIGNED )---------------------------(addr -- w.addr) LAligned LINK LDump DCB 7,"ALIGNED" Aligned DCD xAligned xAligned ADDS TOS, #3 LSRS TOS, #2 LSLS TOS, #2 Next ;( ALIGN )---------------------------( -- ) LAlign LINK LAligned DCB 5,"ALIGN" Align DCD doCol DCD Here, Dup, At, Aligned DCD Store DCD Exit ;( CREATE )---------------------------( -- ) LCreate LINK LAlign DCB 6,"CREATE" Create DCD doCol DCD Align, Here, Latest DCD Comma DCD Bl, Word DCD DotS DCD Exit Mess8 DCB 9,"Creating " ;( FLASH )---------------------------( -- ) LFlash LINK LCreate DCB 5,"FLASH" Flash DCD doCol DCD Exit ;( RAM )---------------------------( -- ) LRam LINK LFlash DCB 3,"RAM" Ram DCD doCol DCD Here, At DCD CHere, Store DCD Exit ;( : )---------------------------( -- ) LColon LINK LRam DCB 1+Immed,":" Colon DCD doCol DCD Create DCD CBrtk ; Set compiler state on ; DCD DCD Exit ;( ; )---------------------------( -- ) LSemi LINK LColon DCB 1+Immed,";" Semi DCD doCol DCD Lit32, Exit DCD Comma DCD OBrtk ; Set compiler state off DCD Exit ;( , )---------------------------(w -- ) LComma LINK LSemi DCB 1+Cmponly,"," Comma DCD doCol DCD Here, At, Store DCD Cell, Here, AddSto DCD Exit ;( Hello )---------------------------(w -- ) LHello LINK LComma DCB 5+Immed,"HELLO" Hello DCD doCol DCD Lit32, Mess9 DCD Count, Type DCD Exit ;----------------------------------- ; CONSTANTS Mess1 DCB 11,"ENORA-Forth" Mess2 DCB 5, "Error" Mess3 DCB 7, "Unknown" Mess4 DCB 3, "Ok>" Mess5 DCB 11,"Not numeric" Mess6 DCB 12,"Stack empty",0x0d Mess7 DCB 9,"Compiling " Mess9 DCB 5,"Hello",0x0d DP0 DCD Begin Last DCD VLatest Avail DCD end_data ;----------------------------------- NextEntry EQU . VLatest EQU LHello ;---------End of Dictionary AREA |.data|, DATA Begin DCD 0 SPACE ReturnStackLength SPACE RAMForIAP SPACE DataStackLength __initial_sp APAD SPACE 128 TIB SPACE 128 RomBuff SPACE BuffSize DLatest DCD 0 ; Point to latest link field ;Latest DCD 0 AState DCD 0 ; True= Compile False= Interpret VBase DCD 0 AnTib DCD 0 AtoIn DCD 0 Transit DCD 0 AHLD DCD 0 AHERE DCD 0 ; RAM pointer ACHERE DCD 0 ; code pointer ADHERE DCD 0 ; data pointer end_data EQU . Length EQU end_data-Begin END