Kernel 0.94

This commit is contained in:
Rémy GIBERT 2020-12-02 16:22:57 +01:00
parent abbd0bec8a
commit ef3e62d5c7
13 changed files with 473 additions and 375 deletions

View File

@ -8,12 +8,12 @@ This document lists all of the **Forth Words** supported in the A2osX implementa
| Word | Syntax | Status | Description | Comment |
|-|-|-|-|-|
| DUP | ( n - n n ) | Working | Duplicate top of stack |
| DUP | ( n - n n ) | Working | Duplicate top of stack |
| DROP | ( n - ) | Working | Discard top of stack |
| SWAP | ( n1 n2 - n2 n1 ) | Working | Reverse top two stack items |
| OVER | ( n1 n2 - n1 n2 n1 ) | Working | Copy second item to top |
| ROT | ( n1 n2 n3 - n2 n3 n1 ) | | Rotate third item to top |
| -DUP | ( n - n ? ) | | Duplicate only if non-zero |
| ROT | ( n1 n2 n3 - n2 n3 n1 ) | Working | Rotate third item to top |
| -DUP | ( n - n ? ) | Working | Duplicate only if non-zero |
| >R | ( n - ) | | Move top item to return stack |
| R> | ( - n ) | | Retrieve item from return stack |
| R | ( - n ) | Working | Copy top of return stack onto stack |
@ -78,7 +78,7 @@ This document lists all of the **Forth Words** supported in the A2osX implementa
| BLANKS | ( addr u - ) | Working | Fill u bytes in memory with blanks |
| HERE | ( - addr ) | Working | Return address above dictionary |
| PAD | ( - addr ) | Working | Return address of scratch area |
| ALLOT | ( u - ) | | Leave a gap of n bytes in the dictionary |
| ALLOT | ( u - ) | Working | Leave a gap of n bytes in the dictionary |
| , | ( n - ) | | Compile number n into the dictionary |
| ' | ( - addr ) | | Find address of next string in dictionary |
| FORGET | ( - ) | | Delete all definitions above and including the following definition |

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -721,33 +721,65 @@ Disk2.Default .DA 280 BlkCnt
.DA #35 TrkCnt
.DA #4 Stepping
.DA #1 VolNum
* .DA #140 QTrkCnt
.DA #0 AltBB
.BS 2
.DA #0 HeadCnt
.BS 1
*--------------------------------------
Disk2.X .DA 320 BlkCnt
.DA #40 TrkCnt
.DA #4 Stepping
.DA #2 VolNum
* .DA #160 QTrkCnt
.DA #0 AltBB
.BS 2
.DA #0 HeadCnt
.BS 1
*--------------------------------------
Disk2.H .DA 384 BlkCnt
.DA #48 TrkCnt
.DA #3 Stepping
.DA #129 VolNum
* .DA #144 QTrkCnt
.DA #$80 AltBB
.BS 2
.DA #0 HeadCnt
.BS 1
*--------------------------------------
Disk2.HX .DA 432 BlkCnt
.DA #54 TrkCnt
.DA #3 Stepping
.DA #130 VolNum
* .DA #162 QTrkCnt
.DA #$80 AltBB
.BS 2
.DA #0 HeadCnt
.BS 1
*-------------------------------------- RANA Elite 2
Disk2.DefaultD .DA 640 BlkCnt
.DA #40 TrkCnt
.DA #2 Stepping
.DA #193 VolNum
.DA #$80 AltBB
.DA #1 HeadCnt
.BS 1
*--------------------------------------
Disk2.XD .DA 640 BlkCnt
.DA #40 TrkCnt
.DA #2 Stepping
.DA #193 VolNum
.DA #$80 AltBB
.DA #1 HeadCnt
.BS 1
*-------------------------------------- RANA Elite 3
Disk2.HD .DA 1280 BlkCnt
.DA #80 TrkCnt
.DA #2 Stepping
.DA ##194 VolNum
.DA #$80 AltBB
.DA #1 HeadCnt
.BS 1
*--------------------------------------
Disk2.HXD .DA 1280 BlkCnt
.DA #80 TrkCnt
.DA #2 Stepping
.DA ##194 VolNum
.DA #$80 AltBB
.DA #1 HeadCnt
.BS 1
*--------------------------------------
.DUMMY
.OR 0

View File

@ -101,7 +101,8 @@ CL.Insert ldy CL.Len
>SYSCALL PutChar
jsr CL.PrintEOL
dec CL.MaxCnt MaxCnt = 1, don't wait for CR
lda CL.MaxCnt
dec MaxCnt = 1, don't wait for CR
bne .8
lda #$ff

