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 *-------------------------------------- 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 ZPInputPtr .BS 2 ZPOutputPtr .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 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.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 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.G InputBuf txa >STA.G hInputBuf >LDYAI OUTPUT.SIZE >SYSCALL GetMem bcs .9 >STYA.G OutputBuf txa >STA.G hOutputBuf >LDYAI CL.SIZE >SYSCALL GetMem bcs .9 >STYA ZPCLBuf txa >STA.G hCLBuf >SYSCALL SListNew bcs .9 >STA.G hSList stz bCompile lda #127 sta RP CS.RUN.LOOP >SLEEP >LDA.G bDebug bpl .2 jsr PrintDebugMsg .2 >LDA.G bTrace bpl .3 >LDYA ZPCLBuf jsr PrintTraceMsg .3 jsr CS.FORTH.Run bcc CS.RUN.LOOP 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 CS.RUN.LOOP * 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 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.FORTH.Run jsr CL.Reset >LDA.G hFile bne CS.FORTH.Run.File 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 >PUSHWI 256 >PUSHW ZPCLBuf >LDA.G hFile >SYSCALL fgets bcs .9 lda (ZPCLBuf) beq .8 cmp #'#' bne .1 ldy #1 lda (ZPCLBuf),y beq .1 cmp #'!' beq .8 .1 jmp CS.RUN.EXEC .8 clc .9 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 jsr CS.RUN.GetSymbol bcs .5 bit ZPType bmi .4 bvc .3 >PUSHW ZPAddrPtr rts .3 ldy #1 >PUSHB (ZPAddrPtr),y >PUSHB (ZPAddrPtr) rts .4 bit bCompile bmi .40 jsr .80 bcc CS.RUN.EXEC rts .40 >LDYA ZPAddrPtr jsr EmitJsrYA bra CS.RUN.EXEC .5 jsr CS.RUN.GetNum bcs .9 .6 jsr NextChar Skip SPACE if any bne .1 .8 clc .9 rts .7 txa asl tax cpx #$A2 ; ECOLON always EXECUTE beq .71 bit bCompile bmi .72 .70 bcs .99 cannot exec compil only .71 jmp (J.KEYWORDS,x) .72 jmp CP.RUN .80 jmp (ZPAddrPtr) .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 .9 rts *-------------------------------------- CS.RUN.GetSymbol >PUSHB.G hSList >PUSHW ZPCLBufPtr >SYSCALL SListLookup bcs .9 >STYA ZPKeyID txa jsr NextKW >PUSHB.G hSList >PUSHW ZPKeyID >PUSHWI ZPType >PUSHWI 4 4 bytes >PUSHWZ From Start >SYSCALL SListGetData bcs .9 .9 rts *-------------------------------------- CS.RUN.GetNum >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 bit bCompile bmi .1 * clc rts .1 >PULLYA jsr EmitPushYA clc .9 rts *-------------------------------------- CS.DOEVENT sec rts *-------------------------------------- CS.QUIT >LDA.G hSList beq .1 >PUSHA >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 *-------------------------------------- PrintPrompt >PUSHW L.MSG.PROMPT >PUSHBI 0 >SYSCALL PrintF rts *-------------------------------------- PrintErrMsg >LDYA.G ZPCLBuf >STYA ZPPtr1 clc 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 *-------------------------------------- CheckStackPop4 lda pStack sec sbc #4 bcc .9 clc rts .9 lda #E.STACKERROR sec rts *-------------------------------------- EmitPullA lda #$B2 lda (zp) jsr EmitByte lda #pStack jsr EmitByte lda #$E6 inc zp lda #pStack bra EmitByte *-------------------------------------- EmitPushYA pha tya jsr EmitPushA pla EmitPushA pha lda #$A9 LDA imm jsr EmitByte pla jsr EmitByte lda #$C6 DEC zp jsr EmitByte lda #pStack jsr EmitByte lda #$92 STA (zp) jsr EmitByte lda #pStack bra EmitByte *-------------------------------------- EmitJsrYA pha lda #$20 jsr EmitByte tya jsr EmitByte pla *-------------------------------------- EmitByte sta (ZPCodePtr) inc ZPCodePtr bne .8 inc ZPCodePtr+1 .8 rts *-------------------------------------- .INB usr/src/bin/forth.s.cl .INB usr/src/bin/forth.s.cp .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