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

1193 lines
26 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
.LIST OFF
.OP 65C02
.OR $2000
.TF bin/forth
*--------------------------------------
HIS.MAX .EQ 10
HISTORY.MAX .EQ 512
*--------------------------------------
.INB inc/macros.i
.INB inc/a2osx.i
.INB inc/kernel.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.HIS .DA MSG.HIS
L.MSG.HISPROMPT .DA MSG.HISPROMPT
L.MSG.HISROMPTCLR .DA MSG.HISROMPTCLR
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
L.FMT.uint16 .DA FMT.uint16
L.FMT.int32 .DA FMT.int32
J.ESC .DA CL.BS left arrow
.DA HIS.GetNext
.DA HIS.GetPrev
.DA CL.NAK right arrow
L.KEYWORDS .DA KEYWORDS
I.KEYWORDS .DA GFX.TEXT
.DA GFX.GR
.DA GFX.PLOT
.DA GFX.RECT
.DA KW.DUP
.DA KW.DROP
.DA KW.SWAP
.DA KW.OVER
.DA KW.ROT
.DA KW.qDUP
.DA KW.Add
.DA KW.DAdd
.DA KW.Sub
.DA KW.DSub
.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.NEGATE
.DA KW.DNEGATE
.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.U.
.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.FETCHSP
.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
.DA KW.INVALID KW.ECOLON
.DA KW.ACODE
.DA KW.FCODE
KW.DO.ID .EQ *-I.KEYWORDS
.DA KW.INVALID KW.DO
.DA KW.INVALID KW.LOOP
.DA KW.INVALID KW.pLOOP
.DA KW.INVALID KW.I
.DA KW.INVALID KW.LEAVE
KW.IF.ID .EQ *-I.KEYWORDS
.DA KW.INVALID KW.IF
.DA KW.INVALID KW.ELSE
.DA KW.INVALID KW.THEN
.DA KW.INVALID KW.BEGIN
.DA KW.INVALID KW.UNTIL
.DA KW.INVALID KW.REPEAT
.DA KW.INVALID KW.WHILE
.DA KW.gR
.DA KW.Rg
.DA KW.R
*--------------------------------------
C.KEYWORDS .DA CP.JSRX GFX.TEXT
.DA CP.JSRX GFX.GR
.DA CP.JSRX GFX.PLOT
.DA CP.JSRX GFX.RECT
.DA CP.JSRX KW.DUP
.DA CP.JSRX KW.DROP
.DA CP.JSRX KW.SWAP
.DA CP.JSRX KW.OVER
.DA CP.JSRX KW.ROT
.DA CP.JSRX KW.qDUP
.DA CP.JSRX KW.Add
.DA CP.JSRX KW.DAdd
.DA CP.JSRX KW.Sub
.DA CP.JSRX KW.DSub
.DA CP.JSRX KW.Mul
.DA CP.JSRX KW.Div
.DA CP.JSRX KW.Mod
.DA CP.JSRX KW.DivMod
.DA CP.JSRX KW.MulDivMod
.DA CP.JSRX KW.MulDiv
.DA CP.JSRX KW.MAX
.DA CP.JSRX KW.MIN
.DA CP.JSRX KW.ABS
.DA CP.JSRX KW.DABS
.DA CP.JSRX KW.NEGATE
.DA CP.JSRX KW.DNEGATE
.DA CP.JSRX KW.AND
.DA CP.JSRX KW.OR
.DA CP.JSRX KW.XOR
.DA CP.JSRX KW.LWR
.DA CP.JSRX KW.GTR
.DA CP.JSRX KW.EQ
.DA CP.JSRX KW.NEGATIVE
.DA CP.JSRX KW.ZERO
.DA CP.JSRX KW..
.DA CP.JSRX KW.U.
.DA CP.JSRX KW..R
.DA CP.JSRX KW.D.
.DA CP.JSRX KW.D.R
.DA CP.JSRX KW.CR
.DA CP.JSRX KW.SPACE
.DA CP.JSRX KW.SPACES
.DA CP.PRINT
.DA CP.JSRX KW.DUMP
.DA CP.JSRX KW.TYPE
.DA CP.JSRX KW.COUNT
.DA CP.JSRX KW.TERMINAL
.DA CP.JSRX KW.KEY
.DA CP.JSRX KW.EMIT
.DA CP.JSRX KW.EXPECT
.DA CP.JSRX KW.WORD
.DA CP.JSRX KW.NUMBER
.DA CP.JSRX KW.STARTSTR
.DA CP.JSRX KW.STRADD
.DA CP.JSRX KW.STRDBL
.DA CP.JSRX KW.SIGN
.DA CP.JSRX KW.ENDSTR
.DA CP.JSRX KW.HOLD
.DA CP.JSRX KW.DECIMAL
.DA CP.JSRX KW.HEX
.DA CP.JSRX KW.OCTAL
.DA CP.JSRX KW.FETCHSP
.DA CP.JSRX KW.FETCHW
.DA CP.JSRX KW.STOREW
.DA CP.JSRX KW.FETCHB
.DA CP.JSRX KW.STOREB
.DA CP.JSRX KW.FETCHPRINTW
.DA CP.JSRX KW.ADDTOW
.DA CP.JSRX KW.CMOVE
.DA CP.JSRX KW.FILL
.DA CP.JSRX KW.ERASE
.DA CP.JSRX KW.BLANKS
.DA CP.JSRX KW.HERE
.DA CP.JSRX KW.PAD
.DA CP.JSRX KW.ALLOT
.DA CP.JSRX KW.nCOMPILE
.DA CP.JSRX KW.QUOTE
.DA CP.JSRX KW.FORGET
.DA CP.JSRX KW.DEFINITIONS
.DA CP.JSRX KW.VOCABULARY
.DA CP.JSRX KW.FORTH
.DA CP.JSRX KW.EDITOR
.DA CP.JSRX KW.ASSEMBLER
.DA CP.INVALID KW.VLIST
.DA CP.JSRX KW.VARIABLE
.DA CP.JSRX KW.CONSTANT
.DA CP.INVALID KW.BCOLON
.DA CP.ECOLON
.DA CP.INVALID KW.ACODE
.DA CP.INVALID KW.FCODE
.DA CP.DO
.DA CP.LOOP
.DA CP.pLOOP
.DA CP.I
.DA CP.LEAVE
.DA CP.IF
.DA CP.ELSE
.DA CP.THEN
.DA CP.BEGIN
.DA CP.UNTIL
.DA CP.REPEAT
.DA CP.WHILE
.DA CP.JSRX KW.gR
.DA CP.JSRX KW.Rg
.DA CP.JSRX KW.R
.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
lda #SL..+SL._
>SYSCALL SListNew
bcs .9
>STA.G hSList
* stz bCompile
lda #127
sta RP
jsr HIS.Init
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 GetErrMsg
>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 CL.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
jsr HIS.Add
jmp CS.RUN.EXEC
.9 rts
*--------------------------------------
CS.FORTH.Run.File
>INCW.G LineCounter
>PUSHB.G hFile
>PUSHW ZPCLBuf
>PUSHWI 256
>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
bit bCompile
bmi .3
>PUSHW ZPAddrPtr CONSTANT,VARIABLE
bra CS.RUN.EXEC
.3 lda ZPAddrPtr+1 VARIABLE : push addr, CONSTANT : push value
jsr CP.Emit.PUSHBI
lda ZPAddrPtr
jsr CP.Emit.PUSHBI
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
rts
.7 bit bCompile
bmi .71
.70 jmp (I.KEYWORDS,x) INTERPRET
.71 jmp (C.KEYWORDS,x) COMPILE
.80 jmp (ZPAddrPtr) RUN
*--------------------------------------
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
CS.RUN.FOpen.RTS
rts
*--------------------------------------
CS.RUN.GetSymbol
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListLookup
bcs CS.RUN.FOpen.RTS
>STYA ZPKeyID
txa
jsr NextKW
CS.RUN.GetSymbolData
>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 HIS.hBuf
beq .10
>SYSCALL FreeStkObj
.10 >LDA.G hSList
beq .1
>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
*--------------------------------------
PrintDebugMsg lda pStack+1
ldy pStack
bne .1
inc
.1 pha
>PUSHW L.MSG.DEBUG
>PUSHW ZPCodePtr
>PUSHW ZPDataPtr
pla
>PUSHYA
>PUSHB RP
>PUSHBI 7
>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.his
.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 (FORTH-79)\r\n"
MSG.HIS .AZ "\r\n%3d : %s"
MSG.HISPROMPT .AZ "\r\n\r\n? "
MSG.HISROMPTCLR .DA #C.BS,#C.BS,#0
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 "
FMT.uint16 .AZ "%D "
FMT.int32 .AZ "%L "
*--------------------------------------
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 "TEXT"
.AT "GR"
.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 "+" ( n1 n2 - sum ) Add.
.AT "D+" ( d1 d2 - sum ) Add double-precision numbers.
.AT "-" ( n1 n2 - diff ) Subtract (n1-n2).
.AT "D-" ( d1 d2 - diff ) Subtract double-precision numbers.
.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 "NEGATE" ( n - -n ) Change sign.
.AT "DNEGATE" ( 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 "U." ( u - ) Print UNSIGNED 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 "SP@" ( - addr ) Return the address of the top of the stack, just before SP@ was executed
.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 "THEN" ( - ) 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 ">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.
*--------------------------------------
.DA #0
*--------------------------------------
CODE.RPDROP2 inc RP
inc RP
CODE.RPDROP2.L .EQ *-CODE.RPDROP2
*--------------------------------------
CODE.TESTTRUE >PULLA
tax
.1 bmi .1+5
CODE.TESTTRUE.L .EQ *-CODE.TESTTRUE
*--------------------------------------
CODE.TESTFALSE >PULLA
tax
.1 bpl .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.DO lda RP
sec
sbc #4
sta RP
tay
ldx #4
.1 >PULLA
iny
sta (pData),y
dex
bne .1
CODE.DO.L .EQ *-CODE.DO
*--------------------------------------
CODE.DOTEST ldy RP
iny
lda (pData),y I LO
iny
iny
cmp (pData),y END LO
dey
lda (pData),y I HI
iny
iny
sbc (pData),y END HI
.1 bcc .1+5 Skip JMP LOOPEND
CODE.DOTEST.L .EQ *-CODE.DOTEST
*--------------------------------------
CODE.LOOP >PULLA
ldy RP
iny
clc
adc (pData),y
sta (pData),y
>PULLA
iny
adc (pData),y
sta (pData),y
CODE.LOOP.L .EQ *-CODE.LOOP
*--------------------------------------
CODE.LOOPEND lda RP POP 4 bytes
clc
adc #4
sta RP
CODE.LOOPEND.L .EQ *-CODE.LOOPEND
*--------------------------------------
CODE.I ldy RP
iny
iny
lda (pData),y
>PUSHA
dey
lda (pData),y
>PUSHA
CODE.I.L .EQ *-CODE.I
*--------------------------------------
CODE.LEAVE ldy RP
iny
iny skip I
iny
lda (pData),y get end LO
tax
iny
lda (pData),y get end HI
dey
dey
sta (pData),y I HI
txa
dey
sta (pData),y I LO
CODE.LEAVE.L .EQ *-CODE.LEAVE
*--------------------------------------
.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
HIS.hBuf .BS 1
HIS.Count .BS 1
HIS.Index .BS 1
HIS.LRU .BS 1
hFile .BS 1
LineCounter .BS 2
hSList .BS 1
hDevGFX .BS 1
DS.END .ED
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s
ASM
Reference in New Issue View Git Blame Copy Permalink