Kernel 0.94

This commit is contained in:
Rémy GIBERT 2020-11-23 23:05:27 +01:00
parent 67878e93ce
commit f8d5dc8deb
11 changed files with 678 additions and 355 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -193,12 +193,13 @@ CS.RUN.Format jsr CS.RUN.GetDevStatus
bcs .9
jsr CS.RUN.WriteCat
.99 bcs .9
>LDYA L.MSG.OK
>SYSCALL PutS
bcs .9
>DEBUG
.8 >PUSHB DSSS0000
>PUSHW pData
>SYSCALL Online
@ -381,18 +382,19 @@ CS.RUN.LL.DISKII
sec
rts
.8 >PUSHW L.MSG.CRLF
.8 ldx #0
jsr CS.RUN.SeekToX
>PUSHW L.MSG.CRLF
>PUSHBI 0
>SYSCALL PrintF
bcs .9
ldx #0
jsr CS.RUN.SeekToX
bit bVerify
bpl .80
jsr CS.RUN.LL.DISKII.V
>DEBUG
bcs .9
.80 jmp CS.RUN.MotorOff
@ -400,9 +402,11 @@ CS.RUN.LL.DISKII
CS.RUN.LL.DISKII.V
lda hTrackBuf
bne .10
>LDYAI 512
>SYSCALL GetMem
bcs .99
stx hTrackBuf
bra .11

View File