View File

@ -1,49 +1,67 @@
NEW
AUTO 3,1
*--------------------------------------
CP.RUN bcs .1 > A6
CP.RUN cpx #KW.CONLY
bcs .1 >= KW.CONLY
cpx #KW.ECOLON.ID
beq .1 END Compilation
>LDYA J.KEYWORDS,x
clc
jmp EmitJsrYA
jmp CP.Emit.JsrYA
.1 jmp (J.CP-$A4,x)
.1 jmp (J.KEYWORDS,x)
*--------------------------------------
CP.ACODE
CP.DO jsr CP.PushCodePtr for compiling LOOP later
clc
rts
*--------------------------------------
CP.FCODE
CP.LOOP lda #$A9 lda #imm
jsr CP.Emit.Byte
lda #$00
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA
lda #$A9 lda #imm
jsr CP.Emit.Byte
lda #$01
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA pushed n = 1
*--------------------------------------
CP.DO
CP.pLOOP >LDYA J.KEYWORDS.ADD MAX I n -> MAX NEWI
jsr CP.Emit.JsrYA
jsr CP.Emit.LOOP
jsr CP.Emit.JMPBack
jsr CP.Emit.LOOPEND
clc
rts
*--------------------------------------
CP.LOOP
*--------------------------------------
CP.pLOOP
*--------------------------------------
CP.I
CP.I >LDYA J.KEYWORDS DUP
clc
jmp CP.Emit.JsrYA
*--------------------------------------
CP.LEAVE
clc
rts
*--------------------------------------
CP.IF jsr EmitTestTRUE
jsr EmitPendingJMP to put jmp -> ELSE/ENDIF later
CP.IF jsr CP.Emit.TESTTRUE
jsr CP.Emit.JMP0000 to put jmp -> ELSE/ENDIF later
clc
rts
*--------------------------------------
CP.ELSE jsr CP.PopPtr1 get previous JMP -> ptr1
jsr EmitPendingJMP to put jmp -> ENDIF later
jsr CP.Emit.JMP0000 to put jmp -> ENDIF later
jsr CP.UpdatePtr1
clc
rts
*--------------------------------------
CP.ENDIF jsr CP.PopPtr1
jsr CP.UpdatePtr1
clc
@ -54,25 +72,21 @@ CP.BEGIN jsr CP.PushCodePtr
clc
rts
*--------------------------------------
CP.UNTIL jsr EmitTestFALSE
jsr CP.EmitJMPBack
jsr CP.EmitPop2
CP.UNTIL jsr CP.Emit.TESTFALSE
jsr CP.Emit.JMPBack
jsr CP.Emit.RPDROP2
clc
rts
*--------------------------------------
CP.REPEAT jsr CP.EmitJMPBack
CP.REPEAT jsr CP.Emit.JMPBack
clc
rts
*--------------------------------------
CP.WHILE jsr EmitTestTRUE
jsr CP.EmitJMPBack
jsr CP.EmitPop2
CP.WHILE jsr CP.Emit.TESTTRUE
jsr CP.Emit.JMPBack
jsr CP.Emit.RPDROP2
clc
rts
@ -90,26 +104,6 @@ CP.PushCodePtr ldy RP
sty RP
rts
*--------------------------------------
CP.EmitJMPBack lda #$4C JMP
jsr EmitByte
ldy RP
iny
lda (pData),y
jsr EmitByte
iny
lda (pData),y
jmp EmitByte
*--------------------------------------
CP.EmitPop2 ldy RP
iny
iny
sty RP
rts
*--------------------------------------
CP.PopPtr1 ldy RP
iny
lda (pData),y
@ -131,76 +125,116 @@ CP.UpdatePtr1 lda ZPCodePtr
sta (ZPPtr1),y
rts
*--------------------------------------
EmitPendingJMP lda #$4C JMP
jsr EmitByte
CP.Emit.JMP0000 lda #$4C JMP
jsr CP.Emit.Byte
jsr CP.PushCodePtr
lda #0
jsr EmitByte
jsr EmitByte
jsr CP.Emit.Byte
jsr CP.Emit.Byte
rts
*--------------------------------------
EmitTestTRUE ldx #$10 BPL
bra EmitTest
CP.Emit.JMPBack lda #$4C JMP
jsr CP.Emit.Byte
ldy RP
iny
lda (pData),y
jsr CP.Emit.Byte
EmitTestFALSE ldx #$30 BMI
iny
lda (pData),y
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.RPDROP2 ldx #CODE.RPDROP2.L
ldy #0
EmitTest jsr EmitPullA
jsr EmitPullA
.1 lda CODE.RPDROP2,y
jsr CP.Emit.Byte
iny
dex
bne .1
lda #$AA TAX
jsr EmitByte
txa
jsr EmitByte
lda #3 skip JMP abs
jsr EmitByte
clc
rts
*--------------------------------------
EmitPullA lda #$B2 lda (zp)
jsr EmitByte
CP.Emit.TESTTRUE
ldx #CODE.TESTTRUE.L
ldy #0
lda #pStack
jsr EmitByte
lda #$E6 inc zp
jsr EmitByte
lda #pStack
bra EmitByte
.1 lda CODE.TESTTRUE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
EmitPushA pha
lda #$A9 LDA imm
jsr EmitByte
CP.Emit.TESTFALSE
ldx #CODE.TESTFALSE.L
ldy #0
pla
jsr EmitByte
lda #$C6 DEC zp
jsr EmitByte
lda #pStack
jsr EmitByte
lda #$92 STA (zp)
jsr EmitByte
lda #pStack
bra EmitByte
.1 lda CODE.TESTFALSE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
EmitJsrYA pha
CP.Emit.PULLA ldx #CODE.PULLA.L
ldy #0
.1 lda CODE.PULLA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PUSHA ldx #CODE.PUSHA.L
ldy #0
.1 lda CODE.PUSHA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOP ldx #CODE.LOOP.L
ldy #0
.1 lda CODE.LOOP,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOPEND ldx #CODE.LOOPEND.L
ldy #0
.1 lda CODE.LOOPEND,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.JsrYA pha
lda #$20
jsr EmitByte
jsr CP.Emit.Byte
tya
jsr EmitByte
jsr CP.Emit.Byte
pla
*--------------------------------------
EmitByte sta (ZPCodePtr)
CP.Emit.Byte sta (ZPCodePtr)
inc ZPCodePtr
bne .8
inc ZPCodePtr+1

