A2osX/BASIC.FX/BASIC.S.XF.txt
2022-08-20 16:37:37 +02:00

689 lines
10 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
BSX.HeadSelect asl A = 0/2
ora BSX.Slotn0
tax x=n0/n2
lda IO.D2.Ph0On,x
lda IO.D2.Ph0On+4,x
lda #1
jsr BSX.Wait100usecA
lda IO.D2.Ph0Off,x
lda IO.D2.Ph0Off+4,x
rts
*--------------------------------------
BSX.Recalibrate ldy BSX.Slotn0
lda IO.D2.Ph0On,y
lda #IO.D2.SeekTimeR
jsr BSX.Wait100usecA
lda #160
php
sei
.1 dec
dec
pha
phy
plx
jsr BSX.SeekPhOnY
lda #IO.D2.SeekTimeR
jsr BSX.Wait100usecA
lda IO.D2.Ph0Off,x
lda #IO.D2.SeekTimeR
jsr BSX.Wait100usecA
pla
bne .1
jsr BSX.Wait25600usec
lda IO.D2.Ph0Off,y
plp
jmp BSX.Wait25600usec
*--------------------------------------
BSX.MoveHead sta BSX.TargetQTrack
lda BSX.CurrentQTrack
bit #1
beq .2 we are on 0/4 or 2/4 track
pha
cmp BSX.TargetQTrack we are on 1/4 or 3/4 track
bcc .1 if CC, C < T, must move in
inc CC: C < T, ON next PH
.1 jsr BSX.SeekPhOnY move in : X = Ph(N)
tya
tax
pla
bcs .2 if CS, C > T, must move out
inc move in : Y = Ph(N+1)
.2 jsr BSX.SeekPhOnY move out: Y = Ph(N)
bra .9 Ph ON to go to 0/4 or 2/4, no wait
*--------------------------------------
.3 bcs .4 if CS, C > T, must move out
inc CC: C < T, ON next PH
.HS B0 BCS
.4 dec CS: C > T, ON prev PH
sta BSX.CurrentQTrack
bit #1
bne .5
lda IO.D2.Ph0Off,x we must go to 0/4 or 2/4 : Off Prev Ph
bra .8 go wait....
.5 phy we must go on 1/4 or 3/4
plx Y already ON, -> X for Ph0Off,x
bcs .6 if CS, C > T, must move out
inc CC: C < T, ON next PH
.6 jsr BSX.SeekPhOnY now X and Y on
.8 lda #IO.D2.SeekTimeF
jsr BSX.Wait100usecA ...wait...
.9 lda BSX.CurrentQTrack
cmp BSX.TargetQTrack
bne .3
lsr CS if X,Y on
jsr BSX.Wait25600usec
lda IO.D2.Ph0Off,y
bcc .10
clc
lda IO.D2.Ph0Off,x
.10 rts
*--------------------------------------
BSX.SeekPhOnY and #6
ora BSX.Slotn0
tay
lda IO.D2.Ph0On,y
rts
*--------------------------------------
BSX.Wait25600usec
lda #0
BSX.Wait100usecA
phx
.1 ldx #19 (2)
.2 dex (2)
bne .2 (3)
dec (2)
bne .1 (3)
plx
rts (6)
*--------------------------------------
BSX.FMT.CheckP lda GP.ParamS
asl
asl
asl
asl
asl
pha
lda GP.ParamD
lsr
lsr
pla
ror
sta BS.WBlock.P.NUM unitnum : DSSS0000
stz BS.WBlock.P.BLK
stz GP.ParamV Standard BB
stz GP.ParamT BLK/DiskII flag
lda #1
sta GP.ParamA default Head Count
lda #4
sta GP.ParamL default Cat Block Count
lda GP.FoundBITS+1
bit #CMDBITS1.L
beq .10
lda GP.ParamL+1
bne .9
lda GP.ParamL
bne .11
.9 lda #BS.E.RANGE
sec
rts
*--------------------------------------
.10 lda #4
sta GP.ParamL Cat Block Count
.11 lda GP.ParamS
ora #$C0 make Cn
sta ZPXPtr1+1
stz ZPXPtr1
ldx #3 4 bytes to check
.1 ldy BSX.DiskII.OFS,x
.2 lda (ZPXPtr1),y
eor BSX.DiskII.SIG,x
bne BSX.FMT.CheckBLK
dex
bpl .1
dec GP.ParamT
*--------------------------------------
BSX.FMT.CheckD2 lda GP.FoundBITS+1
bit #CMDBITS1.B
bne .99 not allowed for D2
bit #CMDBITS1.A
beq .10
lda GP.ParamA+1
bne .98
lda GP.ParamA
beq .98
cmp #3
bcs .98
lsr
lsr CS if 2 heads
ror GP.ParamV => V : d0000sss
lda GP.FoundBITS+1
.10 bit #CMDBITS1.E
beq .19
lda GP.ParamE+1
bne .98
bra .20
.19 lda #35
sta GP.ParamE
.20 lda GP.FoundBITS+1
bit #CMDBITS1.F
beq .29
lda GP.ParamF+1
bne .98
lda GP.ParamF
beq .98
cmp #5
bcs .98
tsb GP.ParamV => V : d0000sss
rts
.29 lda #4
sta GP.ParamF Stepping
clc
rts
.98 lda #BS.E.RANGE
.HS 2C BIT ABS
.99 lda #BS.E.INVOPT
sec
rts
*--------------------------------------
BSX.FMT.CheckBLK
lda GP.FoundBITS+1
bit #CMDBITS1.A+CMDBITS1.E+CMDBITS1.F
bne .99 not allowed for BLK dev
bit #CMDBITS1.B
beq .8
lda GP.ParamB+2
bne .98
.8 clc
rts
.98 lda #BS.E.RANGE
.HS 2C BIT ABS
.99 lda #BS.E.INVOPT
sec
rts
*--------------------------------------
BSX.DiskII.OFS .HS 010305FF
BSX.DiskII.SIG .HS 20000300
*--------------------------------------
* GP.ParamS : Slot (1/7)
* GP.ParamD : Drive (1/2)
* GP.ParamA : Head count (1/2)
* GP.ParamE : Track count (0,...)
* GP.ParamF : Stepping (1..4)
* GP.ParamV : VolNum (0..255)
*--------------------------------------
BSX.FMT.D2 lda GP.ParamS
asl
asl
asl
asl
sta BSX.Slotn0
tax
* clc
adc GP.ParamD
tay
lda IO.D2.DrvSel1-1,y
lda IO.D2.DrvOn,x
lda #0
ldy #6
.11 jsr BSX.Wait100usecA
dey
bne .11
jsr BSX.Recalibrate
lda #0
jsr BSX.HeadSelect
lda GP.ParamV
sta X.TRKFMT.VolNum
stz X.TRKFMT.TrkNum
stz BSX.CurrentQTrack
.1 ldx BSX.Slotn0
lda IO.D2.ReadProt,x test for write protected
lda IO.D2.ReadMode,x
asl
lda #BS.E.WPROT
bcs .9
php
sei
jsr X.TRKFMT
plp
lda GP.ParamA head count
dec
beq .2
jsr BSX.HeadSelect
inc X.TRKFMT.TrkNum
php
sei
jsr X.TRKFMT
plp
lda #0
jsr BSX.HeadSelect
.2 dec GP.ParamE track count
beq .8
inc X.TRKFMT.TrkNum
lda BSX.CurrentQTrack
clc
adc GP.ParamF stepping
jsr BSX.MoveHead
bra .1
.8 lda #0
jsr BSX.MoveHead
clc
.9 bit IO.D2.DrvOff,x
rts
*--------------------------------------
BSX.Slotn0 .BS 1
BSX.CurrentQTrack .BS 1
BSX.TargetQTrack .BS 1
*--------------------------------------
BSX.FMT.GetCatBlk
asl
tax
jmp (.1,x)
.1 .DA BSX.GetCatBlk.PRODOS
.DA BSX.GetCatBlk.SOS
.DA BSX.GetCatBlk.FX1
.DA BSX.GetCatBlk.FX2
.DA BSX.GetCatBlk.1ST
.DA BSX.GetCatBlk.NEXT
.DA BSX.GetCatBlk.BM
BSX.GetCatBlk.PRODOS
lda /BB.PRODOS
.HS 2C BIT ABS
BSX.GetCatBlk.SOS
lda /BB.SOS
.HS 2C BIT ABS
BSX.GetCatBlk.FX1
lda /BB.FX2
.HS 2C BIT ABS
BSX.GetCatBlk.FX2
lda /BB.FX2+512
sta ZPXPtr1+1
stz ZPXPtr1
lda BS.WBlock.P.PTR+1
sta ZPXPtr2+1
stz ZPXPtr2
ldy #0
ldx #2
.1 lda (ZPXPtr1),y
sta (ZPXPtr2),y
iny
bne .1
inc ZPXPtr1+1
inc ZPXPtr2+1
dex
bne .1
clc
rts
*--------------------------------------
BSX.GetCatBlk.1ST
jsr BSX.GetCatBlk.Size
jsr BSX.GetCatBlk.CLR
lda BS.WBlock.P.PTR+1
sta ZPXPtr2+1
lda GP.ParamL cat blocks
dec
sta BSX.GetCatBlk.CNT
beq .1
lda #3
sta BSX.GetCatBlk.IDX
ldy #$02 Next Cat Block = 3
sta (ZPXPtr2),y
.1
* lda BS.CMDBUF.LEN
* and #$F0
* bne .9
* lda BS.CMDBUF.LEN
lda #$F7 BLANK+s+d
ldy #$04 storage_type+filelen
sta (ZPXPtr2),y
ldx #0
.2
* lda BS.CMDBUF,x
* jsr BSX.ToUpper
lda BSX.GetCatBlk.BLANK,x
inx
iny
sta (ZPXPtr2),y
* cpx BS.CMDBUF.LEN
cpx #5
bne .2
lda GP.ParamS
ora #$30
iny
sta (ZPXPtr2),y
lda GP.ParamD
ora #$30
iny
sta (ZPXPtr2),y
ldy #$1C+3 date_time
ldx #3
.3 lda MLI.DATETIME,x
sta (ZPXPtr2),y
dey
dex
bpl .3
ldy #$22 access
lda #$C3
sta (ZPXPtr2),y
iny entry_length
lda #$27
sta (ZPXPtr2),y
iny entries_per_block
lda #$0D
sta (ZPXPtr2),y
ldy #$27 bit_map_pointer
lda GP.ParamL
inc
inc
sta (ZPXPtr2),y
ldy #$29 total_blocks
lda GP.ParamB
sta (ZPXPtr2),y
eor #$ff
sta BSX.GetCatBlk.nCnt
iny
lda GP.ParamB+1
sta (ZPXPtr2),y
eor #$ff
sta BSX.GetCatBlk.nCnt+1
clc
rts
.9 lda #BS.E.INVOPT
sec
rts
*--------------------------------------
BSX.GetCatBlk.NEXT
sec
dec BSX.GetCatBlk.CNT
bmi .9
jsr BSX.GetCatBlk.CLR
lda BSX.GetCatBlk.IDX
dec
sta (ZPXPtr2) previous block#
ldy BSX.GetCatBlk.CNT
beq .1
inc
inc
sta BSX.GetCatBlk.IDX
ldy #2 next block#
sta (ZPXPtr2),y
.1 clc
.9 rts
*--------------------------------------
BSX.GetCatBlk.BM
sec
dec BSX.GetCatBlk.BMCNT
bmi .9
jsr BSX.GetCatBlk.CLR
* ldy #0
ldx #2
lda BSX.GetCatBlk.UB
beq .4
.1 lda #%10000000
.2 dec BSX.GetCatBlk.UB
bmi .5
inc BSX.GetCatBlk.nCnt
bne .3
inc BSX.GetCatBlk.nCnt+1
.3 lsr
bne .2
iny
bra .1
.4 lda #%10000000
.5 inc BSX.GetCatBlk.nCnt
bne .6
inc BSX.GetCatBlk.nCnt+1
beq .8
.6 pha
eor (ZPXPtr2),y
sta (ZPXPtr2),y
pla
lsr
bne .5
iny
bne .4
inc ZPXPtr2+1
dex
bne .4
.8 clc
.9 rts
*--------------------------------------
BSX.GetCatBlk.Size
clc
lda GP.ParamB total blocks
beq .1
sec
.1 lda GP.ParamB+1
bit #$0f
beq .2
sec
.2 php
lsr
lsr
lsr
lsr
plp
adc #0
sta BSX.GetCatBlk.BMCNT
inc +1 (ProDOS)
inc +1 (SOS)
adc GP.ParamL +x (cat blocks)
sta BSX.GetCatBlk.UB
rts
*--------------------------------------
BSX.GetCatBlk.CLR
lda BS.WBlock.P.PTR+1
sta ZPXPtr2+1
pha
stz ZPXPtr2
lda #0
tay
ldx #2
.1 sta (ZPXPtr2),y
iny
bne .1
inc ZPXPtr2+1
dex
bne .1
pla
sta ZPXPtr2+1
rts
*--------------------------------------
BSX.GetCatBlk.BLANK .AS "BLANK"
BSX.GetCatBlk.BMCNT .BS 1
BSX.GetCatBlk.UB .BS 1
BSX.GetCatBlk.CNT .BS 1
BSX.GetCatBlk.IDX .BS 1
BSX.GetCatBlk.nCnt .BS 2
*--------------------------------------
MAN
SAVE usr/src/basic.fx/basic.s.xf
LOAD usr/src/basic.fx/basic.s
ASM