@ -58,9 +58,13 @@ KW.Lookup >LDYA L.KEYWORDS
rts
*--------------------------------------
KW.DUP lda pStack
sec
sbc #2
bcc .9
beq .9
cmp #$FF
beq .9
cmp #1
bcc .99
lda (pStack)
tax
@ -72,9 +76,13 @@ KW.DUP lda pStack
clc
rts
.9 lda #E.STKOVERFLOW
.9 lda #E.STACKERROR
sec
rts
.99 lda #E.STKOVERFLOW
sec
rts
*--------------------------------------
KW.DROP lda pStack
beq .9
@ -187,7 +195,40 @@ KW.Sub jsr CheckStackPop4
clc
.9 rts
*--------------------------------------
KW.Mul
KW.Mul jsr CheckStackPop4
bcs .9
>PULLW ZPPtr1
>PULLW ZPPtr2
stz ZPPtr3
stz ZPPtr3+1
ldx #16
.1 lsr ZPPtr2+1
ror ZPPtr2
bcc .2
clc
lda ZPPtr1
adc ZPPtr3
sta ZPPtr3
lda ZPPtr1+1
adc ZPPtr3+1
sta ZPPtr3+1
.2 asl ZPPtr1
rol ZPPtr1+1
dex
bne .1
>PUSHW ZPPtr3
clc
.9 rts
*--------------------------------------
KW.Div
*--------------------------------------
@ -197,7 +238,9 @@ KW.DivMod
*--------------------------------------
KW.MulDivMod
*--------------------------------------
KW.MulDiv
KW.MulDiv
clc
rts
*--------------------------------------
KW.MAX jsr CheckStackPop4
bcs .9
@ -355,11 +398,11 @@ KW.LWR jsr CheckStackPop4
sbc (pStack),y
inc pStack
inc pStack
rol
ror
lda #0
sta (pStack)
ldy #1
sta (pStack),y
clc
.9 rts
@ -376,11 +419,12 @@ KW.GTR jsr CheckStackPop4
sbc (pStack),y
inc pStack
inc pStack
rol
lda #0
ror
eor #$80
sta (pStack)
ldy #1
sta (pStack),y
clc
@ -400,8 +444,6 @@ KW.EQ jsr CheckStackPop4
sbc (pStack),y
inc pStack
inc pStack
bcc .1
txa
@ -410,38 +452,41 @@ KW.EQ jsr CheckStackPop4
sec
.HS 90 BCC
.1 clc
lda #0
ror
sta (pStack)
ldy #1
sta (pStack),y
clc
.9 rts
*--------------------------------------
KW.NEGATIVE >PULLA
>PULLA
bpl .9
KW.NEGATIVE ldy #1
lda (pStack),y
sec
.HS 90 BCC
.9 clc
asl
lda #0
ror
sta (pStack)
sta (pStack),y
clc
rts
*--------------------------------------
KW.ZERO >PULLA
tax
>PULLA
bne .9
txa
KW.ZERO clc
ldy #1
lda (pStack),y
ora (pStack)
bne .9
sec
.HS 90 BCC
.9 clc
.9 lda #0
ror
sta (pStack)
sta (pStack),y
clc
rts
@ -549,7 +594,7 @@ KW.KEY >SYSCALL GetChar
>PUSHA
.9 rts
.9 rts
*--------------------------------------
KW.EMIT >PULLA
>SYSCALL PutChar
@ -658,11 +703,11 @@ KW.FILL2 tax
clc
rts
*--------------------------------------
KW.HERE >PUSHW ZPUsrBufPtr
KW.HERE >PUSHW ZPDataPtr
clc
rts
*--------------------------------------
KW.PAD >PUSHW ZPPadBuf
KW.PAD >PUSHW ZPOutputPtr
clc
rts
*--------------------------------------
@ -679,17 +724,10 @@ KW.VLIST
clc
rts
*--------------------------------------
KW.BCOLON
KW.BCOLON bit bCompile
bmi KW.COLON.SYN
clc
rts
*--------------------------------------
KW.ECOLON
clc
rts
*--------------------------------------
KW.VARIABLE >PUSHB.G hSList
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
@ -700,54 +738,243 @@ KW.VARIABLE >PUSHB.G hSList
txa
jsr NextKW
>LDYA L.PUSHADDR
>STYA ZPUsrCodePtr
lda #SYM.T.CODE
sta ZPType
>LDYA ZPCodePtr
>STYA ZPAddrPtr
>PUSHB.G hSList
>PUSHW ZPKeyID
>PUSHWI ZPUsrBufPtr
>PUSHWI 4 BufPtr+CodePtr
>PUSHWI ZPType
>PUSHWI 4
>SYSCALL SListAddData
bcs .9
sec
ror bCompile
clc
.9 rts
KW.COLON.SYN lda #E.SYN
sec
rts
*--------------------------------------
KW.ECOLON bit bCompile
bpl KW.COLON.SYN
lda #$60
jsr EmitByte
stz bCompile
clc
rts
*--------------------------------------
KW.VARIABLE lda pStack
cmp #$FE
bcc .99
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
>STYA ZPKeyID
txa
jsr NextKW
lda #SYM.T.VAR
sta ZPType
>LDYA ZPDataPtr
>STYA ZPAddrPtr
>PUSHB.G hSList
>PUSHW ZPKeyID
>PUSHWI ZPType
>PUSHWI 4
>SYSCALL SListAddData
bcs .9
>PULLA
sta (ZPUsrBufPtr)
sta (ZPDataPtr)
>PULLA
ldy #1
sta (ZPUsrBufPtr),y
sta (ZPDataPtr),y
lda ZPUsrBufPtr
lda ZPDataPtr
clc
adc #2
sta ZPUsrBufPtr
sta ZPDataPtr
bcc .9
inc ZPUsrBufPtr+1
inc ZPDataPtr+1
clc
.9 rts
.99 lda #E.STACKERROR
sec
rts
*--------------------------------------
KW.CONSTANT
*--------------------------------------
KW.ACODE
*--------------------------------------
KW.FCODE
clc
rts
*--------------------------------------
KW.DO
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
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
PW.pLOOP >PULLA
tax
>PULLA
bra KW.LOOPax
*--------------------------------------
KW.I
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
clc
rts
*--------------------------------------
KW.IF
KW.IF
clc
rts
*--------------------------------------
KW.ELSE
KW.ELSE
clc
rts
*--------------------------------------
KW.ENDIF
clc
rts
*--------------------------------------
KW.BEGIN
*--------------------------------------