View File

@ -43,6 +43,7 @@ KW.Lookup >LDYA L.KEYWORDS
jsr IncPtr1
.6 inx
inx
lda (ZPPtr1) Array Ending 0, lookup failed
bne .1
@ -55,21 +56,27 @@ KW.Lookup >LDYA L.KEYWORDS
jmp IsSpaceOrCR CS=end of valid chars
*--------------------------------------
KW.mDUP lda (pStack)
ldy #1
ora (pStack),y
bne KW.DUP
clc
rts
*--------------------------------------
KW.DUP lda pStack
beq .9
cmp #$FF
beq .9
bcs .9
cmp #1
cmp #2
bcc .99
lda (pStack)
tax
ldy #1
lda (pStack),y
>PUSHA
txa
lda (pStack),y
>PUSHA
clc
rts
@ -88,6 +95,7 @@ KW.DROP lda pStack
inc pStack
beq .9
inc pStack
clc
rts
@ -121,29 +129,65 @@ KW.SWAP ldy #3
iny #3
txa
sta (pStack),y
clc
rts
*--------------------------------------
KW.OVER lda pStack
sec
sbc #2
bcc .9
KW.OVER jsr CheckStackPop4
bcs .9
cmp #2
bcc .99
ldy #3
lda (pStack),y
>PUSHA
lda (pStack),y
>PUSHA
clc
rts
.9 lda #E.STKOVERFLOW
.99 lda #E.STKOVERFLOW
sec
.9 rts
*--------------------------------------
KW.ROT lda pStack
beq .9
cmp #$FB
bcs .9
ldy #5
lda (pStack),y n1 HI
pha
dey
lda (pStack),y n1 LO
pha
.1 dey
lda (pStack),y
iny
iny
sta (pStack),y
dey
dey
bne .1
iny
pla
sta (pStack)
pla
sta (pStack),y
clc
rts
*--------------------------------------
KW.ROT
*--------------------------------------
KW.mDUP
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
KW.gR
*--------------------------------------
@ -535,7 +579,7 @@ KW.LWR jsr CheckStackPop4
inc pStack
lda (pStack),y
sbc (pStack),y
sbc (pStack)
inc pStack
ror
@ -556,7 +600,7 @@ KW.GTR jsr CheckStackPop4
inc pStack
lda (pStack),y
sbc (pStack),y
sbc (pStack)
inc pStack
lda #0
@ -852,11 +896,54 @@ KW.HERE >PUSHW ZPDataPtr
clc
rts
*--------------------------------------
KW.PAD >PUSHW ZPOutputPtr
KW.PAD >PUSHW ZPOutputBufPtr
clc
rts
KW.ALLOT.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
KW.ALLOT lda #SYM.T.VAR
sta ZPType
lda pStack
beq KW.ALLOT.9
cmp #$FF
bcs KW.ALLOT.9
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
>STYA ZPKeyID
txa
jsr NextKW
>LDYA ZPDataPtr
>STYA ZPAddrPtr
>PULLA
clc
adc ZPDataPtr
sta ZPDataPtr
>PULLA
adc ZPDataPtr+1
sta ZPDataPtr+1
>PUSHB.G hSList
>PUSHW ZPKeyID
>PUSHWI ZPType
>PUSHWI 4
>SYSCALL SListAddData
.9 rts
*--------------------------------------
KW.ALLOT
KW.nCOMPILE
KW.QUOTE
KW.FORGET
@ -869,9 +956,53 @@ KW.ASSEMBLER
sec
rts
*--------------------------------------
KW.VLIST
clc
rts
KW.VLIST bit bCompile
bpl .10
.8 clc
.9 rts
.10 stz ZPPtr2
stz ZPPtr2+1
.1 >LDYA ZPPtr2
>STYA ZPPtr1
>PUSHB.G hSList
>PUSHW ZPPtr1
>PUSHW ZPOutputBufPtr
>SYSCALL SListGetByID
bcs .8
>STYA ZPPtr2 Save Next ID
>PUSHB.G hSList
>PUSHW ZPPtr1 KeyID
>PUSHW ZPType
>PUSHWI 4
>PUSHWZ from Start
>SYSCALL SListGetData
bcs .9
>PUSHW L.MSG.DUMP2
>PUSHW ZPOutputBufPtr
ldx #4
bit ZPType
bmi .2
dex
dex
bvs .2
dex
dex
.2 >PUSHW L.MSG.TYPES,x
>PUSHW ZPAddrPtr
>PUSHBI 6
>SYSCALL PrintF
jmp .1
KW.VC.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
KW.VARIABLE lda #SYM.T.VAR
bra KM.VC
@ -881,14 +1012,12 @@ KW.CONSTANT lda #SYM.T.CONST
KM.VC sta ZPType
lda pStack
cmp #$FE
bcs .10
beq KW.VC.9
cmp #$FF
bcs KW.VC.9
lda #E.STACKERROR
sec
rts
.10 >PUSHB.G hSList
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
@ -972,7 +1101,7 @@ KW.ECOLON bit bCompile
bpl KW.COLON.SYN
lda #$60
jsr EmitByte
jsr CP.Emit.Byte
stz bCompile
@ -987,152 +1116,6 @@ KW.FCODE
sec
rts
*--------------------------------------
KW.DO tsx
lda $101,x
clc
adc #0
pha
lda $102,x
adc #0
ldy RP
sta (pData),y
dey
pla
sta (pData),y
dey
>PULLA start
tax
>PULLA
sta (pData),y
dey
txa
sta (pData),y
dey
>PULLA end+1
tax
>PULLA
sta (pData),y
dey
txa
sta (pData),y
dey
sty RP
clc
rts
*--------------------------------------
KW.LOOP lda #1
ldx #0
KW.LOOPax ldy RP
iny end+1
iny
iny start
clc
adc (pData),y
sta (pData),y
pha
iny
txa
adc (pData),y
sta (pData),y
tax
pla
ldy RP
iny end+1
cmp (pData),y
txa
iny
sbc (pData),y
bcs .8
lda RP
clc
adc #5
tay
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1
pla
pla
jmp (ZPPtr1)
.8 lda RP
clc
adc #6
sta RP
* clc
rts
*--------------------------------------
PW.pLOOP >PULLA
tax
>PULLA
bra KW.LOOPax
*--------------------------------------
KW.I ldy RP
iny end+1
iny
iny start
lda (pData),y
tax
iny
lda (pData),y
>PUSHA
txa
>PUSHA
clc
rts
*--------------------------------------
KW.LEAVE
*--------------------------------------
KW.IF
*--------------------------------------
KW.ELSE
*--------------------------------------
KW.ENDIF
*--------------------------------------
KW.BEGIN
*--------------------------------------
KW.UNTIL
*--------------------------------------
KW.REPEAT
*--------------------------------------
KW.WHILE lda #E.SYN
sec
rts
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s.kw
LOAD usr/src/bin/forth.s

