mirror of
https://github.com/A2osX/A2osX.git
synced 2024-09-10 07:54:37 +00:00
841 lines
19 KiB
Plaintext
841 lines
19 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
|
|||
|
*--------------------------------------
|
|||
|
USERSPACE.SIZE .EQ 4096
|
|||
|
SCRATCH.SIZE .EQ 256
|
|||
|
*--------------------------------------
|
|||
|
.DUMMY
|
|||
|
.OR ZPBIN
|
|||
|
ZS.START
|
|||
|
ZPCLBuf .BS 2
|
|||
|
ZPCLBufPtr .BS 2
|
|||
|
ZPFileBuf .BS 2
|
|||
|
ZPFileBufPtr .BS 2
|
|||
|
|
|||
|
ZPPadBuf .BS 2
|
|||
|
ZPKeyID .BS 2
|
|||
|
|
|||
|
ZPUsrBufPtr .BS 2
|
|||
|
ZPUsrCodePtr .BS 2
|
|||
|
|
|||
|
ZPAddrPtr .BS 2
|
|||
|
ZPCodePtr .BS 2
|
|||
|
|
|||
|
ZPPtr1 .BS 2
|
|||
|
ZPPtr2 .BS 2
|
|||
|
|
|||
|
ZPPtr3 .BS 2
|
|||
|
|
|||
|
CL.Ptr .BS 1
|
|||
|
CL.Len .BS 1
|
|||
|
CL.bReady .BS 1
|
|||
|
CL.bEscMode .BS 1
|
|||
|
CL.MaxCnt .BS 1
|
|||
|
|
|||
|
bCompile .EQ *
|
|||
|
ArgIndex .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.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.PROMPT .DA MSG.PROMPT
|
|||
|
L.MSG.PROMPTCRLF .DA MSG.PROMPTCRLF
|
|||
|
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.PUSHADDR .DA PUSHADDR
|
|||
|
L.KEYWORDS .DA KEYWORDS
|
|||
|
J.KEYWORDS .DA KW.DUP
|
|||
|
.DA KW.DROP
|
|||
|
.DA KW.SWAP
|
|||
|
.DA KW.OVER
|
|||
|
.DA KW.ROT
|
|||
|
.DA KW.mDUP
|
|||
|
.DA KW.gR
|
|||
|
.DA KW.Rg
|
|||
|
.DA KW.R
|
|||
|
.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
|
|||
|
.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.BCOLON
|
|||
|
.DA KW.ECOLON
|
|||
|
.DA KW.VARIABLE
|
|||
|
.DA KW.CONSTANT
|
|||
|
.DA KW.ACODE
|
|||
|
.DA KW.FCODE
|
|||
|
.DA KW.DO
|
|||
|
.DA KW.LOOP
|
|||
|
.DA PW.pLOOP
|
|||
|
.DA KW.I
|
|||
|
.DA KW.LEAVE
|
|||
|
.DA KW.IF
|
|||
|
.DA KW.ELSE
|
|||
|
.DA KW.ENDIF
|
|||
|
.DA KW.BEGIN
|
|||
|
.DA KW.UNTIL
|
|||
|
.DA KW.REPEAT
|
|||
|
.DA KW.WHILE
|
|||
|
.DA KW.COMMENT
|
|||
|
.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 256
|
|||
|
>SYSCALL GetMem
|
|||
|
bcs CS.INIT.RTS
|
|||
|
|
|||
|
>STYA ZPCLBuf
|
|||
|
txa
|
|||
|
>STA.G hCLBuf
|
|||
|
|
|||
|
>LDYAI 256
|
|||
|
>SYSCALL GetMem
|
|||
|
bcs CS.INIT.RTS
|
|||
|
|
|||
|
>STYA ZPPadBuf
|
|||
|
txa
|
|||
|
>STA.G hPadBuf
|
|||
|
|
|||
|
>LDYAI USERSPACE.SIZE
|
|||
|
>SYSCALL GetMem
|
|||
|
bcs CS.INIT.RTS
|
|||
|
|
|||
|
>STYA ZPUsrBufPtr
|
|||
|
>STYA.G UsrBuf
|
|||
|
txa
|
|||
|
>STA.G hUsrBuf
|
|||
|
|
|||
|
>SYSCALL SListNew
|
|||
|
bcs CS.INIT.RTS
|
|||
|
|
|||
|
>STA.G hSList
|
|||
|
|
|||
|
stz bCompile
|
|||
|
|
|||
|
.1 >SLEEP
|
|||
|
|
|||
|
>LDA.G bDebug
|
|||
|
bpl .2
|
|||
|
|
|||
|
jsr PrintDebugMsg
|
|||
|
|
|||
|
.2 >LDA.G bTrace
|
|||
|
bpl .3
|
|||
|
|
|||
|
>LDYA ZPFileBufPtr
|
|||
|
jsr PrintTraceMsg
|
|||
|
|
|||
|
.3 jsr CS.FORTH.Run
|
|||
|
bcc .1
|
|||
|
|
|||
|
cmp #MLI.E.EOF
|
|||
|
beq .8
|
|||
|
|
|||
|
cmp #3
|
|||
|
beq .99
|
|||
|
|
|||
|
pha
|
|||
|
>LDA.G bExitOnEOF
|
|||
|
bmi .9
|
|||
|
|
|||
|
pla
|
|||
|
>PUSHA
|
|||
|
>PUSHW ZPCLBuf
|
|||
|
>SYSCALL GetErrorMessage
|
|||
|
>LDYA ZPCLBuf
|
|||
|
>SYSCALL PutS
|
|||
|
bra .1
|
|||
|
|
|||
|
* jsr PrintErrMsg
|
|||
|
|
|||
|
.9 pla
|
|||
|
.99 sec
|
|||
|
rts
|
|||
|
|
|||
|
.8 lda #0 Exit Code = Success
|
|||
|
sec
|
|||
|
rts
|
|||
|
*--------------------------------------
|
|||
|
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 hFileBuf
|
|||
|
bne .90
|
|||
|
|
|||
|
>LDYA ZPPtr1
|
|||
|
jsr CS.RUN.LoadFile
|
|||
|
bcs .9
|
|||
|
|
|||
|
>STA.G hFileBuf
|
|||
|
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.FORTH.Run >LDA.G hFileBuf
|
|||
|
bne CS.FORTH.Run.File
|
|||
|
|
|||
|
jsr CL.Reset
|
|||
|
|
|||
|
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
|
|||
|
lda (ZPFileBufPtr)
|
|||
|
beq .8
|
|||
|
|
|||
|
ldy #$ff
|
|||
|
|
|||
|
.3 iny
|
|||
|
lda (ZPFileBufPtr),y
|
|||
|
sta (ZPCLBuf),y
|
|||
|
beq .4
|
|||
|
|
|||
|
eor #C.CR
|
|||
|
bne .3
|
|||
|
|
|||
|
sta (ZPCLBuf),y
|
|||
|
|
|||
|
iny
|
|||
|
|
|||
|
.4 tya
|
|||
|
|
|||
|
clc
|
|||
|
adc ZPFileBufPtr
|
|||
|
sta ZPFileBufPtr
|
|||
|
bcc .5
|
|||
|
|
|||
|
inc ZPFileBufPtr+1
|
|||
|
|
|||
|
.5 lda (ZPCLBuf)
|
|||
|
beq CS.FORTH.Run.File
|
|||
|
|
|||
|
cmp #'#'
|
|||
|
beq CS.FORTH.Run.File
|
|||
|
|
|||
|
>LDYA ZPCLBuf
|
|||
|
>STYA ZPCLBufPtr
|
|||
|
|
|||
|
jmp CS.RUN.EXEC
|
|||
|
|
|||
|
.8 lda #MLI.E.EOF
|
|||
|
|
|||
|
sec
|
|||
|
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 >PUSHB.G hSList
|
|||
|
>PUSHW ZPCLBufPtr
|
|||
|
>SYSCALL SListLookup
|
|||
|
bcs .5
|
|||
|
|
|||
|
>STYA ZPKeyID
|
|||
|
|
|||
|
>PUSHB.G hSList
|
|||
|
>PUSHW ZPKeyID
|
|||
|
>PUSHWI ZPAddrPtr
|
|||
|
>PUSHWI 4 4 bytes
|
|||
|
>PUSHWZ From Start
|
|||
|
|
|||
|
>SYSCALL SListGetData
|
|||
|
bcs .9
|
|||
|
|
|||
|
jmp (ZPCodePtr)
|
|||
|
|
|||
|
.8 clc
|
|||
|
.9 rts
|
|||
|
|
|||
|
.5 >PUSHW ZPCLBufPtr
|
|||
|
>PUSHWI ZPCLBufPtr
|
|||
|
>PUSHBI 10
|
|||
|
>SYSCALL StrToL
|
|||
|
bcs .9
|
|||
|
|
|||
|
ldy #2
|
|||
|
lda (pStack)
|
|||
|
sta (pStack),y
|
|||
|
|
|||
|
inc pStack
|
|||
|
|
|||
|
lda (pStack)
|
|||
|
sta (pStack),y
|
|||
|
|
|||
|
inc pStack
|
|||
|
|
|||
|
.6 jsr NextChar Skip SPACE if any
|
|||
|
beq .8
|
|||
|
|
|||
|
jmp .1
|
|||
|
|
|||
|
.7 txa
|
|||
|
asl
|
|||
|
tax
|
|||
|
|
|||
|
jmp (J.KEYWORDS,x)
|
|||
|
*--------------------------------------
|
|||
|
CS.RUN.LoadFile >PUSHYA
|
|||
|
>PUSHBI O.RDONLY
|
|||
|
>PUSHBI S.FI.T.TXT
|
|||
|
>PUSHWZ Aux type
|
|||
|
>SYSCALL LoadTxtFile
|
|||
|
bcs .9
|
|||
|
|
|||
|
phx
|
|||
|
txa
|
|||
|
>SYSCALL GetMemPtr
|
|||
|
>STYA ZPFileBuf
|
|||
|
>STYA ZPFileBufPtr
|
|||
|
pla
|
|||
|
|
|||
|
.9 rts
|
|||
|
*--------------------------------------
|
|||
|
CS.DOEVENT sec
|
|||
|
rts
|
|||
|
*--------------------------------------
|
|||
|
CS.QUIT >LDA.G hSList
|
|||
|
beq .1
|
|||
|
|
|||
|
>PUSHA
|
|||
|
>SYSCALL SListFree
|
|||
|
|
|||
|
.1 ldy #hFileBuf
|
|||
|
jsr .7
|
|||
|
|
|||
|
ldy #hUsrBuf
|
|||
|
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
|
|||
|
*--------------------------------------
|
|||
|
PrintErrMsg >LDYA ZPFileBuf
|
|||
|
>STYA ZPPtr1
|
|||
|
|
|||
|
stz ZPPtr2
|
|||
|
stz ZPPtr2+1 Line counter
|
|||
|
|
|||
|
.1 inc ZPPtr2
|
|||
|
bne .2
|
|||
|
inc ZPPtr2+1
|
|||
|
|
|||
|
.2 >LDYA ZPPtr1
|
|||
|
>STYA ZPPtr3 save line start
|
|||
|
|
|||
|
.20 lda (ZPPtr1)
|
|||
|
beq .4 EoF
|
|||
|
|
|||
|
inc ZPPtr1
|
|||
|
bne .3
|
|||
|
inc ZPPtr1+1
|
|||
|
.3 cmp #C.CR
|
|||
|
bne .20 Scan until EoL
|
|||
|
|
|||
|
ldx ZPPtr1
|
|||
|
cpx ZPFileBufPtr
|
|||
|
lda ZPPtr1+1
|
|||
|
sbc ZPFileBufPtr+1
|
|||
|
bcc .1 not this line....
|
|||
|
|
|||
|
.4 >LDA.G bTrace
|
|||
|
bmi .5
|
|||
|
|
|||
|
jsr PrintTraceMsg.3
|
|||
|
|
|||
|
.5 lda ZPPtr3
|
|||
|
cmp ZPFileBufPtr
|
|||
|
bne .6
|
|||
|
|
|||
|
lda ZPPtr3+1
|
|||
|
cmp ZPFileBufPtr+1
|
|||
|
beq .8
|
|||
|
|
|||
|
.6 >PUSHBI '-'
|
|||
|
ldy #S.PS.hStdErr
|
|||
|
lda (pPS),y
|
|||
|
>SYSCALL FPutC
|
|||
|
inc ZPPtr3
|
|||
|
bne .5
|
|||
|
inc ZPPtr3+1
|
|||
|
bra .5
|
|||
|
|
|||
|
.8 ldy #S.PS.hStdErr
|
|||
|
lda (pPS),y
|
|||
|
>PUSHA
|
|||
|
>PUSHW L.MSG.ERR
|
|||
|
>PUSHW ZPPtr2 Line counter
|
|||
|
>PUSHBI 2
|
|||
|
>SYSCALL FPrintF
|
|||
|
|
|||
|
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
|
|||
|
lda (pPS),y
|
|||
|
>PUSHA
|
|||
|
|
|||
|
>PUSHW L.MSG.ECHOCRLF
|
|||
|
>PUSHBI 0
|
|||
|
>SYSCALL FPrintF
|
|||
|
|
|||
|
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 .8
|
|||
|
|
|||
|
jsr IsSpaceOrCR
|
|||
|
bcs .8
|
|||
|
|
|||
|
inc ZPCLBufPtr
|
|||
|
bne NextCharNB
|
|||
|
inc ZPCLBufPtr+1
|
|||
|
bra NextCharNB
|
|||
|
|
|||
|
.8 rts
|
|||
|
*--------------------------------------
|
|||
|
NextChar lda (ZPCLBufPtr)
|
|||
|
beq .8
|
|||
|
|
|||
|
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
|
|||
|
beq IsEndKW.8
|
|||
|
|
|||
|
cmp #C.CR
|
|||
|
beq IsEndKW.8
|
|||
|
|
|||
|
sec
|
|||
|
rts
|
|||
|
|
|||
|
IsEndKW.8 clc
|
|||
|
rts
|
|||
|
*--------------------------------------
|
|||
|
PUSHADDR lda ZPAddrPtr+1
|
|||
|
>PUSHA
|
|||
|
lda ZPAddrPtr
|
|||
|
>PUSHA
|
|||
|
rts
|
|||
|
*--------------------------------------
|
|||
|
CheckStackPop4 lda pStack
|
|||
|
sec
|
|||
|
sbc #4
|
|||
|
bcc .9
|
|||
|
|
|||
|
clc
|
|||
|
rts
|
|||
|
|
|||
|
.9 lda #E.STACKERROR
|
|||
|
sec
|
|||
|
rts
|
|||
|
*--------------------------------------
|
|||
|
.INB usr/src/bin/forth.s.cl
|
|||
|
.INB usr/src/bin/forth.s.kw
|
|||
|
*--------------------------------------
|
|||
|
CS.END
|
|||
|
*--------------------------------------
|
|||
|
MSG.GREETINGS .AZ "\r\nA2osX-FORTH %d.%d (figForth)\r\n\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.PROMPTCRLF .AZ "\e[?7l\r\n" Disable Line Wrap
|
|||
|
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 "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 - rem quot ) Multiply, then divide (n1*n2/n3), with double-precision intermediate.
|
|||
|
.AT "*/" ( n1 n2 - 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 ":" ( - ) Begin a colon definition.
|
|||
|
.AT ";" ( - ) End of a colon definition.
|
|||
|
.AT "VARIABLE" ( n - ) Create a variable with initial value n.
|
|||
|
* ( - addr ) Return address when executed.
|
|||
|
.AT "CONSTANT" ( n - ) Create a constant with value n.
|
|||
|
* ( - n ) Return the value n when executed.
|
|||
|
.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.
|
|||
|
*--------------------------------------
|
|||
|
.AT "(" ( - ) Begin comment, terminated by ).
|
|||
|
*--------------------------------------
|
|||
|
.DA #0
|
|||
|
*--------------------------------------
|
|||
|
.DUMMY
|
|||
|
.OR 0
|
|||
|
DS.START
|
|||
|
bDebug .BS 1
|
|||
|
bTrace .BS 1
|
|||
|
bExitOnEOF .BS 1
|
|||
|
hCLBuf .BS 1
|
|||
|
hPadBuf .BS 1
|
|||
|
hUsrBuf .BS 1
|
|||
|
UsrBuf .BS 2
|
|||
|
hFileBuf .BS 1
|
|||
|
hSList .BS 1
|
|||
|
|
|||
|
DS.END .ED
|
|||
|
*--------------------------------------
|
|||
|
MAN
|
|||
|
SAVE usr/src/bin/forth.s
|
|||
|
ASM
|