View File

@ -10,39 +10,45 @@ NEW
.INB inc/mli.i
.INB inc/mli.e.i
*--------------------------------------
USERSPACE.SIZE .EQ 4096
SCRATCH.SIZE .EQ 256
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
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
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
bCompile .EQ *
ArgIndex .BS 1
ArgIndex .EQ *
bCompile .BS 1
RP .BS 1
ZS.END .ED
*--------------------------------------
@ -81,7 +87,6 @@ J.ESC .DA CL.BS left arrow
* .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
@ -196,39 +201,58 @@ CS.RUN >PUSHW L.MSG.GREETINGS
jsr CS.RUN.ARGS
bcs CS.INIT.RTS
>LDYAI 256
>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
>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
bcs .9
>STA.G hSList
stz bCompile
lda #127
sta RP
.1 >SLEEP
CS.RUN.LOOP >SLEEP
>LDA.G bDebug
bpl .2
@ -238,11 +262,11 @@ CS.RUN >PUSHW L.MSG.GREETINGS
.2 >LDA.G bTrace
bpl .3
>LDYA ZPFileBufPtr
>LDYA ZPCLBuf
jsr PrintTraceMsg
.3 jsr CS.FORTH.Run
bcc .1
bcc CS.RUN.LOOP
cmp #MLI.E.EOF
beq .8
@ -260,7 +284,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
>SYSCALL GetErrorMessage
>LDYA ZPCLBuf
>SYSCALL PutS
bra .1
bra CS.RUN.LOOP
* jsr PrintErrMsg
@ -301,14 +325,14 @@ CS.RUN.ARGS inc ArgIndex
sta (pData),y
bra CS.RUN.ARGS
.4 >LDA.G hFileBuf
.4 >LDA.G hFile
bne .90
>LDYA ZPPtr1
jsr CS.RUN.LoadFile
jsr CS.RUN.FOpen
bcs .9
>STA.G hFileBuf
>STA.G hFile
bra CS.RUN.ARGS
.8 clc
@ -322,10 +346,10 @@ CS.RUN.ARGS inc ArgIndex
sec QUIT Process
rts
*--------------------------------------
CS.FORTH.Run >LDA.G hFileBuf
bne CS.FORTH.Run.File
CS.FORTH.Run jsr CL.Reset
jsr CL.Reset
>LDA.G hFile
bne CS.FORTH.Run.File
lda #80
sta CL.MaxCnt
@ -351,49 +375,32 @@ CS.FORTH.Run >LDA.G hFileBuf
jmp CS.RUN.EXEC
.9 rts
*--------------------------------------
CS.FORTH.Run.File
lda (ZPFileBufPtr)
>PUSHWI 256
>PUSHW ZPCLBuf
>LDA.G hFile
>SYSCALL fgets
bcs .9
lda (ZPCLBuf)
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
bne .1
jmp CS.RUN.EXEC
.8 lda #MLI.E.EOF
ldy #1
lda (ZPCLBuf),y
beq .1
sec
rts
cmp #'!'
beq .8
.1 jmp CS.RUN.EXEC
.8 clc
.9 rts
*--------------------------------------
CS.RUN.EXEC lda (ZPCLBufPtr)
beq .8
@ -409,28 +416,106 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
rts
.2 >PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListLookup
.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 ZPAddrPtr
>PUSHWI ZPType
>PUSHWI 4 4 bytes
>PUSHWZ From Start
>SYSCALL SListGetData
bcs .9
jmp (ZPCodePtr)
.8 clc
.9 rts
.5 >PUSHW ZPCLBufPtr
*--------------------------------------
CS.RUN.GetNum >PUSHW ZPCLBufPtr
>PUSHWI ZPCLBufPtr
>PUSHBI 10
>SYSCALL StrToL
@ -447,31 +532,16 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
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
bit bCompile
bmi .1
phx
txa
>SYSCALL GetMemPtr
>STYA ZPFileBuf
>STYA ZPFileBufPtr
pla
* clc
rts
.1 >PULLYA
jsr EmitPushYA
clc
.9 rts
*--------------------------------------
CS.DOEVENT sec
@ -483,10 +553,21 @@ CS.QUIT >LDA.G hSList
>PUSHA
>SYSCALL SListFree
.1 ldy #hFileBuf
.1 >LDA.G hFile
beq .2
>SYSCALL FClose
.2 ldy #hCodeBuf
jsr .7
ldy #hUsrBuf
ldy #hDataBuf
jsr .7
ldy #hInputBuf
jsr .7
ldy #hOutputBuf
jsr .7
ldy #hCLBuf
@ -504,63 +585,10 @@ PrintPrompt >PUSHW L.MSG.PROMPT
>SYSCALL PrintF
rts
*--------------------------------------
PrintErrMsg >LDYA ZPFileBuf
PrintErrMsg >LDYA.G ZPCLBuf
>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
clc
rts
*--------------------------------------
@ -670,12 +698,6 @@ IsSpaceOrCR cmp #C.SPACE
IsEndKW.8 clc
rts
*--------------------------------------
PUSHADDR lda ZPAddrPtr+1
>PUSHA
lda ZPAddrPtr
>PUSHA
rts
*--------------------------------------
CheckStackPop4 lda pStack
sec
sbc #4
@ -687,8 +709,59 @@ CheckStackPop4 lda pStack
.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
@ -798,9 +871,7 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
.AT ":" ( - ) Begin a colon definition.
.AT ";" ( - ) End of a colon definition.
.AT "VARIABLE" ( n - ) Create a variable with initial value n.
* ( - addr ) Return address when executed.
.AT "CONSTANT" ( n - ) Create a constant with value n.
* ( - n ) Return the value n when executed.
.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.
@ -822,15 +893,26 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
*--------------------------------------
.DUMMY
.OR 0
DS.START
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
InputBuf .BS 2
hOutputBuf .BS 1
OutputBuf .BS 2
hCLBuf .BS 1
hPadBuf .BS 1
hUsrBuf .BS 1
UsrBuf .BS 2
hFileBuf .BS 1
hFile .BS 1
hSList .BS 1
DS.END .ED