View File

@ -25,8 +25,8 @@ SYM.T.CODE .EQ 128
ZS.START
ZPCodePtr .BS 2
ZPDataPtr .BS 2
ZPInputPtr .BS 2
ZPOutputPtr .BS 2
ZPInputBufPtr .BS 2
ZPOutputBufPtr .BS 2
ZPKeyID .BS 2
ZPType .BS 1
@ -81,6 +81,10 @@ 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
J.ESC .DA CL.BS left arrow
@ -93,13 +97,13 @@ L.KEYWORDS .DA KEYWORDS
J.KEYWORDS .DA KW.DUP
.DA KW.DROP
.DA KW.SWAP
.DA KW.OVER
J.KEYWORDS.OVER .DA KW.OVER
.DA KW.ROT
.DA KW.mDUP
.DA KW.gR
.DA KW.Rg
.DA KW.R
.DA KW.Add
J.KEYWORDS.ADD .DA KW.Add
.DA KW.DAdd
.DA KW.Sub
.DA KW.Mul
@ -117,7 +121,7 @@ J.KEYWORDS .DA KW.DUP
.DA KW.AND
.DA KW.OR
.DA KW.XOR
.DA KW.LWR
J.KEYWORDS.LWR .DA KW.LWR
.DA KW.GTR
.DA KW.EQ
.DA KW.NEGATIVE
@ -172,26 +176,15 @@ J.KEYWORDS .DA KW.DUP
.DA KW.VLIST
.DA KW.VARIABLE
.DA KW.CONSTANT
.DA KW.BCOLON
.DA KW.ECOLON A6
*--------------------------------------
.DA KW.BCOLON
KW.ECOLON.ID .EQ *-J.KEYWORDS
.DA KW.ECOLON
.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
*--------------------------------------
J.CP .DA CP.ACODE
.DA CP.FCODE
KW.CONLY .EQ *-J.KEYWORDS
*--------------------------------------
.DA CP.DO
.DA CP.LOOP
.DA CP.pLOOP
@ -241,7 +234,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
>SYSCALL GetMem
bcs .9
>STYA.G InputBuf
>STYA ZPInputBufPtr
txa
>STA.G hInputBuf
@ -249,7 +242,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
>SYSCALL GetMem
bcs .9
>STYA.G OutputBuf
>STYA ZPOutputBufPtr
txa
>STA.G hOutputBuf
@ -406,7 +399,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
.1 jsr KW.Lookup
bcs .2
jsr .7
bcc CS.RUN.EXEC
@ -430,7 +423,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
rts
.40 >LDYA ZPAddrPtr
jsr EmitJsrYA
jsr CP.Emit.JsrYA
bra CS.RUN.EXEC
.5 jsr CS.RUN.GetNum
@ -441,27 +434,23 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
.8 clc
.9 rts
.7 txa
asl
tax
.7 bit bCompile
bmi .71
cpx #$A6 ; 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
cpx #KW.CONLY
bcc .70
lda #E.SYN
sec
rts
.70 jmp (J.KEYWORDS,x) INTERPRET
.71 jmp CP.RUN COMPILE
.80
* >DEBUG
jmp (ZPAddrPtr)
*--------------------------------------
CS.RUN.ARGS inc ArgIndex
@ -551,6 +540,9 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
>SYSCALL StrToL
bcs .9
bit bCompile
bmi .1
ldy #2
lda (pStack)
sta (pStack),y
@ -561,16 +553,26 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
sta (pStack),y
inc pStack
bit bCompile
bpl .9
.1 >PULLYA
jsr EmitPushA
tya
jmp EmitPushA
* 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
@ -749,9 +751,10 @@ IsSpaceOrCR cmp #C.SPACE CS=TRUE
.8 rts
*--------------------------------------
CheckStackPop4 lda pStack
sec
sbc #4
bcc .9
beq .9
cmp #$FD
bcs .9
clc
rts
@ -766,7 +769,7 @@ CheckStackPop4 lda pStack
*--------------------------------------
CS.END
*--------------------------------------
MSG.GREETINGS .AZ "\r\nA2osX-FORTH %d.%d (figFORTH)\r\n"
MSG.GREETINGS .AZ "\e[?7h\r\nA2osX-FORTH %d.%d (figFORTH)\r\n"
MSG.USAGE .AS "Usage : FORTH <option> file\r\n"
.AS " -D : Debug Mode\r\n"
.AS " -T : Trace On"
@ -776,6 +779,10 @@ 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 "
*--------------------------------------
@ -889,6 +896,48 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
.AT "WHILE" ( f - ) Exit loop immediately if f is false.
*--------------------------------------
.DA #0
*--------------------------------------
CODE.RPDROP2 inc RP
inc RP
CODE.RPDROP2.L .EQ *-CODE.RPDROP2
*--------------------------------------
CODE.TESTTRUE >PULLA
>PULLA
tax
.1 bpl .1+5
CODE.TESTTRUE.L .EQ *-CODE.TESTTRUE
*--------------------------------------
CODE.TESTFALSE >PULLA
>PULLA
tax
.1 bmi .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.LOOP ldy #2
lda (pStack),y
cmp (pStack)
inc pStack
lda (pStack),y
sbc (pStack)
dec pStack
.1 bcc .1+5
CODE.LOOP.L .EQ *-CODE.LOOP
*--------------------------------------
CODE.LOOPEND lda pStack POP 4 bytes
clc
adc #4
sta pStack
clc
CODE.LOOPEND.L .EQ *-CODE.LOOPEND
*--------------------------------------
.DUMMY
.OR 0
@ -905,10 +954,7 @@ hDataBuf .BS 1
DataBuf .BS 2
hInputBuf .BS 1
InputBuf .BS 2
hOutputBuf .BS 1
OutputBuf .BS 2
hCLBuf .BS 1
hFile .BS 1

