Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Kernel 0.94

This commit is contained in:
Rémy GIBERT 2020-11-29 14:16:39 +01:00
parent 006fe249a8
commit f4c0aaa878
9 changed files with 591 additions and 368 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
.Docs/Forth Words.md
View File

@ -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

BIN
.Floppies/A2OSX.BUILD.po
View File

Binary file not shown.

6
BIN/CAT.S.txt
View File

@ -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]"
*--------------------------------------

111
BIN/FORTH.S.CP.txt
View File

@ -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

305
BIN/FORTH.S.KW.txt
View File

@ -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

491
BIN/FORTH.S.txt
View File

@ -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 <option> file\r\n"
.AS " -D : Debug Mode\r\n"
.AS " -T : Trace On"
MSG.ECHOCRLF .AZ "\r\n"
MSG.DEBUG .AZ "pStack=%H"
MSG.ERR .AZ "^\r\nLine #%D:"
MSG.PROMPT .AZ "\e[?7hOK\r\n> " Enable Line Wrap
MSG.DEBUG .AZ "(CODE:%H, DATA=%H, SP=%h, RP=%h)\r\n"
MSG.TRACE .AZ "[%5D]%s\r\n"
MSG.PROMPT .AZ "\e[?7h\r\n> " Enable Line Wrap
MSG.PROMPTCRLF .AZ "\e[?7l\r\n" Disable Line Wrap
MSG.OK .AZ "OK\r\n"
FMT.Byte .AZ "%d "
FMT.int16 .AZ "%I "
*--------------------------------------
@ -774,8 +802,8 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
.AT "/" ( n1 n2 - quot ) Divide (n1/n2).
.AT "MOD" ( n1 n2 - rem ) Modulo (remainder from division).
.AT "/MOD" ( n1 n2 - rem quot ) Divide, giving remainder and quotient.
.AT "*/MOD" ( n1 n2 - rem quot ) Multiply, then divide (n1*n2/n3), with double-precision intermediate.
.AT "*/" ( n1 n2 - quot ) Like */MOD, but give quotient only.
.AT "*/MOD" ( n1 n2 n3 - rem quot ) Multiply, then divide (n1*n2/n3), with double-precision intermediate.
.AT "*/" ( n1 n2 n3 - quot ) Like */MOD, but give quotient only.
.AT "MAX" ( n1 n2 - max ) Maximum.
.AT "MIN" ( n1 n2 - min ) Minimum.
.AT "ABS" ( n - absolute ) Absolute value.
@ -840,11 +868,11 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
.AT "EDITOR" ( - ) Set context vocabulary to Editor vocabulary.
.AT "ASSEMBLER" ( - ) Set context vocabulary to Assembler.
.AT "VLIST" ( - ) Print names in context vocabulary.
.AT "VARIABLE" ( n - ) Create a variable with initial value n.
.AT "CONSTANT" ( n - ) Create a constant with value n.
*--------------------------------------
.AT ":" ( - ) Begin a colon definition.
.AT ";" ( - ) End of a colon definition.
.AT "VARIABLE" ( n - ) Create a variable with initial value n.
.AT "CONSTANT" ( n - ) Create a constant with value n.
.AT "CODE" ( - ) Create assembly-language definition.
.AT ";CODE" ( - ) Create a new defining word, with runtime code routine in high-level Forth.
.AT "DO" ( end+1 start - ) Set up loop, given index range.
@ -859,8 +887,6 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
.AT "UNTIL" ( f - ) Loop back to BEGIN until f is true.
.AT "REPEAT" ( - ) Loop back to BEGIN unconditionally.
.AT "WHILE" ( f - ) Exit loop immediately if f is false.
*--------------------------------------
.AT "(" ( - ) Begin comment, terminated by ).
*--------------------------------------
.DA #0
*--------------------------------------
@ -886,6 +912,7 @@ OutputBuf .BS 2
hCLBuf .BS 1
hFile .BS 1
LineCounter .BS 2
hSList .BS 1
DS.END .ED

14
EXAMPLES/MANDELBROT.F.txt
View File

@ -1,12 +1,12 @@
NEW
AUTO 3,1
#!/bin/forth
#!/bin/forth
\ Setup constants to remove magic numbers to allow
\ for greater zoom with different scale factors.
20 CONSTANT MAXITER
20 CONSTANT MAXITER
-39 CONSTANT MINVAL
40 CONSTANT MAXVAL
20 5 lshift CONSTANT RESCALE
40 CONSTANT MAXVAL
20 32 * CONSTANT RESCALE
RESCALE 4 * CONSTANT S_ESCAPE
\ These variables hold values during the escape calculation.
@ -37,8 +37,8 @@ RESCALE 4 * CONSTANT S_ESCAPE
\ stores the row column values from the stack for the escape calculation.
: INIT_VARS
5 lshift DUP CREAL ! ZREAL !
5 lshift DUP CIMAG ! ZIMAG !
32 * DUP CREAL ! ZREAL !
32 * DUP CIMAG ! ZIMAG !
1 COUNT ! ;
\ Performs a single iteration of the escape calculation.
@ -49,7 +49,7 @@ RESCALE 4 * CONSTANT S_ESCAPE
TRUE
ELSE
- CREAL @ + \ leave result on stack
ZREAL @ ZIMAG @ RESCALE */ 1 lshift
ZREAL @ ZIMAG @ RESCALE */ 2 *
CIMAG @ + ZIMAG !
ZREAL ! \ Store stack item into ZREAL
COUNT_AND_TEST?

2
SYS/KERNEL.S.ERRORX.txt
View File

@ -85,6 +85,7 @@ ERRORX.Codes .DA #MLI.E.BADCALL
.DA #E.ENVF
.DA #E.IBIN
.DA #E.FTB
.DA #E.INUM
.DA #3 Ctrl-C
*--------------------------------------PARSER
.DA #E.CSYN
@ -130,6 +131,7 @@ ERRORX.Messages .AT "Bad MLI Call"
.AT "Env Is Full"
.AT "Invalid BIN"
.AT "File Too Big"
.AT "Invalid Numerical"
.AT "User Interrupt"
*--------------------------------------
.AT "Cmd Syntax Error"

4
SYS/KERNEL.S.PWDX.txt
View File

@ -338,8 +338,10 @@ PWDX.OpenSession
ldy #31
sec
.5 jsr SHARED.FORPNT.getY
cmp (ZPPtr4),y Check MD5
eor (ZPPtr4),y Check MD5
bne .9
dey