View File

@ -2,9 +2,9 @@ NEW
AUTO 3,1
*--------------------------------------
IO.D2.SeekTimeR .EQ 140 LIBBLKDEV Recalibration
IO.D2.SeekTimeF .EQ 68 LIBBLKDEV Track Formatter
IO.D2.SeekTimeB .EQ 68 LIBBLKDEV Boot Block
IO.D2.SeekTimeP .EQ 68 ProDOS.FX initial
IO.D2.SeekTimeF .EQ 70 LIBBLKDEV Track Formatter
IO.D2.SeekTimeB .EQ 70 LIBBLKDEV Boot Block
IO.D2.SeekTimeP .EQ 70 ProDOS.FX initial
IO.D2.SeekTimeI .EQ 10 ProDOS.FX increment -> until > 128
*--------------------------------------
IO.D2.Ph0Off .EQ $C080

View File

@ -88,12 +88,10 @@ D2MoveHead >PULLB MoveTo
sta .7+1
stz .6+1
lda IO.D2.Ph0On,x
bit IO.D2.Ph0On,x
nop
nop
* lda #IO.D2.SeekTimeF
* jsr D2.Wait100usecA
pla
.1 bcc .2
@ -134,9 +132,10 @@ D2MoveHead >PULLB MoveTo
sta .7+1
.5 sta $C000
.5 bit $C000
nop
nop
lda #IO.D2.SeekTimeF
jsr D2.Wait100usecA
@ -146,10 +145,11 @@ D2MoveHead >PULLB MoveTo
jsr D2.Wait25600usec
.6 sta $C000
.6 bit $C000
nop
nop
.7 sta $C000
.7 bit $C000
nop
nop
@ -162,9 +162,10 @@ D2.Wait25600usec
lda #0
D2.Wait100usecA
.1 ldx #20 (2)
.1 ldx #11 (2)
.2 dex (2)
.2 bit $C0EC
dex (2)
bne .2 (3)
dec (2)

