diff --git a/.Floppies/A2OSX.BOOTHD.woz b/.Floppies/A2OSX.BOOTHD.woz index bc6f3ee4..912abc73 100644 Binary files a/.Floppies/A2OSX.BOOTHD.woz and b/.Floppies/A2OSX.BOOTHD.woz differ diff --git a/.Floppies/A2OSX.BUILD.po b/.Floppies/A2OSX.BUILD.po index c699dfce..cbe4c456 100644 Binary files a/.Floppies/A2OSX.BUILD.po and b/.Floppies/A2OSX.BUILD.po differ diff --git a/.Floppies/A2OSX.TEST.po b/.Floppies/A2OSX.TEST.po index c7aae8d5..ed412c8e 100644 Binary files a/.Floppies/A2OSX.TEST.po and b/.Floppies/A2OSX.TEST.po differ diff --git a/A2osX.S.txt b/A2osX.S.txt index 59cfdcd9..6afbbb6a 100644 --- a/A2osX.S.txt +++ b/A2osX.S.txt @@ -333,21 +333,27 @@ DisableRamDRV php lda DEVPTRS3D2 cmp DEVPTRS S0D1=NOVEV bne .1 + lda DEVPTRS3D2+1 cmp DEVPTRS+1 S0D1=NODEV beq .9 S3D2=NODEV, nothing to do + .1 ldx DEVCNT .2 lda DEVLST,x LOOKING FOR $BF, $BB, $B7, $B3 and #$F3 cmp #$B3 beq .3 + dex bpl .2 + plp + lda #1 No device found, exit with error sec rts + .3 cpx DEVCNT beq .5 @@ -364,13 +370,16 @@ DisableRamDRV php sta DEVPTRS3D2 lda DEVPTRS+1 sta DEVPTRS3D2+1 + plp jsr MLI .DA #MLIONLINE .DA MLIONLINE01 clc Success!! rts + .9 plp + lda #0 Not detected sec rts diff --git a/BIN/FORMAT.S.txt b/BIN/FORMAT.S.txt index e77c9ac0..a82a180a 100644 --- a/BIN/FORMAT.S.txt +++ b/BIN/FORMAT.S.txt @@ -336,20 +336,16 @@ CS.RUN.LL.DISKII jsr CS.RUN.ZeroPtr1 16 sectors filled with 0, give some time to spin up stz CurTrack + stz CurQTrack lda TrkCnt sta Counter - ldx #0 - -.1 jsr CS.RUN.CheckCtrlC - bcs .9 +.1 >SLEEP - jsr CS.RUN.SeekToX + jsr CS.RUN.CheckCtrlC bcs .9 - >SLEEP - >PUSHW L.MSG.LLDISK2 >PUSHB CurTrack inc @@ -374,10 +370,10 @@ CS.RUN.LL.DISKII lda CurQTrack * clc adc Stepping - tax - - bra .1 + + jsr CS.RUN.SeekToX + bcc .1 .9 pha jsr CS.RUN.MotorOff @@ -390,6 +386,9 @@ CS.RUN.LL.DISKII >SYSCALL PrintF bcs .9 + ldx #0 + jsr CS.RUN.SeekToX + bit bVerify bpl .80 @@ -399,10 +398,6 @@ CS.RUN.LL.DISKII .80 jmp CS.RUN.MotorOff *-------------------------------------- CS.RUN.LL.DISKII.V - >PUSHW L.MSG.VERIFY - >PUSHBI 0 - >SYSCALL PrintF - lda hTrackBuf bne .10 >LDYAI 512 @@ -465,9 +460,8 @@ CS.RUN.LL.DISKII.V dec Counter bne .3 - >PUSHW L.MSG.CRLF - >PUSHBI 0 - >SYSCALL PrintF + >LDYA L.MSG.OK + >SYSCALL PutS .9 rts *-------------------------------------- @@ -495,12 +489,8 @@ CS.RUN.LL.DISKII.VBLK >PUSHA >PUSHBI 1 >SYSCALL PrintF - plx - rts - -.8 lda #C.CR - >SYSCALL PutChar - plx + +.8 plx rts *-------------------------------------- CS.RUN.MotorOn sec @@ -520,19 +510,22 @@ CS.RUN.SeekToX >PUSHB DSSS0000 >LIBCALL hLIBBLKDEV,LIBBLKDEV.D2MoveHead rts *-------------------------------------- -CS.RUN.ZeroPtr1 >LDYA ZPPtr1 - >STYA ZPPtr2 - - lda #$AA +CS.RUN.ZeroPtr1 lda ZPPtr1+1 + pha + + lda #0 tay -.10 sta (ZPPtr2),y +.1 sta (ZPPtr1),y iny - bne .10 + bne .1 - inc ZPPtr2+1 + inc ZPPtr1+1 dex - bne .10 + bne .1 + + pla + sta ZPPtr1+1 rts *-------------------------------------- @@ -671,6 +664,8 @@ CS.RUN.CheckCtrlC phx phy + >SLEEP + ldy #S.PS.hStdIn lda (pPS),y >SYSCALL FEOF @@ -709,7 +704,7 @@ MSG.NOSIZE .AZ "Unable to get media size." MSG.INIT .AZ "Formatting %s, Volname:%s\r\n" MSG.LL .AZ "Low Level Format %D Blks\r\n" MSG.LLDISK2 .AZ "\rWriting Track %02d (%02d/%02d)..." -MSG.VERIFY .AZ "Verifying Track %02d/%02d, Block %05D..." +MSG.VERIFY .AZ "\rVerifying Track %02d/%02d, Block %05D..." MSG.WRITECAT .AZ "Writing Catalog..." FMT.BLANK .AZ "BLANK%H%H" *-------------------------------------- diff --git a/BIN/FORTH.S.CL.txt b/BIN/FORTH.S.CL.txt new file mode 100644 index 00000000..fff2f4ae --- /dev/null +++ b/BIN/FORTH.S.CL.txt @@ -0,0 +1,266 @@ +NEW + AUTO 3,1 +*-------------------------------------- +CL.READN0A tax +CL.READN0X >PUSHW ZPCLBuf + >PUSHW L.FMT.Byte + txa + >PUSHA + >PUSHBI 1 + >SYSCALL SPrintF + bcs .9 + + lda #$ff + sta CL.bReady +* clc +.9 rts +*-------------------------------------- +CL.CHARIN tax + + bit CL.bEscMode \e ? + bpl .4 + + cpx #'[' + beq .8 \e[ + + stz CL.bEscMode + txa + + ldx #EscChars.Cnt-1 + +.1 cmp EscChars,x + beq .2 + + dex + bpl .1 + +.8 rts invalid \e[ sequence + +.2 lda CL.MaxCnt + bne .3 + + lda EscChars.Remap,x + bra CL.READN0A + +.3 txa + asl + tax + jmp (J.ESC,x) +*-------------------------------------- +.4 cpx #C.ESC + bne .5 + + lda #$ff + sta CL.bEscMode + + clc + rts + +.5 lda CL.MaxCnt + beq CL.READN0X + + cpx #C.SPACE + bcc CL.CHARIN.CTRL + + cpx #C.DEL + bne CL.Insert +*-------------------------------------- +* Erase char BEFORE cursor +*-------------------------------------- + lda CL.Len + beq .8 + + lda CL.Ptr + beq .8 + + lda #C.BS + >SYSCALL PutChar + + dec CL.Ptr + jmp CL.DEL +*-------------------------------------- +CL.Insert ldy CL.Len + cpy CL.MaxCnt + beq .8 Buffer full, discard... + + iny + sty CL.Len + +.1 dey + lda (ZPCLBuf),y Move from Ptr To end of buffer forward... + iny + sta (ZPCLBuf),y + dey + cpy CL.Ptr + bne .1 + + txa + sta (ZPCLBuf),y + inc CL.Ptr + + >SYSCALL PutChar + jsr CL.PrintEOL + + dec CL.MaxCnt MaxCnt = 1, don't wait for CR + bne .8 + + lda #$ff + sta CL.bReady + +.8 clc + rts +*-------------------------------------- +CL.CHARIN.CTRL cpx #C.CR + beq .8 + + cpx #C.EOF + beq .9 + + cpx #3 Ctrl-C + beq CL.CLR + + cpx #26 Ctrl-Z + bne .8 + + jmp CL.SUPPR + +.8 jsr CheckLFAfterCR + bcs .9 + + lda #$ff + sta CL.bReady + + clc +.9 rts +*-------------------------------------- +CL.CLR lda (ZPCLBuf) + beq CL.Reset.1 + +.1 lda CL.Ptr + cmp CL.Len + beq .2 + + inc + sta CL.Ptr + + lda #C.FS + >SYSCALL PutChar + bra .1 + +.2 ldy #0 + +.3 lda #C.DEL + sta (ZPCLBuf),y + iny + lda (ZPCLBuf),y + bne .3 + + jsr CL.PrintCLBuf +*-------------------------------------- +CL.Reset lda #0 + sta (ZPCLBuf) + +CL.Reset.1 ldx #CL.Ptr + +.1 stz 0,x + inx + cpx #CL.bEscMode+1 + bne .1 + + >LDYA ZPCLBuf + >STYA ZPCLBufPtr + + rts +*-------------------------------------- +CL.BS lda CL.Ptr + beq .9 + + dec CL.Ptr + + lda #C.BS + >SYSCALL PutChar + +.9 rts +*-------------------------------------- +CL.NAK lda CL.Ptr + cmp CL.Len + beq .9 + + inc + sta CL.Ptr + + lda #C.FS + >SYSCALL PutChar + +.9 rts +*-------------------------------------- +* Erase char UNDER cursor +*-------------------------------------- +CL.SUPPR lda CL.Len + beq CL.PrintEOL.8 + + lda CL.Ptr + cmp CL.Len + beq CL.PrintEOL.8 +*-------------------------------------- +CL.DEL ldy CL.Ptr + +.1 iny + lda (ZPCLBuf),y + dey + sta (ZPCLBuf),y + iny + cpy CL.Len + bne .1 + + dec CL.Len +*-------------------------------------- +CL.PrintEOL lda CL.Ptr + +.1 cmp CL.Len + beq .2 + + pha + tay + lda (ZPCLBuf),y + >SYSCALL PutChar + pla + inc + bra .1 + +.2 lda #C.SPACE + >SYSCALL PutChar + lda CL.Ptr + +.3 cmp CL.Len + beq .4 + + pha + lda #C.BS + >SYSCALL PutChar + pla + inc + bra .3 + +.4 lda #C.BS + >SYSCALL PutChar + +CL.PrintEOL.8 clc + rts +*-------------------------------------- +CL.PrintCLBuf ldy #S.PS.hStdOut + lda (pPS),y + >PUSHA + >PUSHW ZPCLBuf + + >SYSCALL FPutS + rts +*-------------------------------------- +CL.DN +CL.UP clc + rts +*-------------------------------------- +MAN +SAVE usr/src/bin/forth.s.cl +LOAD usr/src/bin/forth.s +ASM diff --git a/BIN/FORTH.S.KW.txt b/BIN/FORTH.S.KW.txt new file mode 100644 index 00000000..fc9855be --- /dev/null +++ b/BIN/FORTH.S.KW.txt @@ -0,0 +1,769 @@ +NEW + AUTO 3,1 +*-------------------------------------- +KW.Lookup >LDYA L.KEYWORDS + >STYA ZPPtr1 + + >LDYA ZPCLBufPtr + >STYA ZPPtr2 + + ldx #0 + +.1 ldy #$ff + +.2 jsr .7 get next valid char in src text + bcs .3 + +.20 jsr ToUpperCase + eor (ZPPtr1),y match table char ? + asl compare only 7 bits + bne .4 no match...get next table keyword + + bcc .2 not last char in this keyword + + jsr .7 next char in text... + bcc .4 valid....failed + +.8 tya Keyword Len + + clc + rts + +.3 dey + lda (ZPPtr1),y was last char in this keyword ? + bmi .8 + + iny +.41 jsr IncPtr1 skip chars to next keyword + +.4 lda (ZPPtr1) + bpl .41 + jsr IncPtr1 + +.6 inx + lda (ZPPtr1) Array Ending 0, lookup failed + bne .1 + +.9 sec + rts + +.7 iny + lda (ZPPtr2),y Get Src text char... + beq .9 end of text + + jsr IsSpaceOrCR + bcc .9 end of valid chars + + clc + rts +*-------------------------------------- +KW.DUP lda pStack + sec + sbc #2 + bcc .9 + + lda (pStack) + tax + ldy #1 + lda (pStack),y + >PUSHA + txa + >PUSHA + clc + rts + +.9 lda #E.STKOVERFLOW + sec + rts +*-------------------------------------- +KW.DROP lda pStack + beq .9 + + inc pStack + beq .9 + inc pStack + clc + rts + +.9 lda #E.STACKERROR + sec + rts +*-------------------------------------- +KW.SWAP ldy #3 + lda (pStack),y + pha + + dey #2 + lda (pStack),y + pha + + lda (pStack) + tax + pla + sta (pStack) + + txa + sta (pStack),y #2 + + dey #1 + lda (pStack),y + tax + pla + sta (pStack),y + + iny + iny #3 + txa + sta (pStack),y + clc + rts +*-------------------------------------- +KW.OVER lda pStack + sec + sbc #2 + bcc .9 + + ldy #3 + lda (pStack),y + >PUSHA + lda (pStack),y + >PUSHA + clc + rts + +.9 lda #E.STKOVERFLOW + sec + rts +*-------------------------------------- +KW.ROT +*-------------------------------------- +KW.mDUP +*-------------------------------------- +KW.gR +*-------------------------------------- +KW.Rg +*-------------------------------------- +KW.R + clc + rts +*-------------------------------------- +KW.Add jsr CheckStackPop4 + bcs .9 + + clc + ldy #2 + lda (pStack),y + adc (pStack) + sta (pStack),y + inc pStack + + lda (pStack),y + adc (pStack) + sta (pStack),y + inc pStack + + clc +.9 rts +*-------------------------------------- +KW.DAdd >FPU ADD32 + clc + rts +*-------------------------------------- +KW.Sub jsr CheckStackPop4 + bcs .9 + + sec + ldy #2 + lda (pStack),y + sbc (pStack) + sta (pStack),y + inc pStack + + lda (pStack),y + sbc (pStack) + sta (pStack),y + inc pStack + + clc +.9 rts +*-------------------------------------- +KW.Mul +*-------------------------------------- +KW.Div +*-------------------------------------- +KW.Mod +*-------------------------------------- +KW.DivMod +*-------------------------------------- +KW.MulDivMod +*-------------------------------------- +KW.MulDiv +*-------------------------------------- +KW.MAX jsr CheckStackPop4 + bcs .9 + + lda (pStack) LO + ldy #2 + cmp (pStack),y + + dey #1 + + lda (pStack),y HI + iny + iny #3 + sbc (pStack),y + bcc .1 + + jsr KW.SWAP + +.1 jmp KW.DROP + +.9 rts +*-------------------------------------- +KW.MIN jsr CheckStackPop4 + bcs .9 + + lda (pStack) LO + ldy #2 + cmp (pStack),y + + dey #1 + + lda (pStack),y HI + iny + iny #3 + sbc (pStack),y + bcs .1 + + jsr KW.SWAP + +.1 jmp KW.DROP + +.9 rts +*-------------------------------------- +KW.ABS +*-------------------------------------- +KW.DABS + clc + rts +*-------------------------------------- +KW.MINUS lda (pStack) LO + eor #$ff + sec + adc #0 + sta (pStack) + + ldy #1 + lda (pStack),y HI + eor #$ff + adc #0 + sta (pStack),y + + clc + rts +*-------------------------------------- +KW.DMINUS lda (pStack) LO + eor #$ff + sec + adc #0 + sta (pStack) + + ldy #1 + lda (pStack),y HI + eor #$ff + adc #0 + sta (pStack),y + + iny + lda (pStack),y + eor #$ff + adc #0 + sta (pStack),y + + iny + lda (pStack),y + eor #$ff + adc #0 + sta (pStack),y + + clc + rts +*-------------------------------------- +KW.AND jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + and (pStack) + sta (pStack),y + inc pStack + + lda (pStack),y + and (pStack) + sta (pStack),y + inc pStack + + clc + +.9 rts +*-------------------------------------- +KW.OR jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + ora (pStack) + sta (pStack),y + inc pStack + + lda (pStack),y + ora (pStack) + sta (pStack),y + inc pStack + + clc + +.9 rts +*-------------------------------------- +KW.XOR jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + eor (pStack) + sta (pStack),y + inc pStack + + lda (pStack),y + eor (pStack) + sta (pStack),y + inc pStack + + clc + +.9 rts +*-------------------------------------- +KW.LWR jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + cmp (pStack) + inc pStack + + lda (pStack),y + sbc (pStack),y + inc pStack + + inc pStack + + rol + sta (pStack) + + clc + +.9 rts +*-------------------------------------- +KW.GTR jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + cmp (pStack) + inc pStack + + lda (pStack),y + sbc (pStack),y + inc pStack + + inc pStack + + rol + eor #$80 + sta (pStack) + + clc + +.9 rts +*-------------------------------------- +KW.EQ jsr CheckStackPop4 + bcs .9 + + ldy #2 + lda (pStack),y + sec + sbc (pStack) + tax + inc pStack + + lda (pStack),y + sbc (pStack),y + inc pStack + + inc pStack + + bcc .1 + + txa + bne .1 + + sec + .HS 90 BCC +.1 clc + ror + sta (pStack) + + clc +.9 rts +*-------------------------------------- +KW.NEGATIVE >PULLA + >PULLA + bpl .9 + + sec + .HS 90 BCC +.9 clc + ror + sta (pStack) + + clc + rts +*-------------------------------------- +KW.ZERO >PULLA + tax + >PULLA + bne .9 + + txa + bne .9 + + sec + .HS 90 BCC +.9 clc + ror + sta (pStack) + + clc + rts +*-------------------------------------- +KW.. jsr KW.DUP + bcs .9 + + ldy #2 + lda L.FMT.int16 + sta (pStack),y + iny + lda L.FMT.int16+1 + sta (pStack),y + >PUSHBI 2 + >SYSCALL PrintF + +* clc + +.9 rts +*-------------------------------------- +KW..R +*-------------------------------------- +KW.D. +*-------------------------------------- +KW.D.R + clc + rts +*-------------------------------------- +KW.CR >PUSHW L.MSG.ECHOCRLF + >PUSHBI 0 + >SYSCALL PrintF + rts +*-------------------------------------- +KW.SPACE lda #C.SPACE + >SYSCALL PutChar + rts +*-------------------------------------- +KW.SPACES >PULLA + + beq .8 + +.1 dec + + pha + + lda #C.SPACE + >SYSCALL PutChar + pla + bne .1 + +.8 clc + rts +*-------------------------------------- +KW.PRINT >LDYAI 256 + >SYSCALL GetMem + bcs .9 + + >STYA ZPPtr1 + phx + + ldy #$ff + + clc + +.1 iny + lda (ZPCLBufPtr),y + beq .2 + + sta (ZPPtr1),y + eor #'" + bne .1 + + sec + +.2 sta (ZPPtr1),y + tya + adc ZPCLBufPtr + sta ZPCLBufPtr + bcc .3 + + inc ZPCLBufPtr+1 + +.3 >LDYA ZPPtr1 + >SYSCALL PutS + + pla + >SYSCALL freemem + + jmp NextChar + +.9 rts +*-------------------------------------- +KW.DUMP +*-------------------------------------- +KW.TYPE +*-------------------------------------- +KW.COUNT +*-------------------------------------- +KW.TERMINAL + clc + rts +*-------------------------------------- +KW.KEY >SYSCALL GetChar + bcs .9 + + >PUSHA + +.9 rts +*-------------------------------------- +KW.EMIT >PULLA + >SYSCALL PutChar + rts +*-------------------------------------- +KW.EXPECT +*-------------------------------------- +KW.WORD +*-------------------------------------- +KW.NUMBER +*-------------------------------------- +KW.STARTSTR +*-------------------------------------- +KW.STRADD +*-------------------------------------- +KW.STRDBL +*-------------------------------------- +KW.SIGN +*-------------------------------------- +KW.ENDSTR +*-------------------------------------- +KW.HOLD +*-------------------------------------- +KW.DECIMAL +*-------------------------------------- +KW.HEX +*-------------------------------------- +KW.OCTAL clc + rts +*-------------------------------------- +KW.FETCHW lda (pStack) + sta ZPAddrPtr + ldy #1 + lda (pStack),y + sta ZPAddrPtr+1 + + lda (ZPAddrPtr) + sta (pStack) + lda (ZPAddrPtr),y + sta (pStack),y + clc + rts +*-------------------------------------- +KW.STOREW jsr CheckStackPop4 + bcs .9 + + >PULLW ZPAddrPtr + >PULLA + sta (ZPAddrPtr) + >PULLA + ldy #1 + sta (ZPAddrPtr),y + +* clc + +.9 rts +*-------------------------------------- +KW.FETCHB >PULLW ZPAddrPtr + lda (ZPAddrPtr) + >PUSHA + clc + rts +*-------------------------------------- +KW.STOREB >PULLW ZPAddrPtr + >PULLA + sta (ZPAddrPtr) + clc +KW.STOREB.RTS rts +*-------------------------------------- +KW.FETCHPRINTW jsr KW.FETCHW + bcs KW.STOREB.RTS + jmp KW.. +*-------------------------------------- +KW.ADDTOW jsr KW.FETCHW + bcs KW.STOREB.RTS + jsr KW.Add + bcs KW.STOREB.RTS + jmp KW.STOREW +*-------------------------------------- +KW.CMOVE + clc + rts +*-------------------------------------- +KW.FILL >PULLA + bra KW.FILL2 + +KW.ERASE lda #0 + bra KW.FILL2 + +KW.BLANKS lda #C.SPACE + +KW.FILL2 tax + + >PULLA + tay + + >PULLW ZPAddrPtr + + txa + +.1 dey + sta (ZPAddrPtr),y + cpy #0 + bne .1 + + clc + rts +*-------------------------------------- +KW.HERE >PUSHW ZPUsrBufPtr + clc + rts +*-------------------------------------- +KW.PAD >PUSHW ZPPadBuf + clc + rts +*-------------------------------------- +KW.ALLOT +KW.nCOMPILE +KW.QUOTE +KW.FORGET +KW.DEFINITIONS +KW.VOCABULARY +KW.FORTH +KW.EDITOR +KW.ASSEMBLER +KW.VLIST + clc + rts +*-------------------------------------- +KW.BCOLON + + clc + rts +*-------------------------------------- +KW.ECOLON + + clc + rts +*-------------------------------------- +KW.VARIABLE >PUSHB.G hSList + >PUSHW ZPCLBufPtr + + >SYSCALL SListNewKey + bcs .9 + + >STYA ZPKeyID + + txa + jsr NextKW + + >LDYA L.PUSHADDR + >STYA ZPUsrCodePtr + + >PUSHB.G hSList + >PUSHW ZPKeyID + >PUSHWI ZPUsrBufPtr + >PUSHWI 4 BufPtr+CodePtr + >SYSCALL SListAddData + bcs .9 + + >PULLA + sta (ZPUsrBufPtr) + >PULLA + ldy #1 + sta (ZPUsrBufPtr),y + + lda ZPUsrBufPtr + clc + adc #2 + sta ZPUsrBufPtr + bcc .9 + + inc ZPUsrBufPtr+1 + + clc +.9 rts +*-------------------------------------- +KW.CONSTANT +*-------------------------------------- +KW.ACODE +*-------------------------------------- +KW.FCODE +*-------------------------------------- +KW.DO +*-------------------------------------- +KW.LOOP +*-------------------------------------- +PW.pLOOP +*-------------------------------------- +KW.I +*-------------------------------------- +KW.LEAVE +*-------------------------------------- +KW.IF +*-------------------------------------- +KW.ELSE +*-------------------------------------- +KW.ENDIF +*-------------------------------------- +KW.BEGIN +*-------------------------------------- +KW.UNTIL +*-------------------------------------- +KW.REPEAT +*-------------------------------------- +KW.WHILE + + clc + rts +*-------------------------------------- +KW.COMMENT clc + rts +*-------------------------------------- +MAN +SAVE usr/src/bin/forth.s.kw +LOAD usr/src/bin/forth.s +ASM diff --git a/BIN/FORTH.S.txt b/BIN/FORTH.S.txt new file mode 100644 index 00000000..5cd66364 --- /dev/null +++ b/BIN/FORTH.S.txt @@ -0,0 +1,840 @@ +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 +*-------------------------------------- +USERSPACE.SIZE .EQ 4096 +SCRATCH.SIZE .EQ 256 +*-------------------------------------- + .DUMMY + .OR ZPBIN +ZS.START +ZPCLBuf .BS 2 +ZPCLBufPtr .BS 2 +ZPFileBuf .BS 2 +ZPFileBufPtr .BS 2 + +ZPPadBuf .BS 2 +ZPKeyID .BS 2 + +ZPUsrBufPtr .BS 2 +ZPUsrCodePtr .BS 2 + +ZPAddrPtr .BS 2 +ZPCodePtr .BS 2 + +ZPPtr1 .BS 2 +ZPPtr2 .BS 2 + +ZPPtr3 .BS 2 + +CL.Ptr .BS 1 +CL.Len .BS 1 +CL.bReady .BS 1 +CL.bEscMode .BS 1 +CL.MaxCnt .BS 1 + +bCompile .EQ * +ArgIndex .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.PUSHADDR .DA PUSHADDR +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 256 + >SYSCALL GetMem + bcs CS.INIT.RTS + + >STYA ZPCLBuf + txa + >STA.G hCLBuf + + >LDYAI 256 + >SYSCALL GetMem + bcs CS.INIT.RTS + + >STYA ZPPadBuf + txa + >STA.G hPadBuf + + >LDYAI USERSPACE.SIZE + >SYSCALL GetMem + bcs CS.INIT.RTS + + >STYA ZPUsrBufPtr + >STYA.G UsrBuf + txa + >STA.G hUsrBuf + + >SYSCALL SListNew + bcs CS.INIT.RTS + + >STA.G hSList + + stz bCompile + +.1 >SLEEP + + >LDA.G bDebug + bpl .2 + + jsr PrintDebugMsg + +.2 >LDA.G bTrace + bpl .3 + + >LDYA ZPFileBufPtr + jsr PrintTraceMsg + +.3 jsr CS.FORTH.Run + bcc .1 + + 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 .1 + +* 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 hFileBuf + bne .90 + + >LDYA ZPPtr1 + jsr CS.RUN.LoadFile + bcs .9 + + >STA.G hFileBuf + 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 >LDA.G hFileBuf + bne CS.FORTH.Run.File + + jsr CL.Reset + + 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 + lda (ZPFileBufPtr) + beq .8 + + ldy #$ff + +.3 iny + lda (ZPFileBufPtr),y + sta (ZPCLBuf),y + beq .4 + + eor #C.CR + bne .3 + + sta (ZPCLBuf),y + + iny + +.4 tya + + clc + adc ZPFileBufPtr + sta ZPFileBufPtr + bcc .5 + + inc ZPFileBufPtr+1 + +.5 lda (ZPCLBuf) + beq CS.FORTH.Run.File + + cmp #'#' + beq CS.FORTH.Run.File + + >LDYA ZPCLBuf + >STYA ZPCLBufPtr + + jmp CS.RUN.EXEC + +.8 lda #MLI.E.EOF + + sec + 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 >PUSHB.G hSList + >PUSHW ZPCLBufPtr + >SYSCALL SListLookup + bcs .5 + + >STYA ZPKeyID + + >PUSHB.G hSList + >PUSHW ZPKeyID + >PUSHWI ZPAddrPtr + >PUSHWI 4 4 bytes + >PUSHWZ From Start + + >SYSCALL SListGetData + bcs .9 + + jmp (ZPCodePtr) + +.8 clc +.9 rts + +.5 >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 + +.6 jsr NextChar Skip SPACE if any + beq .8 + + jmp .1 + +.7 txa + asl + tax + + jmp (J.KEYWORDS,x) +*-------------------------------------- +CS.RUN.LoadFile >PUSHYA + >PUSHBI O.RDONLY + >PUSHBI S.FI.T.TXT + >PUSHWZ Aux type + >SYSCALL LoadTxtFile + bcs .9 + + phx + txa + >SYSCALL GetMemPtr + >STYA ZPFileBuf + >STYA ZPFileBufPtr + pla + +.9 rts +*-------------------------------------- +CS.DOEVENT sec + rts +*-------------------------------------- +CS.QUIT >LDA.G hSList + beq .1 + + >PUSHA + >SYSCALL SListFree + +.1 ldy #hFileBuf + jsr .7 + + ldy #hUsrBuf + 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 ZPFileBuf + >STYA ZPPtr1 + + stz ZPPtr2 + stz ZPPtr2+1 Line counter + +.1 inc ZPPtr2 + bne .2 + inc ZPPtr2+1 + +.2 >LDYA ZPPtr1 + >STYA ZPPtr3 save line start + +.20 lda (ZPPtr1) + beq .4 EoF + + inc ZPPtr1 + bne .3 + inc ZPPtr1+1 +.3 cmp #C.CR + bne .20 Scan until EoL + + ldx ZPPtr1 + cpx ZPFileBufPtr + lda ZPPtr1+1 + sbc ZPFileBufPtr+1 + bcc .1 not this line.... + +.4 >LDA.G bTrace + bmi .5 + + jsr PrintTraceMsg.3 + +.5 lda ZPPtr3 + cmp ZPFileBufPtr + bne .6 + + lda ZPPtr3+1 + cmp ZPFileBufPtr+1 + beq .8 + +.6 >PUSHBI '-' + ldy #S.PS.hStdErr + lda (pPS),y + >SYSCALL FPutC + inc ZPPtr3 + bne .5 + inc ZPPtr3+1 + bra .5 + +.8 ldy #S.PS.hStdErr + lda (pPS),y + >PUSHA + >PUSHW L.MSG.ERR + >PUSHW ZPPtr2 Line counter + >PUSHBI 2 + >SYSCALL FPrintF + + 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 +*-------------------------------------- +PUSHADDR lda ZPAddrPtr+1 + >PUSHA + lda ZPAddrPtr + >PUSHA + rts +*-------------------------------------- +CheckStackPop4 lda pStack + sec + sbc #4 + bcc .9 + + clc + rts + +.9 lda #E.STACKERROR + sec + rts +*-------------------------------------- + .INB usr/src/bin/forth.s.cl + .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