View File

@ -131,19 +131,23 @@ CS.RUN.FILE >LDYAI FILEBUF.SIZE
sta hMD5Ctx
.1 >PUSHWI FILEBUF.SIZE Bytes To Read
.1 >SLEEP
>PUSHWI FILEBUF.SIZE Bytes To Read
>PUSHW ZPDataBufPtr Dst Ptr
lda hFile
>SYSCALL FRead
bcc .2
eor #MLI.E.EOF
cmp #MLI.E.EOF
beq .8
.9 rts
.2 >STYA ZPDataLen
>SLEEP
>PUSHB hMD5Ctx
>PUSHW ZPDataBufPtr
>PUSHW ZPDataLen

View File

@ -1,7 +1,7 @@
NEW
AUTO 3,1
*--------------------------------------
IO.D2.SeekTimeR .EQ 130 LIBBLKDEV Recalibration
IO.D2.SeekTimeR .EQ 140 LIBBLKDEV Recalibration
IO.D2.SeekTimeF .EQ 65 LIBBLKDEV Track Formatter
IO.D2.SeekTimeB .EQ 65 LIBBLKDEV Boot Block
IO.D2.SeekTimeP .EQ 65 ProDOS.FX initial

View File

@ -132,12 +132,13 @@ D2MoveHead.SEI ldx Slotn0
.4 tay
lda IO.D2.Ph0On,x
nop
nop
phx
ldx Slotn0
bit IO.D2.RData,x
lda IO.D2.Ph0On,y
nop
nop
bit IO.D2.RData,x
plx
lda #IO.D2.SeekTimeF
jsr D2.Wait100usecA
@ -146,16 +147,14 @@ D2MoveHead.SEI ldx Slotn0
.7 jsr D2.Wait25600usec
.8 bit IO.D2.Ph0Off,x
nop
nop
ldx IO.D2.Ph0Off,y
nop
nop
.8 pha
bit IO.D2.Ph0Off,x
ldx Slotn0
bit IO.D2.RData,x
lda IO.D2.Ph0Off,y
bit IO.D2.RData,x
pla
rts
*--------------------------------------
D2.Wait25600usec

View File

@ -801,12 +801,13 @@ XRW.Seek ldx XRW.UnitIndex
.4 tay
lda IO.D2.Ph0On,x
nop
nop
phx
ldx A2L
bit IO.D2.RData,x
lda IO.D2.Ph0On,y
nop
nop
bit IO.D2.RData,x
plx
jsr XRW.WaitSeekTime
@ -814,16 +815,14 @@ XRW.Seek ldx XRW.UnitIndex
.7 jsr XRW.Wait25600usec
.8 bit IO.D2.Ph0Off,x
nop
nop
ldx IO.D2.Ph0Off,y
nop
nop
.8 pha
bit IO.D2.Ph0Off,x
ldx A2L
bit IO.D2.RData,x
lda IO.D2.Ph0Off,y
bit IO.D2.RData,x
pla
rts
*--------------------------------------
XRW.Reset ldx A2L