View File

@ -380,11 +380,15 @@ L596F ldy #$FF index to last byte of data to write.
* if no error, acc=uncertain, x=unchanged, y=0, carry clear.
*--------------------------------------
.LIST ON
XRW.Write lda IO.D2.ReadProt,x PREWRITE MODE
XRW.Write sec
.LIST OFF
lda IO.D2.ReadProt,x PREWRITE MODE
lda IO.D2.ReadMode,x
lda nbuf2
bpl .1
jmp XRW.ReadMode
.1 lda nbuf2
sta pcl
lda #$FF Self Sync Byte
@ -550,9 +554,11 @@ XRW.WaitSeekTime
XRW.Wait25600usec
lda #0
XRW.Wait100usecA
.1 ldx #18 (2)
phx
.1 ldx #10 (2)
.2 dex (2)
.2 bit $C0EC (4)
dex (2)
bne .2 (3)
inc XRW.montimel (6)
@ -563,6 +569,7 @@ XRW.Wait100usecA
.3 dec (2)
bne .1 (3)
plx
rts (6)
*--------------------------------------
* read subroutine (16-sector format)
@ -720,11 +727,9 @@ XRW.Read.RTS rts
* A = target track
*--------------------------------------
XRW.Seek ldx XRW.UnitIndex
cmp XRW.D2Trk-1,x
beq XRW.Read.RTS
pha save target track
jsr XRW.Trk2Qtrk
sta XRW.TargetQTrack
@ -736,86 +741,85 @@ XRW.Seek ldx XRW.UnitIndex
pla
sta XRW.D2Trk-1,x will be current track at the end
lda XRW.CurrentQTrack
ldx A2L
ldy A2L
.1 lda XRW.CurrentQTrack
cmp XRW.TargetQTrack
beq .7
pha
bcs .10
jsr .8
bcs .2
* Current < Target, must move in
inc
.10 and #6
ora A2L
tax
ora #$80
sta .7+1
stz .6+1
lda IO.D2.Ph0On,x
nop
nop
* jsr XRW.WaitSeekTime
pla
.1 bcc .2
.HS B0 BCS
* Current > Target, must move out
dec
.HS 90 BCC
* Current < Target, must move in
.2 inc
.2 dec
sta XRW.CurrentQTrack
and #7
tay
pha
bcs .3
and #6
ora A2L
tax
lda XRW.PhIn,y
pla
bcs .3
* Current < Target, must move in
inc
.HS B0 BCS
* Current > Target, must move out
.3 dec
and #6
ora A2L
bcc .4
* move out : invert 2 phases
.3 lda XRW.PhOut,y
.4 ora A2L
sta .5+1
lsr
bcc .5
asl
ldx .7+1
stx .6+1
sta .7+1
.5 sta $C000 SELF MODIFIED
phx
tax
pla
.4 tay
lda IO.D2.Ph0On,x
nop
nop
lda IO.D2.Ph0On,y
nop
nop
jsr XRW.WaitSeekTime
bra .1
lda XRW.CurrentQTrack
cmp XRW.TargetQTrack
bne .1
.7 jsr XRW.Wait25600usec
jsr XRW.Wait25600usec
.8 bit IO.D2.Ph0Off,x
nop
nop
.6 sta $C000 SELF MODIFIED
ldx IO.D2.Ph0Off,y
nop
nop
.7 sta $C000 SELF MODIFIED
nop
nop
.8 rts
rts
*--------------------------------------
XRW.Reset ldx A2L
@ -948,24 +952,6 @@ XRW.TestWP ldx A2L
rol write protect-->carry-->bit 0=1
lda IO.D2.RData,x keep in read mode
rts
*--------------------------------------
XRW.PhIn .DA #IO.D2.Ph3Off 7->0
.DA #IO.D2.Ph1On 0->1
.DA #IO.D2.Ph0Off 1->2
.DA #IO.D2.Ph2On 2->3
.DA #IO.D2.Ph1Off 3->4
.DA #IO.D2.Ph3On 4->5
.DA #IO.D2.Ph2Off 5->6
.DA #IO.D2.Ph0On 6->7
XRW.PhOut .DA #IO.D2.Ph1Off 1->0
.DA #IO.D2.Ph0on 2->1
.DA #IO.D2.Ph2off 3->2
.DA #IO.D2.Ph1On 4->3
.DA #IO.D2.Ph3Off 5->4
.DA #IO.D2.Ph2On 6->5
.DA #IO.D2.Ph0Off 7->6
.DA #IO.D2.Ph3On 0->7
*--------------------------------------
.LIST ON
XRW.FREE .EQ $D540-*

