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 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 .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