A2osX/BIN/FORTH.S.txt

896 lines
19 KiB
Plaintext
Raw Normal View History

2020-11-19 15:34:02 +00:00
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
*--------------------------------------
2020-11-23 22:05:27 +00:00
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
2020-11-19 15:34:02 +00:00
*--------------------------------------
.DUMMY
.OR ZPBIN
ZS.START
2020-11-23 22:05:27 +00:00
ZPCodePtr .BS 2
ZPDataPtr .BS 2
ZPInputPtr .BS 2
ZPOutputPtr .BS 2
2020-11-19 15:34:02 +00:00
ZPKeyID .BS 2
2020-11-23 22:05:27 +00:00
ZPType .BS 1
.BS 1
2020-11-19 15:34:02 +00:00
ZPAddrPtr .BS 2
ZPPtr1 .BS 2
ZPPtr2 .BS 2
ZPPtr3 .BS 2
2020-11-23 22:05:27 +00:00
ZPCLBuf .BS 2
ZPCLBufPtr .BS 2
2020-11-19 15:34:02 +00:00
CL.Ptr .BS 1
CL.Len .BS 1
CL.bReady .BS 1
CL.bEscMode .BS 1
CL.MaxCnt .BS 1
2020-11-23 22:05:27 +00:00
ArgIndex .EQ *
bCompile .BS 1
RP .BS 1
2020-11-19 15:34:02 +00:00
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
2020-11-26 19:47:57 +00:00
* .DA HIS.GetNext
2020-11-19 15:34:02 +00:00
* .DA HIS.GetPrev
.DA CL.NAK right arrow
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
2020-11-26 19:47:57 +00:00
.DA KW.ECOLON A2
*--------------------------------------
2020-11-19 15:34:02 +00:00
.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
2020-11-26 19:47:57 +00:00
*--------------------------------------
J.CP .DA CP.VARIABLE
.DA CP.CONSTANT
.DA CP.ACODE
.DA CP.FCODE
.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 CP.COMMENT
2020-11-19 15:34:02 +00:00
.DA 0
*--------------------------------------
CS.INIT clc
CS.INIT.RTS rts
*--------------------------------------
CS.RUN >PUSHW L.MSG.GREETINGS
>PUSHW A2osX.KVER
>PUSHBI 2
>SYSCALL PrintF
2020-11-26 19:47:57 +00:00
* >DEBUG
2020-11-19 15:34:02 +00:00
bcs CS.INIT.RTS
jsr CS.RUN.ARGS
bcs CS.INIT.RTS
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
>LDYAI CODE.SIZE
2020-11-19 15:34:02 +00:00
>SYSCALL GetMem
bcs CS.INIT.RTS
2020-11-23 22:05:27 +00:00
>STYA ZPCodePtr
>STYA.G CodeBuf
2020-11-19 15:34:02 +00:00
txa
2020-11-23 22:05:27 +00:00
>STA.G hCodeBuf
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
>LDYAI DATA.SIZE
2020-11-19 15:34:02 +00:00
>SYSCALL GetMem
2020-11-23 22:05:27 +00:00
.9 bcs CS.INIT.RTS
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
>STYA ZPDataPtr
>STYA.G DataBuf
2020-11-19 15:34:02 +00:00
txa
2020-11-23 22:05:27 +00:00
>STA.G hDataBuf
>LDYAI INPUT.SIZE
2020-11-19 15:34:02 +00:00
>SYSCALL GetMem
2020-11-23 22:05:27 +00:00
bcs .9
>STYA.G InputBuf
txa
>STA.G hInputBuf
>LDYAI OUTPUT.SIZE
>SYSCALL GetMem
bcs .9
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
>STYA.G OutputBuf
2020-11-19 15:34:02 +00:00
txa
2020-11-23 22:05:27 +00:00
>STA.G hOutputBuf
>LDYAI CL.SIZE
>SYSCALL GetMem
bcs .9
>STYA ZPCLBuf
txa
>STA.G hCLBuf
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>SYSCALL SListNew
2020-11-23 22:05:27 +00:00
bcs .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>STA.G hSList
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
stz bCompile
2020-11-23 22:05:27 +00:00
lda #127
sta RP
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
CS.RUN.LOOP >SLEEP
2020-11-19 15:34:02 +00:00
>LDA.G bDebug
bpl .2
jsr PrintDebugMsg
.2 >LDA.G bTrace
bpl .3
2020-11-23 22:05:27 +00:00
>LDYA ZPCLBuf
2020-11-19 15:34:02 +00:00
jsr PrintTraceMsg
.3 jsr CS.FORTH.Run
2020-11-23 22:05:27 +00:00
bcc CS.RUN.LOOP
2020-11-19 15:34:02 +00:00
cmp #MLI.E.EOF
beq .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
cmp #3
beq .99
pha
>LDA.G bExitOnEOF
bmi .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
pla
>PUSHA
>PUSHW ZPCLBuf
>SYSCALL GetErrorMessage
>LDYA ZPCLBuf
>SYSCALL PutS
2020-11-23 22:05:27 +00:00
bra CS.RUN.LOOP
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
* jsr PrintErrMsg
.9 pla
.99 sec
rts
.8 lda #0 Exit Code = Success
sec
rts
*--------------------------------------
2020-11-26 19:47:57 +00:00
CS.RUN.ARGS inc ArgIndex
2020-11-19 15:34:02 +00:00
lda ArgIndex
>SYSCALL ArgV
bcs .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>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
2020-11-23 22:05:27 +00:00
.4 >LDA.G hFile
2020-11-19 15:34:02 +00:00
bne .90
>LDYA ZPPtr1
2020-11-23 22:05:27 +00:00
jsr CS.RUN.FOpen
2020-11-19 15:34:02 +00:00
bcs .9
2020-11-23 22:05:27 +00:00
>STA.G hFile
2020-11-19 15:34:02 +00:00
bra CS.RUN.ARGS
.8 clc
.9 rts
.90 >PUSHW L.MSG.USAGE
>PUSHBI 0
>SYSCALL PrintF
lda #E.SYN
sec QUIT Process
rts
*--------------------------------------
2020-11-23 22:05:27 +00:00
CS.FORTH.Run jsr CL.Reset
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
>LDA.G hFile
bne CS.FORTH.Run.File
2020-11-19 15:34:02 +00:00
lda #80
sta CL.MaxCnt
jsr PrintPrompt
bcs .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.1 >SYSCALL GetChar
2020-11-26 19:47:57 +00:00
bcs .9 I/O error
2020-11-19 15:34:02 +00:00
.2 cmp #3 Ctrl-C
beq .9 CS
jsr CL.CHARIN
bit CL.bReady Something to execute ?
2020-11-26 19:47:57 +00:00
bpl .1
2020-11-19 15:34:02 +00:00
>PUSHW L.MSG.PROMPTCRLF
>PUSHBI 0
>SYSCALL PrintF
jmp CS.RUN.EXEC
2020-11-26 19:47:57 +00:00
.9 rts
2020-11-23 22:05:27 +00:00
*--------------------------------------
2020-11-19 15:34:02 +00:00
CS.FORTH.Run.File
2020-11-23 22:05:27 +00:00
>PUSHWI 256
>PUSHW ZPCLBuf
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
>LDA.G hFile
>SYSCALL fgets
bcs .9
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
lda (ZPCLBuf)
beq .8
2020-11-26 19:47:57 +00:00
cmp #'\'
beq .8
2020-11-23 22:05:27 +00:00
cmp #'#'
bne .1
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
ldy #1
lda (ZPCLBuf),y
beq .1
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
cmp #'!'
beq .8
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.1 jmp CS.RUN.EXEC
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
.8 clc
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
CS.RUN.EXEC lda (ZPCLBufPtr)
beq .8
.1 jsr KW.Lookup
bcs .2
tya
jsr NextKW
jsr .7
bcc CS.RUN.EXEC
rts
2020-11-23 22:05:27 +00:00
.2 jsr CS.RUN.GetSymbol
bcs .5
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
bit ZPType
bmi .4
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
bvc .3
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
>PUSHW ZPAddrPtr
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
rts
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.3 ldy #1
>PUSHB (ZPAddrPtr),y
>PUSHB (ZPAddrPtr)
rts
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.4 bit bCompile
bmi .40
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
jsr .80
bcc CS.RUN.EXEC
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
rts
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.40 >LDYA ZPAddrPtr
2020-11-26 19:47:57 +00:00
jsr EmitJsrYA
2020-11-23 22:05:27 +00:00
bra CS.RUN.EXEC
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.5 jsr CS.RUN.GetNum
bcs .9
.6 jsr NextChar Skip SPACE if any
bne .1
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.8 clc
.9 rts
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.7 txa
asl
tax
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
cpx #$A2 ; ECOLON always EXECUTE
beq .71
bit bCompile
bmi .72
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.70 bcs .99 cannot exec compil only
.71 jmp (J.KEYWORDS,x)
.72 jmp CP.RUN
2020-11-27 16:37:47 +00:00
.80
* >DEBUG
jmp (ZPAddrPtr)
2020-11-23 22:05:27 +00:00
.99 lda #E.SYN
sec
rts
*--------------------------------------
CS.RUN.FOpen >PUSHYA
>PUSHBI O.RDONLY
>PUSHBI S.FI.T.TXT
>PUSHWZ Aux type
>SYSCALL FOpen
bcs .9
>STA.G hFile
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
.9 rts
*--------------------------------------
CS.RUN.GetSymbol
>PUSHB.G hSList
2020-11-19 15:34:02 +00:00
>PUSHW ZPCLBufPtr
>SYSCALL SListLookup
2020-11-23 22:05:27 +00:00
bcs .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>STYA ZPKeyID
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
txa
jsr NextKW
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>PUSHB.G hSList
>PUSHW ZPKeyID
2020-11-23 22:05:27 +00:00
>PUSHWI ZPType
2020-11-19 15:34:02 +00:00
>PUSHWI 4 4 bytes
>PUSHWZ From Start
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>SYSCALL SListGetData
bcs .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.9 rts
2020-11-23 22:05:27 +00:00
*--------------------------------------
CS.RUN.GetNum >PUSHW ZPCLBufPtr
2020-11-19 15:34:02 +00:00
>PUSHWI ZPCLBufPtr
>PUSHBI 10
>SYSCALL StrToL
bcs .9
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack)
sta (pStack),y
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
inc pStack
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
lda (pStack)
sta (pStack),y
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
inc pStack
2020-11-23 22:05:27 +00:00
bit bCompile
2020-11-25 16:29:06 +00:00
bpl .9
2020-11-19 15:34:02 +00:00
2020-11-26 19:47:57 +00:00
.1 >PULLYA
2020-11-25 16:29:06 +00:00
jsr EmitPushA
2020-11-26 19:47:57 +00:00
tya
2020-11-25 16:29:06 +00:00
jmp EmitPushA
2020-11-23 22:05:27 +00:00
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
CS.DOEVENT sec
rts
*--------------------------------------
CS.QUIT >LDA.G hSList
beq .1
>PUSHA
>SYSCALL SListFree
2020-11-23 22:05:27 +00:00
.1 >LDA.G hFile
beq .2
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
>SYSCALL FClose
.2 ldy #hCodeBuf
jsr .7
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
ldy #hDataBuf
2020-11-19 15:34:02 +00:00
jsr .7
2020-11-26 19:47:57 +00:00
2020-11-23 22:05:27 +00:00
ldy #hInputBuf
jsr .7
ldy #hOutputBuf
2020-11-19 15:34:02 +00:00
jsr .7
ldy #hCLBuf
.7 lda (pData),y
beq .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>SYSCALL FreeMem
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.8 clc
rts
*--------------------------------------
PrintPrompt >PUSHW L.MSG.PROMPT
>PUSHBI 0
>SYSCALL PrintF
rts
*--------------------------------------
2020-11-23 22:05:27 +00:00
PrintErrMsg >LDYA.G ZPCLBuf
2020-11-19 15:34:02 +00:00
>STYA ZPPtr1
2020-11-23 22:05:27 +00:00
clc
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
PrintDebugMsg
clc
rts
*--------------------------------------
PrintTraceMsg >STYA ZPPtr3
PrintTraceMsg.3 >PUSHBI '>'
ldy #S.PS.hStdErr
lda (pPS),y
>SYSCALL FPutC
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
ldy #$ff
.1 iny
lda (ZPPtr3),y
beq .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
cmp #C.CR
beq .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
phy
>PUSHA
ldy #S.PS.hStdErr
lda (pPS),y
>SYSCALL FPutC
ply
bra .1
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.8 ldy #S.PS.hStdErr
lda (pPS),y
>PUSHA
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
>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
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
tay
bne .9
>SYSCALL GetChar
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.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
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
jsr IsSpaceOrCR
bcs .8
inc ZPCLBufPtr
bne NextCharNB
inc ZPCLBufPtr+1
bra NextCharNB
2020-11-26 19:47:57 +00:00
.8 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
NextChar lda (ZPCLBufPtr)
beq .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
inc ZPCLBufPtr
bne .8
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
inc ZPCLBufPtr+1
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
.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
*--------------------------------------
CheckStackPop4 lda pStack
sec
sbc #4
bcc .9
clc
rts
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
.INB usr/src/bin/forth.s.cl
2020-11-23 22:05:27 +00:00
.INB usr/src/bin/forth.s.cp
2020-11-19 15:34:02 +00:00
.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.
.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.
.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
2020-11-26 19:47:57 +00:00
DS.START .BS 128 RETURN STACK
2020-11-23 22:05:27 +00:00
2020-11-19 15:34:02 +00:00
bDebug .BS 1
bTrace .BS 1
bExitOnEOF .BS 1
2020-11-23 22:05:27 +00:00
hCodeBuf .BS 1
CodeBuf .BS 2
hDataBuf .BS 1
DataBuf .BS 2
hInputBuf .BS 1
InputBuf .BS 2
hOutputBuf .BS 1
OutputBuf .BS 2
2020-11-19 15:34:02 +00:00
hCLBuf .BS 1
2020-11-23 22:05:27 +00:00
hFile .BS 1
2020-11-19 15:34:02 +00:00
hSList .BS 1
DS.END .ED
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s
ASM