View File

@ -525,19 +525,16 @@ CPU.Init2c sta CLRIOUDIS
bit IO.IIC.CLRVBLIRQ clear //c IRQ
.3 pha (3)
pla (4)
pha (3)
pla (4)
pha (3)
pla (4)
pha (3)
pla (4)
pha (3)
.3 lda #20
.4 pha (3)
pla (4)
pha (3)
pla (4)
dec
bne .4
iny
cpy #100
bne .5
@ -569,7 +566,6 @@ CPU.InitOk plp
>PUSHA push CPU speed LO
>PUSHBI 2
>SYSCALL2 printf
>DEBUGOA
rts
*--------------------------------------
CPU.Init.Z80 >PUSHWI MSG.Z80
@ -876,6 +872,7 @@ IrqMgrInit >LDYAI MSG.IRQ
>LDYAI MSG.IRQ.POLL
.8 >SYSCALL2 puts
clc
rts
*--------------------------------------
@ -895,7 +892,7 @@ IrqMgrInit.TClock
cmp TClock.SIG,x
bne .3
dey
dex
bpl .2
bra .4
@ -904,6 +901,7 @@ IrqMgrInit.TClock
lda ZPPtr1+1
cmp #$C8
bne .1
sec
rts
@ -921,6 +919,7 @@ IrqMgrInit.TClock
php
sei
lda #$40+$20 Enable interrupt + 64Hz
sta $c080,y
@ -937,6 +936,7 @@ IrqMgrInit.TClock
sta CORE.TickPer10t
sta CORE.Tick10t
dec A2osX.IRQMode
plp
clc
rts
@ -1167,7 +1167,7 @@ Z80Code.Size .EQ *-Z80Code.Start
Mouse.OFS .HS 05070B0CFB
Mouse.SIG .HS 38180120D6
*--------------------------------------
TClock.OFS .HS 01030507
TClock.OFS .HS 00020406
TClock.SIG .HS 08285870
*--------------------------------------
SmartPort.OFS .HS 010305

View File

@ -250,6 +250,29 @@ MATH32.DIVMOD jsr MATH32.TMP32ZERO
rts
*--------------------------------------
*uint32_t lcg_parkmiller(uint32_t *state)
*{
* // Precomputed parameters for Schrage's method
* const uint32_t M = 0x7fffffff;
* const uint32_t A = 48271;
* const uint32_t Q = M / A; // 44488
* const uint32_t R = M % A; // 3399
*
* uint32_t div = *state / Q; // max: M / Q = A = 48,271
* uint32_t rem = *state % Q; // max: Q - 1 = 44,487
*
* int32_t s = rem * A; // max: 44,487 * 48,271 = 2,147,431,977 = 0x7fff3629
* int32_t t = div * R; // max: 48,271 * 3,399 = 164,073,129
* int32_t result = s - t;
*
* if (result < 0)
* result += M;
*
* return *state = result;
*}
*--------------------------------------
* MATH32.RND TODO
*--------------------------------------
MATH32.A2STR10NP ldx #3 3 digit max
ldy #0 Disable Padding
MATH32.A2STR10 jsr MATH32.A2ACC32