A2osX/BIN/FORTH.S.txt

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.FS			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 #24					Ctrl-X
				beq .8

				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 #24					Ctrl-X
				beq .9					CS

				jsr CL.CHARIN
				bcs .9

				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
				>PUSHWI 0				ScopeID
				>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 StrVFree

.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	.CZ "\e[?7h\r\nA2osX-FORTH %d.%d (FORTH-79)\r\n"
MSG.HIS			.CZ "\r\n%3d : %s"
MSG.HISPROMPT	.CZ "\r\n\r\n? "
MSG.HISROMPTCLR .CZ "\b \b"
MSG.USAGE		.CS "Usage : FORTH <option> file\r\n"
				.CS "   -D : Debug Mode\r\n"
				.CS "   -T : Trace On"
MSG.ECHOCRLF	.CZ "\r\n"
MSG.DEBUG		.CZ "(CODE:%H, DATA=%H, SP=%H, RP=%h)\r\n"
MSG.TRACE		.CZ "[%5D]%s\r\n"
MSG.PROMPT		.CZ "\e[?7h\r\n> "		Enable Line Wrap
MSG.PROMPTCRLF	.CZ "\e[?7l\r\n"		Disable Line Wrap
MSG.OK			.CZ "OK\r\n"
MSG.DUMP2		.CZ "%s %s%D "
MSG.CONST		.CZ "Const V="
MSG.VAR			.CZ "Var @="
MSG.CODE		.CZ "Code @="
FMT.Byte		.CZ "%d "
FMT.int16		.CZ "%I "
FMT.uint16		.CZ "%D "
FMT.int32		.CZ "%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,#21
*--------------------------------------
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