diff --git a/.Docs/Forth Words.md b/.Docs/Forth Words.md index 5039c0b2..faf23ac5 100644 --- a/.Docs/Forth Words.md +++ b/.Docs/Forth Words.md @@ -21,14 +21,14 @@ This document lists all of the **Forth Words** supported in the A2osX implementa | D+ | ( d1 d2 - sum ) | Working | Add double-precision numbers | | - | ( n1 n2 - diff ) | Working | Subtract (n1-n2) | | | | * | ( n1 n2 - prod ) | Working | Multiply | -| / | ( n1 n2 - quot ) | | Divide (n1/n2) | | | -| MOD | ( n1 n2 - rem ) | | Modulo (remainder from division) | | | -| /MOD | ( n1 n2 - rem quot ) | | Divide, giving remainder and quotient | -| */MOD | ( n1 n2 - rem quot ) | | Multiply, then divide (n1*n2/n3), with double-precision intermediate | -| */ | ( n1 n2 - quot ) | | Like */MOD, but give quotient only | -| MAX | ( n1 n2 - max ) | Working | Maximum | +| / | ( n1 n2 - quot ) | Working | Divide (n1/n2) | | | +| MOD | ( n1 n2 - rem ) | Working | Modulo (remainder from division) | | | +| /MOD | ( n1 n2 - rem quot ) | Working | Divide, giving remainder and quotient | +| */MOD | ( n1 n2 n3 - rem quot ) | | Multiply, then divide (n1*n2/n3), with double-precision intermediate | +| */ | ( n1 n2 n3 - quot ) | | Like */MOD, but give quotient only | +| MAX | ( n1 n2 - max ) | Working | Maximum | | MIN | ( n1 n2 - min ) | Working | Minimum | -| ABS | ( n - absolute ) | | Absolute value | +| ABS | ( n - absolute ) | Working | Absolute value | | DABS | ( d - absolute ) | | Absolute value of double-precision number | | MINUS | ( n - -n ) | Working | Change sign | | DMINUS | ( d - -d ) | Working | Change sign of double-precision number | @@ -88,10 +88,10 @@ This document lists all of the **Forth Words** supported in the A2osX implementa | EDITOR | ( - ) | | Set context vocabulary to Editor vocabulary | | ASSEMBLER | ( - ) | | Set context vocabulary to Assembler | | VLIST | ( - ) | | Print names in context vocabulary | +| VARIABLE | ( n - ) | Working | Create a variable with initial value n | +| CONSTANT | ( n - ) | Working | Create a constant with value n | | : | ( - ) | Working | Begin a colon definition | | ; | ( - ) | Working | End of a colon definition | -| VARIABLE | ( n - ) | Working | Create a variable with initial value n | -| CONSTANT | ( n - ) | | Create a constant with value n | | CODE | ( - ) | | Create assembly-language definition | | ;CODE | ( - ) | | Create a new defining word, with runtime code routine in high-level Forth | | DO | ( end+1 start - ) | Working | Set up loop, given index range | @@ -102,10 +102,10 @@ This document lists all of the **Forth Words** supported in the A2osX implementa | IF | ( f - ) | Working | If top of stack is true, execute true clause | | ELSE | ( - ) | Working | Beginning of the false clause | | ENDIF | ( - ) | Working | End of the IF-ELSE structure | -| BEGIN | ( - ) | | Start an indefinite loop | -| UNTIL | ( f - ) | | Loop back to BEGIN until f is true | -| REPEAT | ( - ) | | Loop back to BEGIN unconditionally | -| WHILE | ( f - ) | | Exit loop immediately if f is false | +| BEGIN | ( - ) | Working | Start an indefinite loop | +| UNTIL | ( f - ) | Working | Loop back to BEGIN until f is true | +| REPEAT | ( - ) | Working | Loop back to BEGIN unconditionally | +| WHILE | ( f - ) | Working | Exit loop immediately if f is false | | ( | ( - ) | | Begin comment, terminated by ) | | ## License diff --git a/.Floppies/A2OSX.BUILD.po b/.Floppies/A2OSX.BUILD.po index 45218476..966d05a2 100644 Binary files a/.Floppies/A2OSX.BUILD.po and b/.Floppies/A2OSX.BUILD.po differ diff --git a/BIN/CAT.S.txt b/BIN/CAT.S.txt index c066a747..a4be73ee 100644 --- a/BIN/CAT.S.txt +++ b/BIN/CAT.S.txt @@ -51,6 +51,7 @@ CS.START cld .DA CS.QUIT L.MSG.USAGE .DA MSG.USAGE L.MSG.CRLF .DA MSG.CRLF +L.MSG.INIT .DA MSG.INIT L.MSG.LINENUM .DA MSG.LINENUM L.MSG.CTRLCHAR .DA MSG.CTRLCHAR L.ASCII .DA ASCII @@ -106,6 +107,10 @@ CS.RUN >STYA ZPBufPtr stx hBuf + + >PUSHW L.MSG.INIT + >PUSHBI 0 + >SYSCALL PrintF *-------------------------------------- CS.RUN.LOOP ldy #S.PS.hStdIn lda (pPS),y @@ -305,6 +310,7 @@ MSG.USAGE .AS "Usage : CAT File1 [File2...]\r\n" .AS " -N : Number all output lines\r\n" .AS " -S : Suppress repeated empty output lines" MSG.CRLF .AZ "\r\n" +MSG.INIT .AZ "\e[?7h" Enable Line Wrap MSG.LINENUM .AZ "%5D:" MSG.CTRLCHAR .AZ "[%S]" *-------------------------------------- diff --git a/BIN/FORTH.S.CP.txt b/BIN/FORTH.S.CP.txt index 1ef54db5..ca0b2f10 100644 --- a/BIN/FORTH.S.CP.txt +++ b/BIN/FORTH.S.CP.txt @@ -1,7 +1,7 @@ NEW AUTO 3,1 *-------------------------------------- -CP.RUN bcs .1 > A2 +CP.RUN bcs .1 > A6 >LDYA J.KEYWORDS,x clc @@ -9,10 +9,6 @@ CP.RUN bcs .1 > A2 .1 jmp (J.CP-$A4,x) *-------------------------------------- -CP.VARIABLE -*-------------------------------------- -CP.CONSTANT -*-------------------------------------- CP.ACODE *-------------------------------------- CP.FCODE @@ -30,17 +26,7 @@ CP.LEAVE clc rts *-------------------------------------- -CP.IF jsr EmitPullA - jsr EmitPullA - - lda #$AA TAX - jsr EmitByte - - lda #$10 BPL - jsr EmitByte - - lda #3 skip JMP abs - jsr EmitByte +CP.IF jsr EmitTestTRUE jsr EmitPendingJMP to put jmp -> ELSE/ENDIF later @@ -51,38 +37,43 @@ CP.ELSE jsr CP.PopPtr1 get previous JMP -> ptr1 jsr EmitPendingJMP to put jmp -> ENDIF later - lda ZPCodePtr - sta (ZPPtr1) - - ldy #1 - lda ZPCodePtr+1 - sta (ZPPtr1),y update pending JMP to here + jsr CP.UpdatePtr1 clc rts *-------------------------------------- CP.ENDIF jsr CP.PopPtr1 - lda ZPCodePtr - sta (ZPPtr1) - - ldy #1 - lda ZPCodePtr+1 - sta (ZPPtr1),y + jsr CP.UpdatePtr1 clc rts *-------------------------------------- -CP.BEGIN -*-------------------------------------- -CP.UNTIL -*-------------------------------------- -CP.REPEAT -*-------------------------------------- -CP.WHILE +CP.BEGIN jsr CP.PushCodePtr + clc + rts *-------------------------------------- -CP.COMMENT +CP.UNTIL jsr EmitTestFALSE + + jsr CP.EmitJMPBack + + jsr CP.EmitPop2 + + clc + rts +*-------------------------------------- +CP.REPEAT jsr CP.EmitJMPBack + + clc + rts +*-------------------------------------- +CP.WHILE jsr EmitTestTRUE + + jsr CP.EmitJMPBack + + jsr CP.EmitPop2 + clc rts *-------------------------------------- @@ -99,6 +90,26 @@ CP.PushCodePtr ldy RP sty RP rts *-------------------------------------- +CP.EmitJMPBack lda #$4C JMP + jsr EmitByte + + ldy RP + iny + lda (pData),y + jsr EmitByte + + iny + lda (pData),y + jmp EmitByte +*-------------------------------------- +CP.EmitPop2 ldy RP + + iny + iny + sty RP + + rts +*-------------------------------------- CP.PopPtr1 ldy RP iny lda (pData),y @@ -112,6 +123,14 @@ CP.PopPtr1 ldy RP rts *-------------------------------------- +CP.UpdatePtr1 lda ZPCodePtr + sta (ZPPtr1) + + ldy #1 + lda ZPCodePtr+1 + sta (ZPPtr1),y + rts +*-------------------------------------- EmitPendingJMP lda #$4C JMP jsr EmitByte @@ -123,6 +142,26 @@ EmitPendingJMP lda #$4C JMP rts *-------------------------------------- +EmitTestTRUE ldx #$10 BPL + bra EmitTest + +EmitTestFALSE ldx #$30 BMI + +EmitTest jsr EmitPullA + jsr EmitPullA + + lda #$AA TAX + jsr EmitByte + + txa + jsr EmitByte + + lda #3 skip JMP abs + jsr EmitByte + + clc + rts +*-------------------------------------- EmitPullA lda #$B2 lda (zp) jsr EmitByte diff --git a/BIN/FORTH.S.KW.txt b/BIN/FORTH.S.KW.txt index e489f8a1..a4c34cd1 100644 --- a/BIN/FORTH.S.KW.txt +++ b/BIN/FORTH.S.KW.txt @@ -26,6 +26,8 @@ KW.Lookup >LDYA L.KEYWORDS .8 tya Keyword Len + jsr NextKW + clc rts @@ -51,11 +53,7 @@ KW.Lookup >LDYA L.KEYWORDS lda (ZPPtr2),y Get Src text char... beq .9 end of text - jsr IsSpaceOrCR - bcc .9 end of valid chars - - clc - rts + jmp IsSpaceOrCR CS=end of valid chars *-------------------------------------- KW.DUP lda pStack beq .9 @@ -152,7 +150,8 @@ KW.gR KW.Rg *-------------------------------------- KW.R - clc + lda #E.SYN + sec rts *-------------------------------------- KW.Add jsr CheckStackPop4 @@ -198,8 +197,7 @@ KW.Sub jsr CheckStackPop4 KW.Mul jsr CheckStackPop4 bcs .9 - >PULLW ZPPtr1 - >PULLW ZPPtr2 + jsr KW.GetPtr1Ptr2Sign stz ZPPtr3 stz ZPPtr3+1 @@ -225,21 +223,143 @@ KW.Mul jsr CheckStackPop4 dex bne .1 - >PUSHW ZPPtr3 + >LDYA ZPPtr3 + jsr KW.PushWSigned clc .9 rts *-------------------------------------- -KW.Div +KW.Div jsr KW.DivMoD.1 + bcs .9 + + >LDYA ZPPtr2 + jsr KW.PushWSigned + + clc + +.9 rts *-------------------------------------- -KW.Mod +KW.Mod jsr KW.DivMoD.1 + bcs .9 + + >PUSHW ZPPtr3 + +.9 rts *-------------------------------------- -KW.DivMod +KW.DivMod jsr KW.DivMoD.1 + bcs .9 + + >PUSHW ZPPtr3 + >LDYA ZPPtr2 + jsr KW.PushWSigned + + clc + +.9 rts *-------------------------------------- KW.MulDivMod *-------------------------------------- KW.MulDiv + lda #E.SYN + sec + rts +*-------------------------------------- +KW.DivMoD.1 jsr CheckStackPop4 + bcs .9 + + jsr KW.GetPtr1Ptr2Sign + + stz ZPPtr3 + stz ZPPtr3+1 + + ldx #16 + +.1 asl ZPPtr2 + rol ZPPtr2+1 + rol ZPPtr3 + rol ZPPtr3+1 + + sec + lda ZPPtr3 + sbc ZPPtr1 + pha + lda ZPPtr3+1 + sbc ZPPtr1+1 + bcs .2 + + pla + dex + bne .1 + + bra .8 + +.2 sta ZPPtr3+1 + pla + sta ZPPtr3 + inc ZPPtr2 + + dex + bne .1 + +.8 clc +.9 rts +*-------------------------------------- +KW.GetPtr1Ptr2Sign + >PULLW ZPPtr1 + sta Sign + + asl + bcc .1 + + lda ZPPtr1 clc + eor #$ff + adc #1 + sta ZPPtr1 + + lda ZPPtr1+1 + eor #$ff + adc #0 + sta ZPPtr1+1 + +.1 >PULLW ZPPtr2 + + asl + bcc .8 + + lda ZPPtr2 + clc + eor #$ff + adc #1 + sta ZPPtr2 + + lda ZPPtr2+1 + eor #$ff + adc #0 + sta ZPPtr2+1 + + lda Sign + eor #$80 + sta Sign + +.8 rts +*-------------------------------------- +KW.PushWSigned bit Sign + bpl .8 + + pha + tya + + clc + eor #$ff + adc #1 + tay + + pla + eor #$ff + adc #0 + +.8 >PUSHYA rts *-------------------------------------- KW.MAX jsr CheckStackPop4 @@ -284,10 +404,30 @@ KW.MIN jsr CheckStackPop4 .9 rts *-------------------------------------- -KW.ABS +KW.ABS ldy #1 + + lda (pStack),y HI + bpl .8 + + lda (pStack) + clc + eor #$ff + adc #1 + sta (pStack) + + lda (pStack),y + eor #$ff + adc #0 + sta (pStack),y + + + +.8 clc + rts *-------------------------------------- KW.DABS - clc + lda #E.SYN + sec rts *-------------------------------------- KW.MINUS lda (pStack) LO @@ -515,7 +655,8 @@ KW..R KW.D. *-------------------------------------- KW.D.R - clc + lda #E.SYN + sec rts *-------------------------------------- KW.CR >PUSHW L.MSG.ECHOCRLF @@ -578,8 +719,6 @@ KW.PRINT >LDYAI 256 pla >SYSCALL freemem - jmp NextChar - .9 rts *-------------------------------------- KW.DUMP @@ -589,7 +728,8 @@ KW.TYPE KW.COUNT *-------------------------------------- KW.TERMINAL - clc + lda #E.SYN + sec rts *-------------------------------------- KW.KEY >SYSCALL GetChar @@ -625,7 +765,8 @@ KW.DECIMAL *-------------------------------------- KW.HEX *-------------------------------------- -KW.OCTAL clc +KW.OCTAL lda #E.SYN + sec rts *-------------------------------------- KW.FETCHW lda (pStack) @@ -678,7 +819,8 @@ KW.ADDTOW jsr KW.FETCHW jmp KW.STOREW *-------------------------------------- KW.CMOVE - clc + lda #E.SYN + sec rts *-------------------------------------- KW.FILL >PULLA @@ -723,13 +865,72 @@ KW.VOCABULARY KW.FORTH KW.EDITOR KW.ASSEMBLER - clc + lda #E.SYN + sec rts *-------------------------------------- KW.VLIST clc rts *-------------------------------------- +KW.VARIABLE lda #SYM.T.VAR + bra KM.VC +*-------------------------------------- +KW.CONSTANT lda #SYM.T.CONST + +KM.VC sta ZPType + + lda pStack + cmp #$FE + bcs .10 + + lda #E.STACKERROR + sec + rts + +.10 >PUSHB.G hSList + >PUSHW ZPCLBufPtr + + >SYSCALL SListNewKey + bcs .9 + + >STYA ZPKeyID + + txa + jsr NextKW + + bit ZPType + bvs .1 + + >PULLW ZPAddrPtr + + bra .2 + +.1 >PULLA + sta (ZPDataPtr) + >PULLA + ldy #1 + sta (ZPDataPtr),y + + >LDYA ZPDataPtr + >STYA ZPAddrPtr + + lda ZPDataPtr + clc + adc #2 + sta ZPDataPtr + bcc .2 + + inc ZPDataPtr+1 + +.2 >PUSHB.G hSList + >PUSHW ZPKeyID + >PUSHWI ZPType + >PUSHWI 4 + >SYSCALL SListAddData + +.9 rts +*-------------------------------------- KW.BCOLON bit bCompile bmi KW.COLON.SYN @@ -740,7 +941,7 @@ KW.BCOLON bit bCompile bcs .9 >STYA ZPKeyID - + txa jsr NextKW @@ -778,62 +979,12 @@ KW.ECOLON bit bCompile clc rts *-------------------------------------- -KW.VARIABLE lda pStack - cmp #$FE - bcc .99 - - >PUSHB.G hSList - >PUSHW ZPCLBufPtr - - >SYSCALL SListNewKey - bcs .9 - - >STYA ZPKeyID - - txa - jsr NextKW - - lda #SYM.T.VAR - sta ZPType - - >LDYA ZPDataPtr - >STYA ZPAddrPtr - - >PUSHB.G hSList - >PUSHW ZPKeyID - >PUSHWI ZPType - >PUSHWI 4 - >SYSCALL SListAddData - bcs .9 - - >PULLA - sta (ZPDataPtr) - >PULLA - ldy #1 - sta (ZPDataPtr),y - - lda ZPDataPtr - clc - adc #2 - sta ZPDataPtr - bcc .9 - - inc ZPDataPtr+1 - - clc -.9 rts - -.99 lda #E.STACKERROR - sec - rts -*-------------------------------------- -KW.CONSTANT -*-------------------------------------- KW.ACODE *-------------------------------------- KW.FCODE - clc + lda #E.SYN + sec rts *-------------------------------------- KW.DO tsx @@ -978,14 +1129,10 @@ KW.UNTIL *-------------------------------------- KW.REPEAT *-------------------------------------- -KW.WHILE lda #E.FUNDEF +KW.WHILE lda #E.SYN sec rts *-------------------------------------- -KW.COMMENT - clc - rts -*-------------------------------------- MAN SAVE usr/src/bin/forth.s.kw LOAD usr/src/bin/forth.s diff --git a/BIN/FORTH.S.txt b/BIN/FORTH.S.txt index 9177cae5..79ae7cd0 100644 --- a/BIN/FORTH.S.txt +++ b/BIN/FORTH.S.txt @@ -49,6 +49,7 @@ CL.MaxCnt .BS 1 ArgIndex .EQ * bCompile .BS 1 RP .BS 1 +Sign .BS 1 ZS.END .ED *-------------------------------------- @@ -76,9 +77,10 @@ L.MSG.GREETINGS .DA MSG.GREETINGS L.MSG.USAGE .DA MSG.USAGE L.MSG.ECHOCRLF .DA MSG.ECHOCRLF L.MSG.DEBUG .DA MSG.DEBUG -L.MSG.ERR .DA MSG.ERR +L.MSG.TRACE .DA MSG.TRACE L.MSG.PROMPT .DA MSG.PROMPT L.MSG.PROMPTCRLF .DA MSG.PROMPTCRLF +L.MSG.OK .DA MSG.OK L.FMT.Byte .DA FMT.Byte L.FMT.int16 .DA FMT.int16 J.ESC .DA CL.BS left arrow @@ -168,11 +170,11 @@ J.KEYWORDS .DA KW.DUP .DA KW.EDITOR .DA KW.ASSEMBLER .DA KW.VLIST - .DA KW.BCOLON - .DA KW.ECOLON A2 -*-------------------------------------- .DA KW.VARIABLE .DA KW.CONSTANT + .DA KW.BCOLON + .DA KW.ECOLON A6 +*-------------------------------------- .DA KW.ACODE .DA KW.FCODE .DA KW.DO @@ -187,11 +189,8 @@ J.KEYWORDS .DA KW.DUP .DA KW.UNTIL .DA KW.REPEAT .DA KW.WHILE - .DA KW.COMMENT *-------------------------------------- -J.CP .DA CP.VARIABLE - .DA CP.CONSTANT - .DA CP.ACODE +J.CP .DA CP.ACODE .DA CP.FCODE .DA CP.DO .DA CP.LOOP @@ -205,7 +204,6 @@ J.CP .DA CP.VARIABLE .DA CP.UNTIL .DA CP.REPEAT .DA CP.WHILE - .DA CP.COMMENT .DA 0 *-------------------------------------- CS.INIT clc @@ -215,7 +213,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS >PUSHW A2osX.KVER >PUSHBI 2 >SYSCALL PrintF -* >DEBUG + bcs CS.INIT.RTS jsr CS.RUN.ARGS @@ -271,7 +269,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS stz bCompile lda #127 sta RP - +*-------------------------------------- CS.RUN.LOOP >SLEEP >LDA.G bDebug @@ -279,43 +277,192 @@ CS.RUN.LOOP >SLEEP jsr PrintDebugMsg -.2 >LDA.G bTrace - bpl .3 +.2 jsr CS.FORTH.Run + bcs .7 + + >LDA.G hFile + bne CS.RUN.LOOP + + >PUSHW L.MSG.OK + >PUSHBI 0 + >SYSCALL PrintF + bcs .99 + + bra CS.RUN.LOOP - >LDYA ZPCLBuf - jsr PrintTraceMsg - -.3 jsr CS.FORTH.Run - bcc CS.RUN.LOOP - - cmp #MLI.E.EOF +.7 cmp #MLI.E.EOF beq .8 cmp #3 beq .99 pha - >LDA.G bExitOnEOF - bmi .9 + >LDA.G hFile + beq .71 + + >LDA.G bTrace + bmi .70 + + jsr PrintTraceMsg + +.70 pla + pha + jsr PrintErrPtr + bra .9 + +.71 pla - pla >PUSHA >PUSHW ZPCLBuf >SYSCALL GetErrorMessage >LDYA ZPCLBuf >SYSCALL PutS - bra CS.RUN.LOOP + bcc CS.RUN.LOOP -* jsr PrintErrMsg + pha .9 pla -.99 sec - rts + sec +.99 rts .8 lda #0 Exit Code = Success sec rts *-------------------------------------- +CS.FORTH.Run jsr CL.Reset + + >LDA.G hFile + bne CS.FORTH.Run.File + + lda #80 + sta CL.MaxCnt + + jsr PrintPrompt + bcs .9 + +.1 >SYSCALL GetChar + bcs .9 I/O error + +.2 cmp #3 Ctrl-C + beq .9 CS + + jsr CL.CHARIN + + bit CL.bReady Something to execute ? + bpl .1 + + >PUSHW L.MSG.PROMPTCRLF + >PUSHBI 0 + >SYSCALL PrintF + + jmp CS.RUN.EXEC + +.9 rts +*-------------------------------------- +CS.FORTH.Run.File + >INCW.G LineCounter + + >PUSHWI 256 + >PUSHW ZPCLBuf + + >LDA.G hFile + >SYSCALL fgets + bcs .9 + + >LDA.G bTrace + bpl .1 + + jsr PrintTraceMsg + +.1 lda (ZPCLBuf) + beq .8 + + cmp #'\' + beq .8 + + cmp #'#' + bne .2 + + ldy #1 + lda (ZPCLBuf),y + beq .2 + + cmp #'!' + beq .8 + +.2 jmp CS.RUN.EXEC + +.8 clc +.9 rts +*-------------------------------------- +CS.RUN.EXEC lda (ZPCLBufPtr) + beq .8 EOL + + jsr IsSpaceOrCR + bcc .1 + + jsr NextChar + bra CS.RUN.EXEC + +.1 jsr KW.Lookup + bcs .2 + + jsr .7 + bcc CS.RUN.EXEC + + rts + +.2 jsr CS.RUN.GetSymbol + bcs .5 + + bit ZPType + bmi .4 CODE + + >PUSHW ZPAddrPtr CONSTANT,VARIABLE + bra CS.RUN.EXEC + +.4 bit bCompile + bmi .40 + + jsr .80 + bcc CS.RUN.EXEC + + rts + +.40 >LDYA ZPAddrPtr + jsr EmitJsrYA + bra CS.RUN.EXEC + +.5 jsr CS.RUN.GetNum + bcc CS.RUN.EXEC + + rts + +.8 clc +.9 rts + +.7 txa + asl + tax + + cpx #$A6 ; ECOLON always EXECUTE + beq .71 + + bit bCompile + bmi .72 + +.70 bcs .99 cannot exec compil only + +.71 jmp (J.KEYWORDS,x) + +.72 jmp CP.RUN + +.80 jmp (ZPAddrPtr) + +.99 lda #E.SYN + sec + rts +*-------------------------------------- CS.RUN.ARGS inc ArgIndex lda ArgIndex @@ -366,141 +513,6 @@ CS.RUN.ARGS inc ArgIndex sec QUIT Process rts *-------------------------------------- -CS.FORTH.Run jsr CL.Reset - - >LDA.G hFile - bne CS.FORTH.Run.File - - lda #80 - sta CL.MaxCnt - - jsr PrintPrompt - bcs .9 - -.1 >SYSCALL GetChar - bcs .9 I/O error - -.2 cmp #3 Ctrl-C - beq .9 CS - - jsr CL.CHARIN - - bit CL.bReady Something to execute ? - bpl .1 - - >PUSHW L.MSG.PROMPTCRLF - >PUSHBI 0 - >SYSCALL PrintF - - jmp CS.RUN.EXEC - -.9 rts -*-------------------------------------- -CS.FORTH.Run.File - >PUSHWI 256 - >PUSHW ZPCLBuf - - >LDA.G hFile - >SYSCALL fgets - bcs .9 - - lda (ZPCLBuf) - beq .8 - - cmp #'\' - beq .8 - - cmp #'#' - bne .1 - - ldy #1 - lda (ZPCLBuf),y - beq .1 - - cmp #'!' - beq .8 - -.1 jmp CS.RUN.EXEC - -.8 clc -.9 rts -*-------------------------------------- -CS.RUN.EXEC lda (ZPCLBufPtr) - beq .8 - -.1 jsr KW.Lookup - bcs .2 - - tya - jsr NextKW - - jsr .7 - bcc CS.RUN.EXEC - - rts - -.2 jsr CS.RUN.GetSymbol - bcs .5 - - bit ZPType - bmi .4 - - bvc .3 - - >PUSHW ZPAddrPtr - - rts - -.3 ldy #1 - >PUSHB (ZPAddrPtr),y - >PUSHB (ZPAddrPtr) - rts - -.4 bit bCompile - bmi .40 - - jsr .80 - bcc CS.RUN.EXEC - - rts - -.40 >LDYA ZPAddrPtr - jsr EmitJsrYA - bra CS.RUN.EXEC - -.5 jsr CS.RUN.GetNum - bcs .9 - -.6 jsr NextChar Skip SPACE if any - bne .1 - -.8 clc -.9 rts - -.7 txa - asl - tax - - cpx #$A2 ; ECOLON always EXECUTE - beq .71 - - bit bCompile - bmi .72 - -.70 bcs .99 cannot exec compil only - -.71 jmp (J.KEYWORDS,x) - -.72 jmp CP.RUN - -.80 -* >DEBUG - jmp (ZPAddrPtr) - -.99 lda #E.SYN - sec - rts -*-------------------------------------- CS.RUN.FOpen >PUSHYA >PUSHBI O.RDONLY >PUSHBI S.FI.T.TXT @@ -530,13 +542,6 @@ CS.RUN.GetSymbol >PUSHWZ From Start >SYSCALL SListGetData - bcs .9 - - - - - - .9 rts *-------------------------------------- @@ -608,51 +613,77 @@ PrintPrompt >PUSHW L.MSG.PROMPT >SYSCALL PrintF rts *-------------------------------------- -PrintErrMsg >LDYA.G ZPCLBuf - >STYA ZPPtr1 - - clc - +PrintDebugMsg >PUSHW L.MSG.DEBUG + >PUSHW ZPCodePtr + >PUSHW ZPDataPtr + >PUSHB pStack + >PUSHB RP + >PUSHBI 6 + >SYSCALL PrintF + rts *-------------------------------------- -PrintDebugMsg - clc - rts -*-------------------------------------- -PrintTraceMsg >STYA ZPPtr3 - -PrintTraceMsg.3 >PUSHBI '>' - ldy #S.PS.hStdErr - lda (pPS),y - >SYSCALL FPutC - - ldy #$ff - -.1 iny - lda (ZPPtr3),y - beq .8 - - cmp #C.CR - beq .8 - - phy - >PUSHA - ldy #S.PS.hStdErr - lda (pPS),y - >SYSCALL FPutC - ply - bra .1 - -.8 ldy #S.PS.hStdErr +PrintTraceMsg ldy #S.PS.hStdErr lda (pPS),y >PUSHA - >PUSHW L.MSG.ECHOCRLF - >PUSHBI 0 + >PUSHW L.MSG.TRACE + + >PUSHW.G LineCounter + >PUSHW ZPCLBuf + >PUSHBI 4 >SYSCALL FPrintF rts *-------------------------------------- +PrintErrPtr lda ZPCLBufPtr + sec + sbc ZPCLBuf + + tax + + ldy #0 + lda #C.SPACE + +.1 sta (ZPCLBuf),y + iny + cpy #7 + bne .1 + + txa + beq .3 + + lda #'-' + +.2 sta (ZPCLBuf),y + iny + dex + bne .2 + +.3 lda #'^' + sta (ZPCLBuf),y + iny + + lda #C.CR + sta (ZPCLBuf),y + iny + + lda #C.LF + sta (ZPCLBuf),y + iny + + txa + sta (ZPCLBuf),y + + ldy #S.PS.hStdErr + lda (pPS),y + >PUSHA + + >PUSHW ZPCLBuf + >SYSCALL FPutS + + rts +*-------------------------------------- CheckLFAfterCR ldy #S.PS.hStdIn Check for any extra LF lda (pPS),y >SYSCALL FEOF @@ -676,22 +707,20 @@ NextKW clc inc ZPCLBufPtr+1 *-------------------------------------- NextCharNB lda (ZPCLBufPtr) - beq .8 + beq .9 jsr IsSpaceOrCR - bcs .8 + bcc .8 - inc ZPCLBufPtr - bne NextCharNB - inc ZPCLBufPtr+1 + jsr NextChar bra NextCharNB .8 rts -*-------------------------------------- -NextChar lda (ZPCLBufPtr) - beq .8 - inc ZPCLBufPtr +.9 sec + rts +*-------------------------------------- +NextChar inc ZPCLBufPtr bne .8 inc ZPCLBufPtr+1 @@ -709,17 +738,15 @@ ToUpperCase cmp #'a' .8 clc exit CC to allow Jmp to rts *-------------------------------------- -IsSpaceOrCR cmp #C.SPACE - beq IsEndKW.8 +IsSpaceOrCR cmp #C.SPACE CS=TRUE + beq .8 cmp #C.CR - beq IsEndKW.8 + beq .8 - sec - rts - -IsEndKW.8 clc - rts + clc + +.8 rts *-------------------------------------- CheckStackPop4 lda pStack sec @@ -739,15 +766,16 @@ CheckStackPop4 lda pStack *-------------------------------------- CS.END *-------------------------------------- -MSG.GREETINGS .AZ "\r\nA2osX-FORTH %d.%d (figForth)\r\n\r\n" +MSG.GREETINGS .AZ "\r\nA2osX-FORTH %d.%d (figFORTH)\r\n" MSG.USAGE .AS "Usage : FORTH