mirror of
https://github.com/A2osX/A2osX.git
synced 2024-09-10 07:54:37 +00:00
983 lines
21 KiB
Plaintext
983 lines
21 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
.LIST OFF
|
||
.OP 65C02
|
||
.OR $2000
|
||
.TF bin/forth
|
||
*--------------------------------------
|
||
.INB inc/macros.i
|
||
.INB inc/a2osx.i
|
||
.INB inc/mli.i
|
||
.INB inc/mli.e.i
|
||
.INB inc/gfx.i
|
||
*--------------------------------------
|
||
CODE.SIZE .EQ 2048
|
||
DATA.SIZE .EQ 2048
|
||
INPUT.SIZE .EQ 256
|
||
OUTPUT.SIZE .EQ 256
|
||
CL.SIZE .EQ 256
|
||
*--------------------------------------
|
||
SYM.T.CONST .EQ 0
|
||
SYM.T.VAR .EQ 64
|
||
SYM.T.CODE .EQ 128
|
||
*--------------------------------------
|
||
.DUMMY
|
||
.OR ZPBIN
|
||
ZS.START
|
||
ZPCodePtr .BS 2
|
||
ZPDataPtr .BS 2
|
||
ZPInputBufPtr .BS 2
|
||
ZPOutputBufPtr .BS 2
|
||
|
||
ZPKeyID .BS 2
|
||
ZPType .BS 1
|
||
.BS 1
|
||
ZPAddrPtr .BS 2
|
||
|
||
ZPPtr1 .BS 2
|
||
ZPPtr2 .BS 2
|
||
ZPPtr3 .BS 2
|
||
|
||
ZPCLBuf .BS 2
|
||
ZPCLBufPtr .BS 2
|
||
|
||
CL.Ptr .BS 1
|
||
CL.Len .BS 1
|
||
CL.bReady .BS 1
|
||
CL.bEscMode .BS 1
|
||
CL.MaxCnt .BS 1
|
||
|
||
ArgIndex .EQ *
|
||
bCompile .BS 1
|
||
RP .BS 1
|
||
Sign .BS 1
|
||
|
||
ZS.END .ED
|
||
*--------------------------------------
|
||
* File Header (16 Bytes)
|
||
*--------------------------------------
|
||
CS.START cld
|
||
jmp (.1,x)
|
||
.DA #$61 6502,Level 1 (65c02)
|
||
.DA #1 BIN Layout Version 1
|
||
.DA #0 S.PS.F.EVENT
|
||
.DA #0
|
||
.DA CS.END-CS.START Code Size (without Constants)
|
||
.DA DS.END-DS.START Data SegmentSize
|
||
.DA #256 Stack Size
|
||
.DA #ZS.END-ZS.START Zero Page Size
|
||
.DA 0
|
||
*--------------------------------------
|
||
* Relocation Table
|
||
*--------------------------------------
|
||
.1 .DA CS.INIT
|
||
.DA CS.RUN
|
||
.DA CS.DOEVENT
|
||
.DA CS.QUIT
|
||
L.DEV.GFX .DA DEV.GFX
|
||
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.TRACE .DA MSG.TRACE
|
||
L.MSG.PROMPT .DA MSG.PROMPT
|
||
L.MSG.PROMPTCRLF .DA MSG.PROMPTCRLF
|
||
L.MSG.OK .DA MSG.OK
|
||
L.MSG.DUMP2 .DA MSG.DUMP2
|
||
L.MSG.TYPES .DA MSG.CONST
|
||
.DA MSG.VAR
|
||
.DA MSG.CODE
|
||
L.FMT.Byte .DA FMT.Byte
|
||
L.FMT.int16 .DA FMT.int16
|
||
J.ESC .DA CL.BS left arrow
|
||
.DA CL.DN
|
||
.DA CL.UP
|
||
* .DA HIS.GetNext
|
||
* .DA HIS.GetPrev
|
||
.DA CL.NAK right arrow
|
||
L.KEYWORDS .DA KEYWORDS
|
||
J.KEYWORDS .DA GFX.PLOT
|
||
.DA GFX.RECT
|
||
.DA KW.DUP
|
||
.DA KW.DROP
|
||
.DA KW.SWAP
|
||
J.KEYWORDS.OVER .DA KW.OVER
|
||
.DA KW.ROT
|
||
.DA KW.mDUP
|
||
.DA KW.gR
|
||
.DA KW.Rg
|
||
.DA KW.R
|
||
J.KEYWORDS.ADD .DA KW.Add
|
||
.DA KW.DAdd
|
||
.DA KW.Sub
|
||
.DA KW.Mul
|
||
.DA KW.Div
|
||
.DA KW.Mod
|
||
.DA KW.DivMod
|
||
.DA KW.MulDivMod
|
||
.DA KW.MulDiv
|
||
.DA KW.MAX
|
||
.DA KW.MIN
|
||
.DA KW.ABS
|
||
.DA KW.DABS
|
||
.DA KW.MINUS
|
||
.DA KW.DMINUS
|
||
.DA KW.AND
|
||
.DA KW.OR
|
||
.DA KW.XOR
|
||
J.KEYWORDS.LWR .DA KW.LWR
|
||
.DA KW.GTR
|
||
.DA KW.EQ
|
||
.DA KW.NEGATIVE
|
||
.DA KW.ZERO
|
||
.DA KW..
|
||
.DA KW..R
|
||
.DA KW.D.
|
||
.DA KW.D.R
|
||
.DA KW.CR
|
||
.DA KW.SPACE
|
||
.DA KW.SPACES
|
||
.DA KW.PRINT
|
||
.DA KW.DUMP
|
||
.DA KW.TYPE
|
||
.DA KW.COUNT
|
||
.DA KW.TERMINAL
|
||
.DA KW.KEY
|
||
.DA KW.EMIT
|
||
.DA KW.EXPECT
|
||
.DA KW.WORD
|
||
.DA KW.NUMBER
|
||
.DA KW.STARTSTR
|
||
.DA KW.STRADD
|
||
.DA KW.STRDBL
|
||
.DA KW.SIGN
|
||
.DA KW.ENDSTR
|
||
.DA KW.HOLD
|
||
.DA KW.DECIMAL
|
||
.DA KW.HEX
|
||
.DA KW.OCTAL
|
||
.DA KW.FETCHW
|
||
.DA KW.STOREW
|
||
.DA KW.FETCHB
|
||
.DA KW.STOREB
|
||
.DA KW.FETCHPRINTW
|
||
.DA KW.ADDTOW
|
||
.DA KW.CMOVE
|
||
.DA KW.FILL
|
||
.DA KW.ERASE
|
||
.DA KW.BLANKS
|
||
.DA KW.HERE
|
||
.DA KW.PAD
|
||
.DA KW.ALLOT
|
||
.DA KW.nCOMPILE
|
||
.DA KW.QUOTE
|
||
.DA KW.FORGET
|
||
.DA KW.DEFINITIONS
|
||
.DA KW.VOCABULARY
|
||
.DA KW.FORTH
|
||
.DA KW.EDITOR
|
||
.DA KW.ASSEMBLER
|
||
.DA KW.VLIST
|
||
.DA KW.VARIABLE
|
||
.DA KW.CONSTANT
|
||
*--------------------------------------
|
||
.DA KW.BCOLON
|
||
KW.ECOLON.ID .EQ *-J.KEYWORDS
|
||
.DA KW.ECOLON
|
||
.DA KW.ACODE
|
||
.DA KW.FCODE
|
||
*--------------------------------------
|
||
KW.CONLY .EQ *-J.KEYWORDS
|
||
*--------------------------------------
|
||
.DA CP.DO
|
||
.DA CP.LOOP
|
||
.DA CP.pLOOP
|
||
.DA CP.I
|
||
.DA CP.LEAVE
|
||
.DA CP.IF
|
||
.DA CP.ELSE
|
||
.DA CP.ENDIF
|
||
.DA CP.BEGIN
|
||
.DA CP.UNTIL
|
||
.DA CP.REPEAT
|
||
.DA CP.WHILE
|
||
.DA 0
|
||
*--------------------------------------
|
||
CS.INIT clc
|
||
CS.INIT.RTS rts
|
||
*--------------------------------------
|
||
CS.RUN >PUSHW L.MSG.GREETINGS
|
||
>PUSHW A2osX.KVER
|
||
>PUSHBI 2
|
||
>SYSCALL PrintF
|
||
|
||
bcs CS.INIT.RTS
|
||
|
||
jsr CS.RUN.ARGS
|
||
bcs CS.INIT.RTS
|
||
|
||
>LDYAI CODE.SIZE
|
||
>SYSCALL GetMem
|
||
bcs CS.INIT.RTS
|
||
|
||
>STYA ZPCodePtr
|
||
>STYA.G CodeBuf
|
||
txa
|
||
>STA.G hCodeBuf
|
||
|
||
>LDYAI DATA.SIZE
|
||
>SYSCALL GetMem
|
||
.9 bcs CS.INIT.RTS
|
||
|
||
>STYA ZPDataPtr
|
||
>STYA.G DataBuf
|
||
txa
|
||
>STA.G hDataBuf
|
||
|
||
>LDYAI INPUT.SIZE
|
||
>SYSCALL GetMem
|
||
bcs .9
|
||
|
||
>STYA ZPInputBufPtr
|
||
txa
|
||
>STA.G hInputBuf
|
||
|
||
>LDYAI OUTPUT.SIZE
|
||
>SYSCALL GetMem
|
||
bcs .9
|
||
|
||
>STYA ZPOutputBufPtr
|
||
txa
|
||
>STA.G hOutputBuf
|
||
|
||
>LDYAI CL.SIZE
|
||
>SYSCALL GetMem
|
||
bcs .9
|
||
|
||
>STYA ZPCLBuf
|
||
txa
|
||
>STA.G hCLBuf
|
||
|
||
>SYSCALL SListNew
|
||
bcs .9
|
||
|
||
>STA.G hSList
|
||
|
||
stz bCompile
|
||
lda #127
|
||
sta RP
|
||
|
||
jsr GFX.Open
|
||
*--------------------------------------
|
||
CS.RUN.LOOP >SLEEP
|
||
|
||
>LDA.G bDebug
|
||
bpl .2
|
||
|
||
jsr PrintDebugMsg
|
||
|
||
.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
|
||
|
||
.7 cmp #MLI.E.EOF
|
||
beq .8
|
||
|
||
cmp #3
|
||
beq .99
|
||
|
||
pha
|
||
>LDA.G hFile
|
||
beq .71
|
||
|
||
>LDA.G bTrace
|
||
bmi .70
|
||
|
||
jsr PrintTraceMsg
|
||
|
||
.70 pla
|
||
pha
|
||
jsr PrintErrPtr
|
||
bra .9
|
||
|
||
.71 pla
|
||
|
||
>PUSHA
|
||
>PUSHW ZPCLBuf
|
||
>SYSCALL GetErrorMessage
|
||
>LDYA ZPCLBuf
|
||
>SYSCALL PutS
|
||
bcc CS.RUN.LOOP
|
||
|
||
pha
|
||
|
||
.9 pla
|
||
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 CP.Emit.JsrYA
|
||
bra CS.RUN.EXEC
|
||
|
||
.5 jsr CS.RUN.GetNum
|
||
bcc CS.RUN.EXEC
|
||
|
||
rts
|
||
|
||
.8 clc
|
||
.9 rts
|
||
|
||
.7 bit bCompile
|
||
bmi .71
|
||
|
||
cpx #KW.CONLY
|
||
bcc .70
|
||
|
||
lda #E.SYN
|
||
sec
|
||
rts
|
||
|
||
.70 jmp (J.KEYWORDS,x) INTERPRET
|
||
|
||
.71 jmp CP.RUN COMPILE
|
||
|
||
.80
|
||
* >DEBUG
|
||
jmp (ZPAddrPtr)
|
||
*--------------------------------------
|
||
CS.RUN.ARGS inc ArgIndex
|
||
|
||
lda ArgIndex
|
||
>SYSCALL ArgV
|
||
bcs .8
|
||
|
||
>STYA ZPPtr1
|
||
lda (ZPPtr1)
|
||
cmp #'-'
|
||
bne .4
|
||
|
||
ldy #1
|
||
lda (ZPPtr1),y
|
||
|
||
ldx #OptionVars-OptionList-1
|
||
|
||
.1 cmp OptionList,x
|
||
beq .2
|
||
|
||
dex
|
||
bpl .1
|
||
|
||
bra .90
|
||
|
||
.2 ldy OptionVars,x
|
||
lda #$ff
|
||
sta (pData),y
|
||
bra CS.RUN.ARGS
|
||
|
||
.4 >LDA.G hFile
|
||
bne .90
|
||
|
||
>LDYA ZPPtr1
|
||
jsr CS.RUN.FOpen
|
||
bcs .9
|
||
|
||
>STA.G hFile
|
||
bra CS.RUN.ARGS
|
||
|
||
.8 clc
|
||
.9 rts
|
||
|
||
.90 >PUSHW L.MSG.USAGE
|
||
>PUSHBI 0
|
||
>SYSCALL PrintF
|
||
|
||
lda #E.SYN
|
||
sec QUIT Process
|
||
rts
|
||
*--------------------------------------
|
||
CS.RUN.FOpen >PUSHYA
|
||
>PUSHBI O.RDONLY
|
||
>PUSHBI S.FI.T.TXT
|
||
>PUSHWZ Aux type
|
||
>SYSCALL FOpen
|
||
bcs .9
|
||
|
||
>STA.G hFile
|
||
|
||
.9 rts
|
||
*--------------------------------------
|
||
CS.RUN.GetSymbol
|
||
>PUSHB.G hSList
|
||
>PUSHW ZPCLBufPtr
|
||
>SYSCALL SListLookup
|
||
bcs .9
|
||
|
||
>STYA ZPKeyID
|
||
|
||
txa
|
||
jsr NextKW
|
||
|
||
>PUSHB.G hSList
|
||
>PUSHW ZPKeyID
|
||
>PUSHWI ZPType
|
||
>PUSHWI 4 4 bytes
|
||
>PUSHWZ From Start
|
||
|
||
>SYSCALL SListGetData
|
||
|
||
.9 rts
|
||
*--------------------------------------
|
||
CS.RUN.GetNum >PUSHW ZPCLBufPtr
|
||
>PUSHWI ZPCLBufPtr
|
||
>PUSHBI 10
|
||
>SYSCALL StrToL
|
||
bcs .9
|
||
|
||
bit bCompile
|
||
bmi .1
|
||
|
||
ldy #2
|
||
lda (pStack)
|
||
sta (pStack),y
|
||
|
||
inc pStack
|
||
|
||
lda (pStack)
|
||
sta (pStack),y
|
||
|
||
inc pStack
|
||
|
||
* clc
|
||
.9 rts
|
||
|
||
.1 lda #$A9 lda #imm
|
||
jsr CP.Emit.Byte
|
||
ldy #1
|
||
lda (pStack),y
|
||
jsr CP.Emit.Byte
|
||
|
||
jsr CP.Emit.PUSHA
|
||
|
||
lda #$A9 lda #imm
|
||
jsr CP.Emit.Byte
|
||
lda (pStack)
|
||
jsr CP.Emit.Byte
|
||
|
||
jsr CP.Emit.PUSHA
|
||
|
||
>RET 4
|
||
*--------------------------------------
|
||
CS.DOEVENT sec
|
||
rts
|
||
*--------------------------------------
|
||
CS.QUIT jsr GFX.Close
|
||
|
||
>LDA.G hSList
|
||
beq .1
|
||
|
||
>PUSHA
|
||
>SYSCALL SListFree
|
||
|
||
.1 >LDA.G hFile
|
||
beq .2
|
||
|
||
>SYSCALL FClose
|
||
|
||
.2 ldy #hCodeBuf
|
||
jsr .7
|
||
|
||
ldy #hDataBuf
|
||
jsr .7
|
||
|
||
ldy #hInputBuf
|
||
jsr .7
|
||
|
||
ldy #hOutputBuf
|
||
jsr .7
|
||
|
||
ldy #hCLBuf
|
||
|
||
.7 lda (pData),y
|
||
beq .8
|
||
|
||
>SYSCALL FreeMem
|
||
|
||
.8 clc
|
||
rts
|
||
*--------------------------------------
|
||
PrintPrompt >PUSHW L.MSG.PROMPT
|
||
>PUSHBI 0
|
||
>SYSCALL PrintF
|
||
rts
|
||
*--------------------------------------
|
||
PrintDebugMsg >PUSHW L.MSG.DEBUG
|
||
>PUSHW ZPCodePtr
|
||
>PUSHW ZPDataPtr
|
||
>PUSHB pStack
|
||
>PUSHB RP
|
||
>PUSHBI 6
|
||
>SYSCALL PrintF
|
||
|
||
rts
|
||
*--------------------------------------
|
||
PrintTraceMsg ldy #S.PS.hStdErr
|
||
lda (pPS),y
|
||
>PUSHA
|
||
|
||
>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
|
||
bcs .9
|
||
|
||
tay
|
||
bne .9
|
||
>SYSCALL GetChar
|
||
|
||
.9 rts
|
||
*--------------------------------------
|
||
IncPtr1 inc ZPPtr1
|
||
bne IncPtr1.8
|
||
inc ZPPtr1+1
|
||
IncPtr1.8 rts
|
||
*--------------------------------------
|
||
NextKW clc
|
||
adc ZPCLBufPtr
|
||
sta ZPCLBufPtr
|
||
bcc NextCharNB
|
||
inc ZPCLBufPtr+1
|
||
*--------------------------------------
|
||
NextCharNB lda (ZPCLBufPtr)
|
||
beq .9
|
||
|
||
jsr IsSpaceOrCR
|
||
bcc .8
|
||
|
||
jsr NextChar
|
||
bra NextCharNB
|
||
|
||
.8 rts
|
||
|
||
.9 sec
|
||
rts
|
||
*--------------------------------------
|
||
NextChar inc ZPCLBufPtr
|
||
bne .8
|
||
|
||
inc ZPCLBufPtr+1
|
||
|
||
.8 rts
|
||
*--------------------------------------
|
||
ToUpperCase cmp #'a'
|
||
bcc .8
|
||
|
||
cmp #'z'+1
|
||
bcs .8
|
||
|
||
eor #$20
|
||
|
||
.8 clc exit CC to allow Jmp to
|
||
rts
|
||
*--------------------------------------
|
||
IsSpaceOrCR cmp #C.SPACE CS=TRUE
|
||
beq .8
|
||
|
||
cmp #C.CR
|
||
beq .8
|
||
|
||
clc
|
||
|
||
.8 rts
|
||
*--------------------------------------
|
||
CheckStackPop4 lda pStack
|
||
beq .9
|
||
|
||
cmp #$FD
|
||
bcs .9
|
||
|
||
clc
|
||
rts
|
||
|
||
.9 lda #E.STACKERROR
|
||
sec
|
||
rts
|
||
*--------------------------------------
|
||
.INB usr/src/bin/forth.s.cl
|
||
.INB usr/src/bin/forth.s.cp
|
||
.INB usr/src/bin/forth.s.kw
|
||
.INB usr/src/bin/forth.s.gfx
|
||
*--------------------------------------
|
||
CS.END
|
||
*--------------------------------------
|
||
DEV.GFX .AZ "/dev/gfx"
|
||
MSG.GREETINGS .AZ "\e[?7h\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 "(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"
|
||
MSG.DUMP2 .AZ "%s %s%D "
|
||
MSG.CONST .AZ "Const V="
|
||
MSG.VAR .AZ "Var @="
|
||
MSG.CODE .AZ "Code @="
|
||
FMT.Byte .AZ "%d "
|
||
FMT.int16 .AZ "%I "
|
||
*--------------------------------------
|
||
OptionList .AS "DdTt"
|
||
OptionVars .DA #bDebug,#bDebug,#bTrace,#bTrace
|
||
*--------------------------------------
|
||
EscChars .AS 'DBAC'
|
||
EscChars.Cnt .EQ *-EscChars
|
||
EscChars.Remap .DA #C.BS,#C.VT,#C.LF,#C.FS
|
||
*--------------------------------------
|
||
KEYWORDS .AT "PLOT"
|
||
.AT "RECT"
|
||
*--------------------------------------
|
||
.AT "DUP" ( n - n n ) Duplicate top of stack.
|
||
.AT "DROP" ( n - ) Discard top of stack.
|
||
.AT "SWAP" ( n1 n2 - n2 n1 ) Reverse top two stack items.
|
||
.AT "OVER" ( n1 n2 - n1 n2 n1 ) Copy second item to top.
|
||
.AT "ROT" ( n1 n2 n3 - n2 n3 n1 ) Rotate third item to top.
|
||
.AT "-DUP" ( n - n ? ) Duplicate only if non-zero.
|
||
.AT ">R" ( n - ) Move top item to return stack.
|
||
.AT "R>" ( - n ) Retrieve item from return stack.
|
||
.AT "R" ( - n ) Copy top of return stack onto stack.
|
||
.AT "+" ( n1 n2 - sum ) Add.
|
||
.AT "D+" ( d1 d2 - sum ) Add double-precision numbers.
|
||
.AT "-" ( n1 n2 - diff ) Subtract (n1-n2).
|
||
.AT "*" ( n1 n2 - prod ) Multiply.
|
||
.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 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.
|
||
.AT "DABS" ( d - absolute ) Absolute value of double-precision number.
|
||
.AT "MINUS" ( n - -n ) Change sign.
|
||
.AT "DMINUS" ( d - -d ) Change sign of double-precision number.
|
||
.AT "AND" ( n1 n2 - and ) Logical bitwise AND.
|
||
.AT "OR" ( n1 n2 - or ) Logical bitwise OR.
|
||
.AT "XOR" ( n1 n2 - xor ) Logical bitwise exclusive OR.
|
||
.AT "<" ( n1 n2 - f ) True if n1 less than n2.
|
||
.AT ">" ( n1 n2 - f ) True if n1 greater than n2.
|
||
.AT "=" ( n1 n2 - f ) True if n1 equal to n2.
|
||
.AT "0<" ( n - f ) True if top number negative.
|
||
.AT "0=" ( n - f ) True if top number zero.
|
||
*--------------------------------------
|
||
.AT "." ( n - ) Print number.
|
||
.AT ".R" ( n u - ) Print number, right-justified in u column.
|
||
.AT "D." ( d - ) Print double-precision number.
|
||
.AT "D.R" ( d u - ) Print double-precision number in u column.
|
||
.AT "CR" ( - ) Do a carriage-return.
|
||
.AT "SPACE" ( - ) Type one space.
|
||
.AT "SPACES" ( u - ) Type u spaces.
|
||
.AT '."' ( - ) Print message (terminated by ").
|
||
.AT "DUMP" ( addr u - ) Dump u numbers starting at address.
|
||
.AT "TYPE" ( addr u - ) Type u characters starting at address.
|
||
.AT "COUNT" ( addr - addr+1 u ) Change length byte string to TYPE form.
|
||
.AT "?TERMINAL" ( - f ) True if terminal break request present.
|
||
.AT "KEY" ( - c ) Read key, put ASCII value on stack.
|
||
.AT "EMIT" ( c - ) Type ASCII character from stack.
|
||
.AT "EXPECT" ( addr u - ) Read u characters (or until carriage-return) from input device to address.
|
||
.AT "WORD" ( c - ) Read one word from input stream, delimited by c.
|
||
.AT "NUMBER" ( addr - d ) Convert string at address to double number.
|
||
.AT "<#" ( - ) Start output string.
|
||
.AT "#" ( d1 - d2 ) Convert one digit of double number and add character to output string.
|
||
.AT "#S" ( d - 0 0 ) Convert all significant digits of double number to output string.
|
||
.AT "SIGN" ( n d - d ) Insert sign of n to output string.
|
||
.AT "#>" ( d - addr u ) Terminate output string for TYPE.
|
||
.AT "HOLD" ( c - ) Insert ASCII character into output string.
|
||
.AT "DECIMAL" ( - ) Set decimal base.
|
||
.AT "HEX" ( - ) Set hexadecimal base.
|
||
.AT "OCTAL" ( - ) Set octal base.
|
||
*--------------------------------------
|
||
.AT "@" ( addr - n ) Replace word address by contents.
|
||
.AT "!" ( n addr - ) Store second word at address on top.
|
||
.AT "C@" ( addr - b ) Fetch one byte only.
|
||
.AT "C!" ( b addr - ) Store one byte only.
|
||
.AT "?" ( addr - ) Print contents of address.
|
||
.AT "+!" ( n addr - ) Add second number to contents of address.
|
||
.AT "CMOVE" ( from to u - ) Move u bytes in memory.
|
||
.AT "FILL" ( addr u b - ) Fill u bytes in memory with b beginning at address.
|
||
.AT "ERASE" ( addr u - ) Fill u bytes in memory with zeros.
|
||
.AT "BLANKS" ( addr u - ) Fill u bytes in memory with blanks.
|
||
.AT "HERE" ( - addr ) Return address above dictionary.
|
||
.AT "PAD" ( - addr ) Return address of scratch area.
|
||
.AT "ALLOT" ( u - ) Leave a gap of n bytes in the dictionary.
|
||
.AT "," ( n - ) Compile number n into the dictionary.
|
||
.AT "'" ( - addr ) Find address of next string in dictionary.
|
||
.AT "FORGET" ( - ) Delete all definitions above and including the following definition.
|
||
.AT "DEFINITIONS" ( - ) Set current vocabulary to context vocabulary.
|
||
.AT "VOCABULARY" ( - ) Create new vocabulary.
|
||
.AT "FORTH" ( - ) Set context vocabulary to Forth vocabulary.
|
||
.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 "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.
|
||
.AT "LOOP" ( - ) Increment index, terminate loop if equal to limit.
|
||
.AT "+LOOP" ( n - ) Increment index by n. Terminate loop if outside limit.
|
||
.AT "I" ( - index ) Place loop index on stack.
|
||
.AT "LEAVE" ( - ) Terminate loop at next LOOP or +LOOP.
|
||
.AT "IF" ( f - ) If top of stack is true, execute true clause.
|
||
.AT "ELSE" ( - ) Beginning of the false clause.
|
||
.AT "ENDIF" ( - ) End of the IF-ELSE structure.
|
||
.AT "BEGIN" ( - ) Start an indefinite loop.
|
||
.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.
|
||
*--------------------------------------
|
||
.DA #0
|
||
*--------------------------------------
|
||
CODE.RPDROP2 inc RP
|
||
inc RP
|
||
CODE.RPDROP2.L .EQ *-CODE.RPDROP2
|
||
*--------------------------------------
|
||
CODE.TESTTRUE >PULLA
|
||
>PULLA
|
||
tax
|
||
.1 bpl .1+5
|
||
CODE.TESTTRUE.L .EQ *-CODE.TESTTRUE
|
||
*--------------------------------------
|
||
CODE.TESTFALSE >PULLA
|
||
>PULLA
|
||
tax
|
||
.1 bmi .1+5
|
||
CODE.TESTFALSE.L .EQ *-CODE.TESTFALSE
|
||
*--------------------------------------
|
||
CODE.PULLA >PULLA
|
||
CODE.PULLA.L .EQ *-CODE.PULLA
|
||
*--------------------------------------
|
||
CODE.PUSHA >PUSHA
|
||
CODE.PUSHA.L .EQ *-CODE.PUSHA
|
||
*--------------------------------------
|
||
CODE.LOOP ldy #2
|
||
lda (pStack),y
|
||
cmp (pStack)
|
||
inc pStack
|
||
|
||
lda (pStack),y
|
||
sbc (pStack)
|
||
|
||
dec pStack
|
||
|
||
.1 bcc .1+5
|
||
CODE.LOOP.L .EQ *-CODE.LOOP
|
||
*--------------------------------------
|
||
CODE.LOOPEND lda pStack POP 4 bytes
|
||
clc
|
||
adc #4
|
||
sta pStack
|
||
clc
|
||
CODE.LOOPEND.L .EQ *-CODE.LOOPEND
|
||
*--------------------------------------
|
||
.DUMMY
|
||
.OR 0
|
||
DS.START .BS 128 RETURN STACK
|
||
|
||
bDebug .BS 1
|
||
bTrace .BS 1
|
||
bExitOnEOF .BS 1
|
||
|
||
hCodeBuf .BS 1
|
||
CodeBuf .BS 2
|
||
|
||
hDataBuf .BS 1
|
||
DataBuf .BS 2
|
||
|
||
hInputBuf .BS 1
|
||
hOutputBuf .BS 1
|
||
|
||
hCLBuf .BS 1
|
||
hFile .BS 1
|
||
LineCounter .BS 2
|
||
hSList .BS 1
|
||
hDevGFX .BS 1
|
||
GFX.CB .BS S.CB
|
||
DS.END .ED
|
||
*--------------------------------------
|
||
MAN
|
||
SAVE usr/src/bin/forth.s
|
||
ASM
|