Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Kernel 0.93+

This commit is contained in:
Rémy GIBERT 2019-10-16 08:09:13 +02:00
parent 9b4bb82dd8
commit 16bc27fa1c
24 changed files with 8985 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
.Floppies/A2OSX.BUILD.po
View File

Binary file not shown.

2
BIN/PAK.S.txt
View File

@ -514,7 +514,7 @@ CS.RUN.WritePakData
>LDA.G Shunk.DstSize+1
jsr CS.RUN.WriteArcByteA
bcs .9
>DEBUG
>PUSHW.G Shunk.DstSize
>PUSHW ZPDstBufPtr
>LDA.G hArcFile

4
INC/LIBPAK.I.txt
View File

@ -26,8 +26,8 @@ PAK.B.BL .EQ %1111
* WORD : Target UNCompressed Length
* !!! USED TO STOP UNPACK,NO EOF TOKEN!!!
*--------------------------------------
S.PAKSHNK.ULEN .EQ 0 Uncompressed length
S.PAKSHNK.BLBITS .EQ 2 1.lll.oooo
S.PAKSHNK.BLBITS .EQ 0 1.lll.oooo
S.PAKSHNK.ULEN .EQ 1 Uncompressed length
S.PAKSHNK.TOPCNT .EQ 3
S.PAKSHNK.TOPBYTES .EQ 4
* TOP Bytes ....

14
LIB/LIBPAK.S.txt
View File

@ -95,6 +95,9 @@ Pak >PULLW Pak.SrcPtr
jsr Pak.Run
bcs .9
jsr Pak.Out.Close
bcs .9
.DO STATS=1
jsr Pak.PrintStats
>DEBUG
@ -482,7 +485,11 @@ Pak.PutByte8.2 ldy Pak.Shnk+S.PAKSHNK.TOPCNT
.9 rts
*--------------------------------------
Pak.Out.Init lda Pak.Shnk+S.PAKSHNK.ULEN
Pak.Out.Init lda Pak.Shnk+S.PAKSHNK.BLBITS
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.ULEN
jsr Pak.Out.PutByte
bcs .9
@ -490,10 +497,6 @@ Pak.Out.Init lda Pak.Shnk+S.PAKSHNK.ULEN
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.BLBITS
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.TOPCNT
jsr Pak.Out.PutByte
bcs .9
@ -574,6 +577,7 @@ Pak.Out.PutByte inc Pak.DstCnt
.1 sta (ZPDstPtr)
inc ZPDstPtr
bne .2
inc ZPDstPtr+1

65
ProDOS.FX/ProDOS.S.CCLK.txt Normal file
View File

@ -0,0 +1,65 @@
NEW
AUTO 3,1
* object code = cclock_0
* Cortland clock driver
* $2F80-$2FFC moved to $D742
*--------------------------------------
CCLK.START >SHORTMX 8 bit mode.
lda statereg state register.
sta savestate save for restore after tool call.
and #$CF clear the read/write aux memory bits.
sta statereg make it real
clc set e = 0 to set native mode
xce
>LONGMX 16 bit mode.
lda ##$0000 zero out result space.
pha push 4 words for hex time result
pha
pha
pha
>IIGS ReadTimeHex
>SHORTM back to 8 bit to get results from stack
lda savestate restore state register
sta statereg
pla pull off seconds and ignore
pla
sta p8time minutes
pla
sta p8time+1 hours
pla year
.1 cmp #100 out of range?
bcc .2 no, go ahead and store
sbc #$64 else put back in range.
bra .1 try again
.2 sta p8date+1 year
pla
inc increment day for Prodos 8 format.
sta p8date day
pla month
inc increment month for Prodos 8 format.
asl shift month as it sits in between
asl the year and day values.
asl
asl
asl
ora p8date put all but the top bit of month
sta p8date value in the day byte.
rol p8date+1 put hi bit of month in low bit of year
pla pull of unused byte
pla pull off day of week. stack now clean.
sec go back to emulation mode
xce to continue with Prodos 8
rts
savestate .HS 00 state of the state register
.AS "JIMJAYKERRY&MIKE"
.HS 0000000000000000 pad 0's until length
.HS 0000000000000000 of driver = 125 bytes.
.HS 000000000000
CCLK.END .EQ * end of obj cclock_0.
.HS 000000 pad to page boundary
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.CCLK
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

151
ProDOS.FX/ProDOS.S.GP.txt Normal file
View File

@ -0,0 +1,151 @@
NEW
AUTO 3,1
* object code = mli_1
* global page
H2E00 jmp mlient1 $2E00-2EFF moved to $BF00
jspare jmp * will be changed to point to dispatcher.
clockv rts changed to jmp ($4C) if clock present.
.DA tclk_in clock routine entry address.
GP.P8errv jmp XDOS.syserr error reporting hook.
sysdeath jmp sysdeath1 system failure hook.
p8error .DA #0
drivertbl1 .DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
drivertbl2 .DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA nodevice
.DA #0 devnum
numdevs .DA #$ff count (-1) active devices
devlist .HS 00000000000000 up to 14 units may be active
.HS 00000000000000
.DA #0
.AS "(C)APPLE "
mlient1 php
sei
jmp mlicont
aftirq sta RRAMWRAMBNK1 read/write RAM bank 1
jmp fix45 restore $45 after interrupt in LC
oldacc .DA #0
afbank .HS 00
* memory map of lower 48k. each bit represents 1 page.
* protected pages = 1, unprotected = 0
memmap .HS C000000000000000
.HS 0000000000000000
.HS 0000000000000001
* table of buffer addresses for currently open files.
* these can only be changed thru the mli call setbuf.
buftbl .HS 0000 file #1
.HS 0000 file #2
.HS 0000 file #3
.HS 0000 file #4
.HS 0000 file #5
.HS 0000 file #6
.HS 0000 file #7
.HS 0000 file #8
* table of interrupt vectors. these can only be changed
* by the mli call allocate_interrupt. values of the registers
* at the time of the most recent interrupt are stored here along
* with the address interrupted.
inttbl .HS 0000 int #1
.HS 0000 int #2
.HS 0000 int #3
.HS 0000 int #4
p8areg .DA #0 A register savearea
p8xreg .DA #0 X register savearea
p8yreg .DA #0 Y register savearea
p8sreg .DA #0 S register savearea
p8preg .DA #0 P register savearea
bankid .DA #1 bank ID byte (ROM/RAM)
intadr .HS 0000 interrupt return address
p8date .HS 0000 bits 15-9=yr, 8-5=mo, 4-0=day
p8time .HS 0000 bits 12-8=hr, 5-0=min, low-hi format
flevel .DA #0 current file level
bubit .DA #0 backup bit disable, setfileinfo only
spare1 .DA #0 used to save acc
newpfxptr .DA #0 appletalk alternate prefix ptr
machidbyte .DA #0 machine ID byte
rommap .DA #0 slot ROM bit map
preflag .DA #0 prefix active flag
mliact .DA #0 MLI active flag
mliretn .DA 0 last MLI call return address
mlix .DA #0 MLI X register savearea
mliy .DA #0 MLI Y register savearea
* language card bank switching routines which must reside at $BFA0 because
* workstation software patches this area
HBFA0 eor $E000 test for rom enable
beq .1 taken if ram enabled
sta RROMBNK2 read ROM
bne .2 always
.1 lda bnkbyt2 for alternate ram
eor $D000 test
beq .2 branch if not alternate ram
lda RRAMWRAMBNK2 else enable alt $D000
.2 pla return code
rti re-enable interrupts and return
mlicont sec
ror mliact notify interrupt routines MLI active.
lda $E000 preserve language card/rom orientation
sta bnkbyt1 for proper restoration when mli exits.
lda $D000
sta bnkbyt2
lda RRAMWRAMBNK1 force ram card on
lda RRAMWRAMBNK1 with write allowed
jmp XDOS.MLI
GP.IrqExit lda bankid determine state of ram card (ROM/RAM)
irqxit0 beq .2 branch if ram card enabled.
bmi .1 branch if alternate $D000 enabled.
lsr determine if no ram card present.
bcc .3 branch if rom only system.
lda RROMWRAMBNK2 enable rom
bcs .3 always taken
.1 lda RRAMWRAMBNK2 enable alternate $D000
.2 lda #$01 preset bankid for rom.
sta bankid (reset if ram card interrupt)
.3 lda p8areg restore acc
rti exit
irqent bit RRAMWRAMBNK1 this entry only used when rom
bit RRAMWRAMBNK1 was enabled at time of interrupt.
jmp irqrecev
bnkbyt1 .DA #0
bnkbyt2 .DA #0
.HS 00000000 pad to before $BFFA
.DA #4 gsos compatibility byte ($BFFA)
.DA #0 pad
.DA #0 reserved
.DA #0 version # of running interpreter
.DA #0 preserved for System Utilities
kversion .HS 23 represents release 2.0.3
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.GP
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

71
ProDOS.FX/ProDOS.S.IRQ.txt Normal file
View File

@ -0,0 +1,71 @@
NEW
AUTO 3,1
*--------------------------------------
* this routine handles interrupts and is coded to reach 'lreset' precisely at
* address $FFCB (ROM rts opcode) for rom switching to function.
* $2D9B-2DFF moved to $FF9B-FFFF
*--------------------------------------
lanirq pha
lda accsav
sta oldacc
pla
sta accsav
pla get status register from stack
pha and put it back.
and #$10 is it a break or interrupt?
bne H2DC2 branch if break.
lda $D000 get ram bankid (LC1 = $D8, LC2=$EE)
eor #$D8 is the system active? ($D8)
beq sysactv branch if it is
lda #$FF
sysactv sta bankid
sta afbank
lda /aftirq setup return address
pha
lda #aftirq
pha
lda #$04 status reg with interrupt flag set
pha
H2DC2 lda /romirq setup ROM re-entry
pha
lda #romirq
pha
gorom sta RROMBNK2 hits ROM rts at $FFCB
* 'lreset' address must = $FFCB for rom switch i/o to work
lreset lda rreset+1
pha
lda rreset
pha
jmp gorom
rreset .DA resetv-1 rts to resetv
fix45 sta p8areg A register savearea
lda oldacc
sta accsav
lda RRAMWRAMBNK1 read/write RAM bank 1
lda RRAMWRAMBNK1
lda afbank
jmp irqxit0
stypfx sty newpfxptr fix appletalk PFI bug
sty preflag prefix flag
rts
stapfx sta newpfxptr
sta preflag
rts
* these 3 vectors hard-coded into processor
.DA nmivect nmi handler
.DA lreset reset handler
irqv .DA lanirq irq handler
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.IRQ
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

742
ProDOS.FX/ProDOS.S.LDR.A.txt Normal file
View File

@ -0,0 +1,742 @@
NEW
AUTO 3,1
*--------------------------------------
H2000 jmp prostart
jmp atalkset appletalk setup for network boot
jmp p16start GQuit setup for gs/os
LDR.MSG.AppleII .AS -"Apple II"
LDR.MSG.ProDOS .AS -"ProDOS 8 V2.0.3 "
.AS -"06-May-93"
H202F .AS -"A2osX Custom"
LDR.MSG.Copyright
.AS -"Copyright Apple Computer, Inc., 1983-93"
LDR.MSG.Reserved
.AS -"All Rights Reserved."
p16start inc setuprts set = 2 for GQuit rts
atalkset inc setuprts set = 1 for appletalk rts
prostart lda unitnum
sta LDR.MLIONLINE.P+1
jsr LDR.Splash
* test for at least a 65c02
sed
lda #$99 a negative #
clc
adc #$01 +1 in decimal = 0 (positive)
cld
bmi m48k if 6502 because will not clear N flag
* machine at least an m65c02
lda #$01 patch for the gs rom
trb statereg to force off intcxrom
ldx #H232B yx=232B location table
ldy /H232B
jsr reloc move interpreter loader to $800
bcs m48k error
* test for at least 64k
ldy #$00
lda #$FF
sta kversion at least 48k ?
eor kversion
sec
bne m48k if not.
sta kversion try again to be sure
lda kversion
bne m48k still not.
lda RROMBNK2 read ROM
jsr whchrom get preliminary system config
bcs m48k machine too small
lda idapple
and #$20
bne m64k if at least 64k //+.
m48k jmp H22EB need enhanced IIe
* we have 64k, now determine model: //e , iic, or Cortland (//gs)
m64k ldx #H2367 yx=2367 relocation table
ldy /H2367
jsr reloc
lda kversion
sta xdosver save current version for dir use
H20CE bcc H20D3
jmp relocerr
H20D3 lda RROMBNK2 read ROM
ldx version ROM id byte
cpx #$06
bne H211D then it's a //e
lda #$E0
bit zidbyte another ROM id byte
php
lda idapple
and #$37
plp
bvc set3 if //c or //x
bmi set7 if //e
set3 php
ora #$08
plp
bpl mach2 if //c
ora #$40
bpl H20FD always taken.
mach2 inc cflag //c or later
bvs H20FD
set7 ora #$80
H20FD sta idapple
lda RROMBNK2 read ROM
sec
jsr idroutine returns system info
bcs H211D branch if // family
inc cortland it's a Cortland, set loader flag
stz vmode force setvid to reset cursor
jsr setvid reset output to screen
lda setuprts
bne H211D branch if prodos 8 alone
* running from gs/os shell so zero out os_boot for appletalk
sta OS_BOOT indicates O/S initially booted.
jsr patch101 patch for gs/os - rev note #101
* put dispatcher in bank 2 of language card
H211D lda LDR.MLIONLINE.P+1 place boot devnum in globals
sta LDR.MLIREADBLOCK.P+1
sta devnum last device used
jsr devsrch finish setting up globals
lda LDR.MLIREADBLOCK.P+1
sta devnum
jsr lc1in switch in language card bank 1.
ldx #rlclk64 set up clock
ldy /rlclk64
jsr reloc
H2139 bcs H20CE
lda #calldisp
sta jspare+1 P8 system death vector
lda /calldisp
sta jspare+2
lda RRAMWRAMBNK2 read/write RAM bank 2
lda RRAMWRAMBNK2
ldx #altdsptbl GQuit dispatcher
ldy /altdsptbl
lda setuprts
cmp #$02 is this a GQuit setup?
beq H216E taken to use GQuit dispatcher.
ldx #newquitbl else, use Bird's Better Bye
ldy /newquitbl if correct machine.
lda machid machine ID byte
bit #$00 //c ?
bne H216E if yes, can use.
and #$C2
cmp #$82 //e with 80 col card ?
beq H216E if yes, can use.
ldx #dsp64 else, use original quit code
ldy /dsp64
inc newquitflag using old quit code so set flag
H216E jsr reloc
lda #$EE byte to distinguish LC bank 2
sta $D000
jsr lc1in switch in LC bank 1
bcs H2139
* test for 128k needed to install ram disk
lda machid machine ID byte
and #$30
eor #$30
bne noramdsk if < 128k
ldx #$FF
php save interrupt status
pla in acc.
sei no interrupts.
sta SETALTZP use alt zero page/stack
stx auxsp init aux sp to $FF
sta CLRALTZP use main zero page/stack
pha restore interrupt status
plp
sta CLRC3ROM enable internal slot 3 ROM
jsr RAMDRV.Install
* check interrupt vector to determine ROM version
noramdsk lda RROMWRAMBNK2 read ROM/write RAM bank 2
ldy irqv interrupt vector
ldx irqv+1 x = high byte
jsr lc1in set language card bank 1 to r/w
cpx #$D0 is it > $D000 (old roms)
lda #$00
bcs H21C5 branch if old roms
sta SETALTZP use alt zero page/stack
lda #$FF set aux sp = $FF
sta auxsp
stx irqv+1 interrupt vector
sty irqv save irq vector in aux lc
sta CLRALTZP use main zero page/stack
stx irqv+1 save irq vector in main lc
sty irqv
lda #$01
H21C5 sta irqflag 1 = new roms
stz cortflag assume not Cortland system
lda cortland running on a Cortland ?
beq H21D5 branch if not.
inc cortflag yes it's Cortland
bra docard
* check for a rom in slot 3. if no rom, use internal $C300 firmware
H21D5 sta CLRC3ROM enable internal slot 3 ROM
lda rommap slot ROM bit map
and #$08 mask all but slot 3
bne isromin3 taken if rom in slot 3
bra H2247 else continue booting
* found a rom in slot 3. is it an external, identifiable 80 col card
* with interrupt routines? if so, enable it else use internal $C300 firmware.
isromin3 sta SETC3ROM enable slot 3 rom
lda $C305 check card id bytes
cmp #$38
bne hitswtch not terminal card
lda $C307
cmp #$18
bne hitswtch
lda $C30B
cmp #$01
bne hitswtch
lda $C30C is it an apple 80 col compatible card?
and #$F0
cmp #$80
bne hitswtch if not.
lda machid machine ID byte
and #$C8
cmp #$C0 is it a //+ ?
beq docard yes
lda $C3FA
cmp #$2C does card have an interrupt handler?
beq docard yes
hitswtch sta CLRC3ROM enable internal $C300 firmware
* verify that the card in aux slot is actually present
sta SET80STORE enable 80-col store
sta SETPAGE2 switch in text page 2
lda #$EE
sta txtp2
asl
asl txtp2
cmp txtp2
bne H2230
lsr
lsr txtp2
cmp txtp2
H2230 sta CLRPAGE2 main memory
sta CLR80STORE disable 80-col store
beq docard branch if card is there
lda machid machine ID byte
and #$FD clear 80-col bit 2 (no card)
bne H2244 always
docard lda machid
ora #$02 turn bit 2 on (80-col card is present)
H2244 sta machid
H2247 lda cortland are we running on a //gs ?
beq H225D if not.
lda #$4C enable clock routine by putting a jmp
sta clockv in front of clock vector
ldx #cortclock yx = relocation table
ldy /cortclock for cortland clock driver
jsr reloc
lda #$01 set bit 0 = clock present
tsb machid
H225D lda setuprts get setup entry point flag
beq H2267 taken if normal boot.
lda RROMBNK2 read ROM
rts return to caller at setup entry point.
setuprts .DA #$00 0 = normal boot, <>0 = return
* set prefix to boot device
H2267 jsr MLI
.DA #MLIONLINE
.DA LDR.MLIONLINE.P
bcs relocerr
lda pbuf+1 get volume name length.
and #$0F strip devnum
beq relocerr
inc add 1 for leading '/'
sta pbuf save prefix length.
lda #'/' place leading '/' in prefix buffer
sta pbuf+1
jsr MLI
.DA #MLISETPREFIX
.DA LDR.MLISETPREFIX.P
bcs relocerr
tax =0
stx dst
ldy #$02 read directory into buffer
lda /DirBlkBuf
H228E sta dst+1
sta LDR.MLIREADBLOCK.P+3
sty LDR.MLIREADBLOCK.P+4
stx LDR.MLIREADBLOCK.P+5
jsr MLI
.DA #MLIREADBLOCK
.DA LDR.MLIREADBLOCK.P
bcs relocerr
ldy #$03 get next block# from link
lda (dst),y
tax
dey
ora (dst),y if both bytes are the same
beq H22B7 then no more blocks of directory.
lda (dst),y
tay
lda dst+1
clc
adc #$02 add $200 to buffer pointer
cmp /dbuf+$800 until it points past end of buffer.
bcc H228E if ok, read next block.
H22B7 jmp $800 jmp to "load interpreter" code
* relocation/configuration error
relocerr sta RROMBNK2 read ROM
jsr home
ldy #$1D
.1 lda LDR.MSG.LdrErr,y
sta vline12+4,y
dey
bpl .1
bmi *
LDR.MSG.LdrErr .AS -"Relocation/Configuration Error"
H22EB ldy #$23
.1 lda LDR.MSG.EnhErr,y
sta vline14+2,y
dey
bpl .1
bmi *
LDR.MSG.EnhErr .AS -"REQUIRES ENHANCED APPLE IIE OR LATER"
LDR.MLIONLINE.P .DA #2
.DA #$60
.DA pbuf+1
LDR.MLISETPREFIX.P
.DA #1
.DA pbuf
LDR.MLIREADBLOCK.P
.DA #3
.DA #0 unit number
.DA 0 2 byte data buffer
.DA 0 2 byte block number
cortland .BS 1 cortland loader flag (1 = Cortland)
newquitflag .BS 1 1 = old quit code
H232B .DA #1 move interpreter loader code
.DA $800 destination address
.DA licode.end-licode length to move
.DA LOADINT source address
.DA #$01 move $3F0 vectors
.DA p3vect destination
.DA $0010 16 bytes to move
.DA H257B source
.DA #$01
.DA lookptr destination address
.DA $0002 length to move
.DA dst source
.DA #$01 move 128k test to zero page
.DA tst128 destination
.DA LDR.Test128.Len length to move
.DA LDR.Test128 source
.HS FF done
dsp64 .DA #$01 move p8 dispatcher code
.DA displc2 destination
.DA $0300 length (must be <= 3 pages)
.DA SEL0 source
.HS FF done
newquitbl .DA #$01 move Bird's Bye code
.DA displc2 dest
.DA $0300 length (must be <= 3 pages)
.DA SEL1 source
.HS FF done
altdsptbl .DA #$01 move GQuit launcher
.DA displc2 destination
.DA $0300 length (must be <= 3 pages)
.DA SEL2 source
.DA #$01 move a copy of GQuit launcher
.DA dispadr to dispadr for gsos
.DA $0300 length (must be <= 3 pages)
.DA SEL2 source
.HS FF done
* tables for moving 64k version of mli for execution
H2367 .DA #$01 relocation table. 1=move src to dst
.DA $ff9b destination
.DA $100-$9B length to move
.DA IRQ source
.DA #$01
.DA MLI dst
.DA $0100 in one page
.DA GP src
.HS 00 0=clear buffers $D700-$DDFF
.DA $D700 start
.DA $0700 len
.DA #$01
.DA $DE00 dst
.DA $2100 length of mli
.DA XDOS src
.DA #$01
.DA $D000
.DA $0700 length of disk ii driver
.DA XRW
.HS FF done
* move thunderclock
rlclk64 .DA #$01 relocation table. 1=move src to dst
.DA $D742 destination
.DA TCLK.END-TCLK.START length of thunderclock driver
.DA TCLK source
.DA #$04 4=relocate and move program
.DA TCLK.START
.DA TCLK.CEND-TCLK.START
.DA TCLK.START
.HS 00
.HS C1C1
clock64 .DA #$00
.HS FF done
* move cortland clock
cortclock .DA #$01 relocation table. 1=move src to dst
.DA $D742 destination
.DA CCLK.END-CCLK.START length of cortland clock driver
.DA CCLK source
.HS FF done
* load and run appletalk configuration file (atinit) if present
* or continue loading and running .system file
* loader origin $800
LOADINT .PH $800
licode jsr MLI check for file 'atinit'
.DA #MLIGETFILEINFO
.DA gfi_list
bcc gfi_ok branch if 'atinit' file found
cmp #$46 file not found?
beq H23DF if so, continue loading interpreter
bne H23E2
gfi_ok lda gfi_type
cmp #$E2 is 'atinit' correct file type?
bne H23E2 error - wrong file type
jsr MLI open 'atinit' file
.DA #$C8
.DA atopen
bne H23E2 error
lda #$9F max size = 39.75k ($2000-$BF00)
sta rdlen+1
stz rdlen
jsr MLI read 'atinit' file to 'sysentry'
.DA #$CA
.DA rdparm
bne H23E2 error - too big
jsr MLI close 'atinit' file
.DA #$CC
.DA clparm
bne H23E2 error
lda RROMBNK2 enable ROM
jsr sysentry execute ATinit
H23DF jmp goloadint execute .system file
* fatal error
H23E2 ldx $23F0 BUG: should be ATINIT.ERR
H23E5 lda $23F0,x BUG: should be ATINIT.ERR
sta vline16,x
dex
bne H23E5
beq *
ATINIT.ERR .DA #$1A length of message
.AS -"Unable to load ATInit file"
gfi_list .DA #$0A
.DA atinitname
.HS 00
gfi_type .HS 00000000
.HS 0000000000000000
.HS 0000
atopen .HS 03
.DA atinitname
.DA iobuf i/o buffer
.HS 01 ref# hard coded since no other files
atinitname .DA #06 length of name
.AS -"atinit" name of appletalk config file
goloadint
lda /dbuf search directory buffer
sta idxl+1
lda #$04 start 1 entry past header
bne H2434 always.
H2432 lda idxl calc next entry position
H2434 clc
adc dbuf+35 inc to next entry address
sta idxl
bcs H2451 branch if page cross.
adc dbuf+35 test for end of block.
bcc H2453 branch if not page cross
lda idxl+1
lsr end of block?
bcc H2453 no.
cmp #$09 end of directory?
bne H244D no.
jmp nointrp no interpreter, go quit.
H244D lda #$04 reset index to 1st entry in next block.
sta idxl
H2451 inc idxl+1 inc to next page.
H2453 ldy #$10 check file type.
lda #$FF must be a prodos sys file
eor (idxl),y
bne H2432 if not sys.
tay see if active
lda (idxl),y
beq H2432 if deleted file.
and #$0F strip file 'kind'.
sta pbuf save length of name.
cmp #$08 must be at least 'x.system'
bcc H2432 else, ignore it.
tay compare last 7 chars for '.system'
ldx #$06
H246C lda (idxl),y
eor iterp,x
asl
bne H2432 branch if something else
dey
dex
bpl H246C
ldy #$00
H247A iny
lda (idxl),y
sta pbuf,y
ora #$80 msb on so can be displayed if error
sta iomess+$11,y
cpy pbuf
bne H247A
lda #$A0 space after name
sta iomess+$12,y
tya error message length
adc #$13 (carry set)
sta ierlen
jsr MLI open interpreter file
.DA #$C8
.DA opparm
bne badlod
jsr MLI get eof (length of file)
.DA #$D1
.DA efparm
bne badlod
lda eof+2
bne toolong
lda eof+1
cmp #$9F max size = 39.75k ($2000-$BF00)
bcs toolong
sta rdlen+1
lda eof
sta rdlen (read entire file)
jsr MLI read interpreter file
.DA #$CA
.DA rdparm
beq H24C8 go close if successfully read.
cmp #$56 memory conflict?
beq toolong then too large
bne badlod else, unable to load.
H24C8 jsr MLI close interpreter file
.DA #$CC
.DA clparm
bne badlod hopefully never taken
* if booting on a //c then see if esc is in keyboard buffer
* and clear it. it may have been pressed to shift speed
* of accelerator chip
lda cflag
beq H24DF taken if not booting on a //c
lda kbd else, check for keypress
cmp #$9B escape?
bne H24DF if not.
sta KBDSTROBE clear keyboard
H24DF lda RROMBNK2 enable ROM
jmp sysentry go run interpreter
cflag .HS 00 set if a //c.
nointrp jsr MLI no interpreter found,so quit.
.DA #$65
.DA quitparm
badlod ldy ierlen center the error message
lda #$27
sec
sbc ierlen
lsr
adc ierlen
tax
H24FA lda iomess,y
sta vline16,x
dex
dey
bpl H24FA
bmi H2511
toolong ldy #$1E
H2508 lda lgmess,y
sta vline16+5,y
dey
bpl H2508
H2511 bmi H2511
lgmess .AS -"** System program too large **"
iomess .AS -"** Unable to load"
.AS -" X.System *********"
ierlen .HS 00
opparm .HS 03
.DA pbuf
.DA iobuf
.HS 01
efparm .HS 02
.DA #01
eof .HS 000000 length of file.
rdparm .HS 04
.HS 01
.DA sysentry
rdlen .HS 0000
.HS 0000
clparm .HS 01
.HS 00
quitparm .HS 04
.HS 00
.HS 0000
.HS 00
.HS 0000
iterp .AS -".SYSTEM" interpreter suffix that is required
licode.end .EP
* 16 bytes moved to $03F0 vectors
H257B .DA breakv
.DA oldrst
.DA #$5A powerup byte
jmp oldrst '&' vector
jmp oldrst ctrl-y vector
.HS 004000
.DA irqent global page interrupt vector
lc1in lda RRAMWRAMBNK1 read/write language card RAM bank 1
lda RRAMWRAMBNK1
rts
* determine which system model and save in machine id (idapple)
whchrom stz idapple assume standard apple //
ldx version check hardware id
cpx #$38 is it apple // (autostart rom)?
beq H25BE if yes
lda #$80
cpx #$06 apple //e?
beq H25BC if yes
lda #$40
cpx #$EA apple //+?
bne H25B6 it not, then machine is unknown.
ldx $FB1E apple /// in emulation?
cpx #$AD
beq H25BC taken if apple //+.
lda #$D0 test again for apple /// emulation
cpx #$8A because will only have 48k memory.
bne H25B6 if taken, then machine is unknown.
H25B4 sec apple /// emulation is not allowed
rts because insufficient memory.
H25B6 lda #$02 machine unknown
sta (dst),y
bne H25D9 always.
H25BC sta idapple save machine id
* check for language card ram
H25BE jsr lc1in switch in language card bank 1
lda #$AA
sta $D000
eor $D000 if LC present, result = 0.
bne H25B4 othewise, insufficient memory.
lsr $D000 check lc again
lda #$55
eor $D000
bne H25B4 not sufficent memory.
lda #$20 LC ram is available
ora idapple
H25D9 jmp tst128 jumps to page 0 routine below
* test for 128k. use page 0 for this routine
LDR.Test128 sta idapple H25DC-2621 was moved to location tst128
bpl not128 if already determined < 128k
lda #$EE
sta SETWRITEAUX write to aux mem while on main zp
sta SETREADAUX and read aux mem.
sta dbuf write these locs just to test aux mem
sta $800 1k apart from each other.
lda dbuf
cmp #$EE
bne noaux
asl dbuf may be sparse mem mapping so
asl change value and see what happens.
cmp dbuf
bne noaux branch if not sparse mapping.
cmp $800
bne H2606 if not sparse.
noaux sec no aux memory available.
bcs H2607
H2606 clc
H2607 sta CLRWRITEAUX switch back to main memory
sta CLRREADAUX
bcs not128 if < 128k
lda idapple
ora #$30 set id = 128k present
sta idapple
not128 lda lookptr+1
sec
sbc #$05
sta lookptr+1
bcs H2620
dec lookptr
H2620 clc
rts
LDR.Test128.len .EQ *-LDR.Test128
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.LDR.A
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

942
ProDOS.FX/ProDOS.S.LDR.B.txt Normal file
View File

@ -0,0 +1,942 @@
NEW
AUTO 3,1
*--------------------------------------
LDR.Splash cld
sta CLR80DISP disable 80 col hardware
sta CLR80STORE disable 80 col store
jsr setnorm set normal text mode
jsr init init text screen
jsr setvid reset output to screen
jsr setkbd reset input to keyboard
jsr home
ldx #$07
.1 lda LDR.MSG.AppleII,x
sta vline10+16,x
dex
bpl .1
ldx #$1D
.2 lda LDR.MSG.ProDOS,x
sta vline12+5,x
dex
bpl .2
ldx #$0B
.3 lda H202F,x
sta vline14+14,x
dex
bpl .3
ldx #$26
.4 lda LDR.MSG.Copyright,x
sta vline23,x
dex
bpl .4
ldx #$13
.5 lda LDR.MSG.Reserved,x
sta vline24+10,x
dex
bpl .5
sec
jsr idroutine returns system info
bcs .8 taken if not a //gs
lda #$80
trb newvideo video mode select
.8 bit $C000
bpl .8
sta $C010
rts
*--------------------------------------
* find all disk devices in system slots and set up address
* and device table in prodos global page. if there is a disk
* card in slot 2 then limit the # of devices in slot 5
* smartport to only 2
*--------------------------------------
numdev2 .HS 0000000000000000 8 bytes for smartport call
driveradr .DA 0
d2idx .DA #0
diskins2 .DA #0 msb clear if drive in slot 2
devsrch stz dst
stz dst+1
stz idxl
ldx #$FF init to no active devices.
stx numdevs count (-1) active devices.
lda #$0E start disk // area at end of devlist.
sta d2idx
* check slot 2. if there is a disk card then clear the msb of diskins2. this
* will limit the # of devices in any slot 5 spartport card to 2.
lda #$C2
sta idxl+1 check slot 2
jsr cmpid is there a disk in slot 2 ?
ror diskins2 if so, clear msb else set it.
lda #$C7 search slots from high to low
sta idxl+1
H26AB jsr cmpid
bcs H270C if no ProDOS device in this slot.
lda (idxl),y check last byte of $Cn rom (y = $ff)
beq diskii branch if 16 sector disk II.
cmp #$FF if = $FF then 13 sector disk II.
bcs H270C ignore if 13 sector boot ROM
sta driveradr else assume it's an intelligent disk.
ldy #$07 check for a smartport device.
lda (idxl),y
bne H26C4 no smartport
jmp smartprt
H26C4 ldy #$FE
lda (idxl),y get attributes.
and #$03 verify it provides read and status calls.
cmp #$03
sec assume it's an off-brand disk
bne H270C
jsr setdevid set up the devid byte from attributes
clc
php remember that it's not a disk //.
lsr move # of units (0=1, 1=2) to carry.
lda idxl+1 store hi entry addr (low already done)
bne H26E6 branch always.
diskii sta devid =0 since disk ii's have null attributes
sec
php remember it's a disk //
lda #RWTS
sta driveradr
lda /RWTS
H26E6 sta driveradr+1
jsr installdev install 1 or 2 devices from this slot.
plp get back if it's a disk // (carry).
bcc nxtdsk2 if not disk //.
dex move the list pointer back by 2 devices
dex
stx numdevs count (-1) active devices
dec d2idx increase the disk two index
dec d2idx
ldy d2idx
inx adj since device count starts with $FF.
lda devlist+1,x get entries for disk //
sta devlist,y move then toward the end of the list
lda devlist,x
sta devlist+1,y
dex back to numdevs again
nxtdsk2 clc
H270C jsr sltrom test for ROM in given slot and set flags
dec idxl+1 next lower slot.
lda idxl+1
and #$07 have all slots been checked ?
bne H26AB no.
* perform the new device search, mapping unmounted smartport devices
* to empty slots in the device table.
jsr newmount
* now copy the disk // list to the end of the regular list.
* start by making the device count include disk //'s
ldx numdevs current device count - 1
lda #$0E
sec
sbc d2idx
beq H2747 if there were no disk //'s then done.
clc
adc numdevs sum of disk //'s and others.
sta numdevs
inx move to open space in regular list.
ldy #$0D first disk // entry.
H272F lda devlist,y
pha
lda devlist,x
sta devlist,y
pla
sta devlist,x
inx
dey
sty d2idx use as a temp
cpx d2idx
bcc H272F continue until indexes cross
H2747 ldy #$00
ldx numdevs now change the device order so that
H274C lda devlist,x the boot device will have highest
pha priority.
and #$7F strip off high bit
eor devnum for comparison.
asl
bne H275A
pla
iny
H275A dex
bpl H274C
ldx numdevs now reverse order of search, hi to lo.
tya was boot device found ?
beq H2777
lda devnum make boot device 1st in search order.
sta devlist,x
dex
bmi H277E branch if only one device.
dey is this a 2 drive device ?
beq H2777 branch if not.
eor #$80 make boot device, drive 2 next.
sta devlist,x
dex
bmi H277E branch if only 1 device, 2 drives.
H2777 pla
sta devlist,x
dex
bpl H2777
H277E jsr fndtrd save accumulated machine id.
beq H2787
sta machid machine ID byte
rts
H2787 jmp H25B6
stadrv ora devid combine with attributes.
ldx numdevs
inx put device # into device list.
sta devlist,x
asl now form drive 2 device number, if any.
rts
sltrom bcc H27F3 branch if disk drive
* test for clock card
ldy #$06
H2799 lda (idxl),y
cmp dskid,y
bne H27BA no clock
dey
dey
bpl H2799
lda idxl+1 transfer hi slot address
sbc #$C1 minus $C1 (default) to relocate
sta clock64 references to clock rom.
lda #$4C enable jump vector in globals.
sta clockv P8 clock vector.
lda idapple mark clock as present.
beq H277E
ora #$01
sta idapple xxxxxxx1 = clock present.
bne H27F3 always taken.
* test for 80 col card
H27BA ldy #$05
lda (idxl),y
cmp #$38
bne H27E4
ldy #$07
lda (idxl),y
cmp #$18
bne H27E4
ldy #$0B
lda (idxl),y
dec must = 1
bne H27E4
iny
lda (idxl),y
and #$F0 mask off low nibble.
cmp #$80 generic for 80-col card.
bne H27E4
lda idapple
beq H277E
ora #$02
sta idapple xxxxxx1x = 80 col card.
bne H27F3 always taken.
* test for any other rom
H27E4 ldx #$00
lda (idxl)
cmp #$FF apple /// non-slot?
beq H2801 invalid rom
H27EC cmp (idxl) look for floating bus
bne H2801 no rom
inx
bne H27EC
H27F3 lda idxl+1 mark a bit in slot byte
and #$07 to indicate rom present.
tax
lda sltbit,x
ora rommap mark bit to flag rom present
sta rommap slot ROM bit map
H2801 rts
* id bytes: evens for clock, odds for disk
dskid .HS 082028005803703C
* slot bits
sltbit .HS 0002040810204080
fndtrd clc
ldy sltbit
H2818 lda (lookptr),y
and #$DF
adc sltbit
sta sltbit
rol sltbit
iny
cpy sltbit+3
bne H2818
tya
asl
asl
asl
asl
tay
eor sltbit
adc #$0B
bne H283B
lda idapple
rts
H283B lda #$00
rts
installdev php how many drives (carry).
lda idxl+1 get index to global device table
and #$07 for this slot...
asl
tay into y reg.
asl
asl now form device # = slot #
asl in high nibble.
jsr stadrv OR in low nibble, store in dev list.
plp restore # of devices in carry.
ror if 2 drives, then bit 7=1.
bpl H2853 branch if a 1 drive device (e.g. hard drive)
inx else presume that 2nd drive is present.
sta devlist,x active device list.
H2853 stx numdevs save updated device count.
asl shift # of drives back into carry.
lda driveradr get high address of device driver.
sta drivertbl1,y device driver table 1.
bcc H2862 branch if single drive.
sta drivertbl2,y device driver table 2.
H2862 lda driveradr+1
sta drivertbl1+1,y
bcc H286D
sta drivertbl2+1,y
H286D rts
* query smartport status to determine # of devices
* and install up to 4 units in table if card is in slot 5
* otherwise only 2 units. this includes a patch #74
smartprt jsr setdevid setup the devid byte from attributes
lda idxl+1
sta driveradr+1
lda driveradr
sta pscall+1 modify operand
clc
adc #$03
sta spvect+1
lda driveradr+1
sta spvect+2
sta pscall+2 modify operand
asl convert $Cn to $n0
asl
asl
asl
sta unitnum unit number
stz A4L force a prodos status call
stz buf dummy pointer
stz bloknml # of bytes to transfer
stz bloknml+1
lda #$10
sta buf+1 dummy pointer should be <> 0
* do a prodos status call patched in from above
pscall jsr $0000 self modifying code
ldy #$FB
lda (idxl),y check device id
and #$02 SCSI?
beq H28B1 no, no need to init Cocoon
sta statunit device = 2 for SCSI
* initialize SCSI Cocoon to build internal device tables
* and report true # of devices attached
jsr spvect status of Cocoon
.HS 00
.DA spcparms ignore any errors.
H28B1 stz statunit set unit# = 0
jsr spvect call to get the device count.
.HS 00 this is a status call
.DA spcparms
lda numdev2
beq donesp no devices, so done.
cmp #$02 carry set if 2,3,4
jsr installdev do the 1st and 2nd device if exists.
lda idxl+1
cmp #$C5
bne donesp if not slot 5
* for slot 5, if there is a disk card in slot 2
* then only install 2 devices otherwise map
* extra devices as slot 2
bit diskins2 disk in slot 2 ?
bpl donesp yes - so done
lda numdev2
cmp #$03 carry set if 3,4,...
bcc donesp
cmp #$04 carry set if 4,5,6,...
lda #$C2 map extra devices as slot 2
sta idxl+1
jsr installdev
lda #$C5
sta idxl+1
donesp jmp nxtdsk2 it's a disk device.
setdevid ldy #$FE check attributes byte.
H28E8 lda (idxl),y
lsr move hi nibble to lo nibble for
lsr device table entries.
lsr
lsr
sta devid
rts
* check unknown card to see if disk id = $Cn00:nn 20 nn 00 nn 03
cmpid lda CLRC8ROM switch out $C8 ROMs
ldy #$05
H28F6 lda (idxl),y compare id bytes
cmp dskid,y
sec set if no disk card
bne H2903
dey
dey
bpl H28F6 loop until all 4 id bytes match.
clc clear if disk card
H2903 rts
* smartport call parameters
spcparms .DA #$03 # of parms
statunit .DA #$00 unit number (code for smartport stat)
.DA numdev2
.DA #00 status code (0 = general status)
* indexes into driver table
driveridx .DA #$06 s3, d1
.DA #$1E s7, d2
.DA #$0E s7, d1
.DA #$1C s6, d2
.DA #$0C s6, d1
.DA #$1A s5, d2
.DA #$0A s5, d1
.DA #$14 s2, d2
.DA #$04 s2, d1
.DA #$12 s1, d2
.DA #$02 s1, d1
.DA #$18 s4, d2
.DA #$08 s4, d1
* self modifying jmp = smartport entry address
spvect jmp $0000 self modifying
newmount stz idxl
lda #$C7 start with slot 7 ($C700)
sta idxl+1
H291F jsr H29EB is there a smartport device here?
bcs H2974 no, next device.
ldy #$FF get smartport address.
lda (idxl),y
clc
adc #$03 add 3 for smartport call
sta spvect+1
lda idxl+1
sta spvect+2
dey
jsr H28E8 set up device attributes
stz statunit
jsr spvect do a status call on smartport itself
.HS 00
.DA spcparms
lda numdev2 # of devices on smartport
cmp #$03
bcc H2974 only 2 devices,skip to next one.
inc add 1 for comparisons.
sta driveradr # of devices + 1.
lda #$03 start at unit #3 (non-slot 5)
ldx spvect+2
cpx #$C5 is this slot 5?
bne H295B no, start at 3.
bit diskins2 disk controller in slot 2?
bpl H295B yes, so allow remapping of s5 devices
lda #$05 else start looking at unit #5
* find block devices on this smartport
H295B cmp driveradr have we done all units in this slot?
bcs H2974 yes, skip to next slot.
sta statunit store the unit#.
jsr spvect do status call
.HS 00
.DA spcparms
lda numdev2 is this a block device?
bmi mount yes, so mount it.
H296E lda statunit go check the next unit#
inc
bra H295B
H2974 dec idxl+1
lda idxl+1
cmp #$C0 searched down to slot 0?
bne H291F if not.
rts
mount ldx #$0C
H297F ldy driveridx,x
lda drivertbl1,y device driver table 1
cmp #nodevice
bne H2990
lda drivertbl1+1,y
cmp /nodevice
beq H2994
H2990 dex
bpl H297F
rts ran out of space for devices, exit.
* empty slot found
H2994 lda idxl+1
pha
phx
phy
tya which slot is empty?
lsr shift into slot#
and #$07 now 1-7
ora #$C0 now $C1-$C7
sta idxl+1
jsr H29EB smartport interface in this slot?
ply
plx
pla
sta idxl+1
bcc H2990 yes, can't use to mirror the device.
jsr lc1in write enable LC ram bank 1.
tya divide index by 2
lsr
tax
lda statunit
sta spunit-1,x store the smartport unit #
lda spvect+1 and entry address.
sta spvectlo-1,x
lda spvect+2
sta spvecthi-1,x
lda RROMBNK2 write protect lc ram.
inc numdevs
ldx numdevs
tya
lsr
cmp #$08
bcc nodev2 drive 2 mount
sbc #$08
ora #$08
nodev2 asl
asl
asl
asl
ora devid include device attributes
sta devlist,x in the active device list.
lda #remap_sp
sta drivertbl1,y device driver table 1
lda /remap_sp
sta drivertbl1+1,y
bra H296E
H29EB jsr cmpid is it a disk controller?
bcs H29F8 no, so return.
sec assume no smartport
ldy #$07
lda (idxl),y is it a smartport?
bne H29F8 if not.
clc smartport found
H29F8 rts
* relocation subroutine. on entry, regs yx = address of parameter table
* with the following parameters:
*
* (1) command: 0 = zero destination range
* 1 = move data from src to dst
* 2 = hi addr ref tbl, relocate and move
* 3 = lo/hi addr ref tbl, relocate and move
* 4 = program, relocate and move
* >4 = end of sequence of commands
* (2) destination
* (2) length
* (2) source
* (1) # of address ranges (n) to be relocated
* (n+1) list of low page addresses to be relocated
* (n+1) list of high page addresses to be relocated
* (n+1) list of offset amounts to be added to be added
* if low and high limits have not been met
*
* on exit, carry set if error and yx = addr of error
* with acc = $00 for table error or $FF if illegal opcode
reloc stx idxl save address of control table
sty idxl+1
rloop lda (idxl) get relocation command.
cmp #$05
bcs rlend taken if >= 5 then done.
tax move destination to page 0
ldy #$01 for indirect access.
lda (idxl),y
sta dst
iny
lda (idxl),y
sta dst+1
iny
lda (idxl),y also the length (byte count)
sta cnt of the destination area.
iny
lda (idxl),y
sta cnt+1
bmi rlerr branch if >= 32k.
txa is it a request to zero destination?
beq zero if yes.
iny
lda (idxl),y get source address.
sta src used for move.
sta cde used for relocation
iny
clc
adc cnt add length to get final address
sta ecde
lda (idxl),y
sta src+1
sta cde+1
adc cnt+1
sta ecde+1
dex test for 'move' command
beq H2AA3 branch if move only (no relocation)
stx wsize save element size (1,2,3)
iny
lda (idxl),y get # of ranges that are valid
sta sgcnt relocation target addresses.
tax separate serial range groups into tbls
H2A42 iny
lda (idxl),y transfer low limits to 'limlo' table
sta limlo,x
dex
bpl H2A42
ldx sgcnt # of ranges
H2A4E iny
lda (idxl),y transfer high limits to 'limhi' table
sta limhi,x
dex
bpl H2A4E
ldx sgcnt # of ranges
H2A5A iny
lda (idxl),y transfer offsets to 'ofset' table
sta ofset,x
dex
bpl H2A5A
jsr adjtbl adj index pointer to next entry.
ldx wsize test for machine code relocation
cpx #$03
beq rlcode branch if program relocation
jsr reladr otherwise, relocate addresses in
H2A70 jsr moveSrcDst tables then move to destination.
bra rloop do next table
rlend clc
rts
rlerr jmp tblerr
rlcode jsr rlprog relocate machine code refs
bra H2A70
* fill destination range with 0's
zero jsr adjtbl adj table pointer to next entry.
lda #$00
ldy cnt+1 is it at least 1 page?
beq H2A94 branch if not.
tay
H2A89 sta (dst),y
iny
bne H2A89
inc dst+1 next page
dec cnt+1
bne H2A89 if more pages to clear.
H2A94 ldy cnt any bytes left to 0?
beq H2AA0 if not.
tay
H2A99 sta (dst),y zero out remainder
iny
cpy cnt
bcc H2A99
H2AA0 jmp rloop
H2AA3 jsr adjtbl
bra H2A70
adjtbl tya add previous table length to
sec get next entry position in table
adc idxl
sta idxl
bcc H2AB2
inc idxl+1
H2AB2 rts
moveSrcDst lda src+1 is move up, down or not at all?
cmp dst+1
bcc movup
bne movdn
lda src
cmp dst
bcc movup
bne movdn
rts no move.
movup ldy cnt+1 calc highest page to move up
tya and adj src and dst.
clc
adc src+1
sta src+1
tya
clc
adc dst+1
sta dst+1
ldy cnt move partial page 1st.
beq H2ADE taken if no partial pages
H2AD6 dey
lda (src),y
sta (dst),y
tya end of page transfer?
bne H2AD6 no
H2ADE dec dst+1
dec src+1
dec cnt+1 done with all pages?
bpl H2AD6 no
rts
movdn ldy #$00
lda cnt+1 partial page move only?
beq H2AFC taken if < 1 page to move
H2AED lda (src),y
sta (dst),y
iny
bne H2AED
inc dst+1 next page
inc src+1
dec cnt+1 more pages?
bne H2AED if more.
H2AFC lda cnt move partial page.
beq H2B09 if no more to move
H2B00 lda (src),y
sta (dst),y
iny
cpy cnt
bne H2B00
H2B09 rts
* relocate addresses
reladr ldy wsize 1 or 2 byte reference
dey
lda (cde),y
jsr adjadr relocate reference.
lda wsize update and test code pointer.
jsr adjcde
bcc reladr if more to do
rts
rlprog ldy #$00 get next opcode
lda (cde),y
jsr oplen determine if a 3 byte instruction.
beq rperr branch if not an opcode
cmp #$03
bne H2B30
ldy #$02
jsr adjadr relocate address
lda #$03
H2B30 jsr adjcde update and test if done.
bcc rlprog if more to do
rts
rperr pla
pla
ldx cde bad code address in y,x
ldy cde+1
lda #$FF indicates bad opcode
sec
rts
tblerr ldx idxl bad table address in y,x
ldy idxl+1
lda #$00 indicates input table error
sec
rts
adjadr lda (cde),y get page address and
ldx sgcnt test against limits.
H2B4D cmp limlo,x is it >= low?
bcc H2B59 if not.
cmp limhi,x is it <= high?
bcc H2B5D branch if it is
beq H2B5D
H2B59 dex try next limit set
bpl H2B4D
rts return w/o adjustment.
H2B5D clc add offset to form relocated
adc ofset,x page address and replace
sta (cde),y old address with result.
rts
adjcde clc update code pointer
adc cde
ldy cde+1
bcc H2B6C branch if not page cross
iny otherwise, update page#.
H2B6C cpy ecde+1 has all code/data been processed?
bcc H2B72 if not.
cmp ecde
H2B72 sta cde save updated values.
sty cde+1
rts return result (carry set = done).
oplen pha form index to tbl & which 2-bit group.
and #$03 low 2 bits specify group
tay
pla
lsr upper 6 bits specify byte in table
lsr
tax
lda opcodln,x
nxgroup dey is opcode len in lowest 2 bits of acc?
bmi H2B89 branch if it is
lsr shift to next group.
lsr (if length = 0 then error)
bne nxgroup
H2B89 and #$03
rts if z-set then error
* relocation table contains length of each opcode in 2-bit groups
opcodln .HS 0928193C0A280D3C
.HS 0B2A193F0A280D3C
.HS 0928193F0A280D3C
.HS 0928193F0A280D3C
.HS 082A113F0A2A1D0C
.HS 2A2A193F0A2A1D3F
.HS 0A2A193F0A280D3C
.HS 0A2A193F0A280D3C
wsize .HS 00
sgcnt .HS 00
limlo .HS 0000000000000000
limhi .HS 0000000000000000
ofset .HS 0000000000000000
* patch to gsos vectors so error is returned for os calls - rev note #101
patch101 php
sei disable interrupts
clc
xce full native mode
>LONGMX
phb save DBR
pha
pha
pea $0000 length of patch
pea $0010 0000/0010 = 16 bytes
pea $3101 user id for prodos 8
pea $8018 attributes (locked/nospec/nocross)
pha
pha
>IIGS NewHandle
lda $01,s retrieve handle
tax
lda $03,s
tay
pea $0000 copy the code into the handle
pea L2C4D
phy
phx
pea $0000 length of patch = 0000/0010
pea $0010
>IIGS PtrToHand
plx low word of handle
plb set DBR to handle's bank
lda >1,x get upper 16 bits of 24 bit address
tay save in y
lda >0,x get low 8 bits of address
and ##$00FF clear high byte
xba put address in high byte
ora ##$005C include JML opcode
sta GSOS2 store in gsos vectors
clc
adc ##$000B
sta GSOS
tya store upper 16 bits too
sta GSOS2+2
adc ##$0000 adj for possible page crossing
sta GSOS+2
plb remove garbage byte from stack
plb restore DBR.
sec
xce back to emulation mode
plp
rts
* copy of the code that goes in the handle
L2C4D lda 1,s
sta 7,s
lda 2,s
sta 8,s
pla
pla
pla
lda ##$00FF #NoOS
sec
rtl
.BS $2C80-*
RAMDRV.Install ldy #$99 move $9A bytesfrom lcsrc to lcdest.
.1 lda RAM,y transfer main bank portion of driver
sta RAMDRV,y dey
cpy #$FF
bne .1
ldx #RAMX set up to move aux portion of driver
stx A1L
dex
stx A2L
ldx /RAMX
stx A1L+1
inx
stx A2L+1
lda #RAMXDRV
sta A4L
lda /RAMXDRV RAMX to RAMXDRV
sta A4L+1
sec irection = to aux bank.
jsr auxmove move aux bank portion of driver.
lda #RAMDRV put driver address into
sta drivertbl2+6 slot 3, drive 2.
lda /RAMDRV
sta drivertbl2+7
inc numdevs count (-1) active devices
ldx numdevs
lda #$BF unit num of /RAM
sta devlist,x
rts
RAM_1_END .EQ * end of /RAM installer
.BS $2D00-* pad 0's to page boundary
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.LDR.B
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

88
ProDOS.FX/ProDOS.S.RAM.txt Normal file
View File

@ -0,0 +1,88 @@
NEW
AUTO 3,1
* object code = ram_2
* /RAM driver (main bank portion)
* origin = $FF00
RAMDRV cld no decimal.
ldx #$0B save 13 bytes of parms
.1 lda A1L,x
sta a1l1,x
dex
bpl .1
ldx #$01
.2 lda passit,x save xfer vectors
sta sp1,x
dex
bpl .2
lda A4L get command.
beq stat 0 = status
cmp #$04 check for command too high.
bcs ioerr if it is, i/o error
eor #$03
sta A4L 0=format, 2=read, 1=write
beq format
ldy bloknml+1 check for large block number.
bne ioerr too big.
lda bloknml block #
bmi ioerr largest block number is $7F
* at this point, control is passed to the code in the alternate 64k.
* it it used for read, write and format. after the request is completed,
* control is passed back to 'noerr'.
format lda #RAMXDRV card entry point
sta passit
lda /RAMXDRV
gocard sta passit+1 also used by 'mainwrt'
sec direction ram -> card
clv start with original zero page
jmp xfer transfer control
ioerr lda #$27
bne H2D41
lda #$2B write protect error.
H2D41 sec flags error
bcs H2D47
noerr .EQ *
stat lda #$00
clc
H2D47 php save status
pha and error code.
ldx #$0B restore 13 byes of parms
H2D4B lda a1l1,x
sta A1L,x
dex
bpl H2D4B
lda sp1 restore xfer parms.
bit $6060 addr $FF58 must = rts ($60) as in ROM
sta passit
lda sp1+1
sta passit+1
pla restore error code
plp and status.
rts
mainwrt sta SETWRITEAUX write to alt 48K
ldy #$00
H2D6A lda (A1L),y pointers set in card by 'setptr'
sta (A4L),y
lda (A2L),y
sta (A3L),y
dey
bne H2D6A
sta CLRWRITEAUX write to main 48K.
lda #donewrt done writing card
sta passit
lda /donewrt
jmp gocard
sp1 .HS 0000
a1l1 .BS 13 13 bytes of storage
* end of obj ram_2
RAMDRV.END .EQ *
.BS $FF9B-* fill to lanirq ($FF9B see note below)
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.RAM
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

322
ProDOS.FX/ProDOS.S.RAMX.txt Normal file
View File

@ -0,0 +1,322 @@
NEW
AUTO 3,1
* object code = ram_0
* /RAM driver (aux bank portion)
* this code is packed into $200 length with no room for expansion !!
* (see note at end of this obj)
* after the main /RAM routine has determined that the command is ok and the
* block to be read/written is within range, it transfers control to this
* aux /RAM routine which remaps the block requested as follows:
* request blocks 0,1: invalid
* 2: returns VDIR (card block 3)
* 3: returns BITMAP (synthesized)
* 4: returns card block 0
* $05-$5F: returns card blocks $05-$5F
* $60-$67: returns blocks $68-$7F in bank 1 of language card
* $68-$7F: returns blocks $68-$7F in bank 2 of language card
H5100 lda RD80STORE read 80 store
pha save for later
sta CLR80STORE turn off 80 store
ldx #$04 move the parameters for use:
L5109 lda A4L,x cmd, unit, bufptr and block (lo)
sta tcmd,x -> tcmd, tunit, R2L, R2H, R01
dex
bpl L5109
and formatflg format the volume first time
bne L514F thru, or when requested.
ldx bloknml save R01 during format.
lda /vblock1 block to be cleared.
jsr clrbuf1 clears all buffers.
ldy #$03 format volume in 2 chunks.
L511F lda VDIR,y
sta vblock1+4,y
dey
bpl L511F
lda #$FE set last block as unusable
sta BITMAP+15 to protect vectors.
tya set bitmap bits to $FF.
ldy #$0E 15 bytes to set
L5130 sta BITMAP,y
dey
bne L5130
sty BITMAP first byte = 0.
ldy #$07 do other chunk
L513B lda access,y
sta vblock1+34,y
dey
bpl L513B
lda formatflg if 0, set to $FF
bne L51AA else exitcard.
sty formatflg y = $FF, won't format next time.
stx R01 restore R01
* use the requested block number to determine
* which routine performs the transfer
L514F asl R01 block requested -> page requested.
lda R01 get page requested.
cmp #$BF in language card ?
bcs L5163 yes, do it.
cmp #$06 bitmap ?
bne L5160
jmp tbmap yes, transfer bitmap
L5160 jmp treg else normal transfer.
* when a block between $60 and $7F is requested, it must be spirited into/from
* the language card area of the 64k card. this requires a 2 stage move:
* into the temp buffer and then to it's real destination.
L5163 tax save R1 for later.
jsr setptr get direction
php and save it.
bcs L51B8 if it's a write.
lcrd txa get R1 back
cmp #$CF which bank is it in ?
bcs L5173 in main bank.
ora #$10 in secondary bank.
bne L5179 branch always.
L5173 sta RRAMWRAMBNK2 turn on main $D000
sta RRAMWRAMBNK2
L5179 sta R01 restore R1.
lda R2H save R2 for later
pha
ldx R2L
sta SETALTZP use alternate zero page/stack
lda /dbuf set R2 to dbuf
sta R2H
lda #dbuf
sta R2L
jsr setptr set pointers
tay A > 0 from setptr
L5194 lda (A1L),y move A1,A2 to A4,A3
sta (A4L),y
lda (A2L),y
sta (A3L),y
dey
bne L5194
sta CLRALTZP use main zero page/stack
L51A2 stx R2L
pla restore R2
sta R2H
plp get direction.
L51AA bcs L51B5 write, done with move.
sta RRAMWRAMBNK1 switch in MLI part of LC
sta RRAMWRAMBNK1
jsr blockdo0 read, transfer dbuf to main
L51B5 jmp exitcard
L51B8 jsr blockdo0 transfer main to dbuf.
jmp lcrd transfer dbuf to language card
* blockdo0 transfers a block between main memory and the 64k card. R1 contains
* the page address of the block in the card; R2 contains the page address of
* the block in main memory. the address in main memory is always in the
* language card, so the language card is always switched in. if cmd is 2, a
* write is done (R2->R1); if cmd is 1, a read is done (R1->R2).
blockdo0 lda /dbuf set up R1 = dbuf
blockdo1 sta R01
blockdo jsr setptr set pointers.
bcs L51DB it's a write.
sta CLRWRITEAUX transfer buffer directly to main.
tay 0 left from setptr.
L51CC lda (A1L),y transfer A1,A2 to A4,A3
sta (A4L),y
lda (A2L),y
sta (A3L),y
dey
bne L51CC
sta SETWRITEAUX back the way it was.
donewrt rts mainwrt returns here
L51DB lda #mainwrt pointers set up,
sta passit pass control to main ram
lda /mainwrt
jmp ex1 set passit+1 and transfer
* setptr is used by other routines to set up pointers and dtect read or write
setptr lda tcmd is it read or write ?
lsr
bcs L5208 taken if write.
lda R2H destination page
sta A4L+1
sta A3L+1
lda R2L
sta A4L
sta A3L
lda R01 source page
sta A1L+1
sta A2L+1
lda #$00 source page aligned
sta A1L
sta A2L
beq L5223
L5208 lda R2H source page
sta A1L+1
sta A2L+1
lda R2L
sta A1L
sta A2L
lda R01 destination page
sta A4L+1
sta A3L+1
lda #$00 destination page aligned
sta A4L
sta A3L
L5223 inc A2L+1
inc A3L+1
rts
* tzip is called if blocks 0,1,4,5 are requested.
* on write it does nothing, on read it returns 0's.
tzip jsr clrbuf0 fill dbuf with 0's
jsr blockdo transfer the 0's
jmp exitcard and return
* clrbuf fills the buffer indicated by R01 to 0's.
* should only be called on a read or format.
clrbuf0 lda /dbuf dbuf is temp buffer.
clrbuf1 sta R01 assign to block.
clrbuf2 jsr setptr set pointers
tay acc = 0
L523A sta (A1L),y
sta (A2L),y
dey
bne L523A
rts
* treg maps the requested block into the aux card
* so that 8k data files will be contiguous (the index
* blocks will not be placed within data).
treg cmp #$04 page 4 = vdir
bne L524A not vdir, continue
lda #$07 else transfer block 7
bne L5258
L524A cmp #$0F if any page < $F (block 8) requested,
bcc tzip it is invalid.
ldx #$00 x = # of iterations.
lda bloknml use true block #.
cmp #$5D beyond 8k blocks ?
bcc L525B no, do normal
sbc #$50 else subtract offset
L5258 jmp times2 and multiply by 2
* determine which 8k chunk it is in, place in x;
* block offset into chunk goes into y.
L525B sec
sbc #$08 block=block-6
L525E cmp #$11 if <=17 then done
bcc L5268
sbc #$11 else block=block-17.
inx iteration count.
bpl L525E should branch always
brk otherwise crash !!!
L5268 tay remainder in y
* if remainder is 1 then it's an index block:
* start index blocks at $1000,$2000...$19FF.
* if remainder is 0 then it is first data block
* in 8k chunk. page is 32 + (16 * x).
* otherwise, it is some other data block.
* page is 32 + (16 * x) + (2 * y)
cpy #$01 is it index block ?
bne L5273 no.
txa index = 2 * (8 + x)
clc
adc #$08
bne times2 multiply by 2.
L5273 inx iteration + 1.
txa page = 2 * (16 + 8x)
asl
asl
asl
asl
sta R01
tya get offset into 8k chunk
beq L5281 if 0, no offset
dey else offset = 2 * y
tya
L5281 clc
adc R01
times2 asl acc = 2 * acc
jsr blockdo1 store in R01 and transfer
jmp exitcard and return
* when block 3 is requested, the bitmap is returned. the real bitmap is only
* 16 bytes long; the rest of the block is synthesized. the temporary buffer
* at $800 is used to build/read a full size bitmap block.
tbmap lda /dbuf use temp buffer as block
sta R01
jsr setptr set pointers, test read/write.
bcs L52A9 branch if it's write.
jsr clrbuf2
ldy #$0F put real bitmap there
L529B lda BITMAP,y
sta (A1L),y
dey
bpl L529B
jsr blockdo move temp buf to user buf
jmp exitcard
L52A9 jsr blockdo move user buf to temp buf
jsr setptr
ldy #$0F move temp buf to bitmap.
L52B1 lda (A4L),y (pointer set by setptr)
sta BITMAP,y
dey
bpl L52B1
jmp exitcard
formatflg .HS 00 not formatted yet
tcmd .HS 00 command
.HS 00 unit (not used)
R2L .HS 00 R2 = user buffer
R2H .HS 00
R01 .HS 00 page requested
BITMAP .HS 00FFFFFF blocks 0-7 used
.HS FFFFFFFF
.HS FFFFFFFF
.HS FFFFFFFE
VDIR .HS F3 storage type = F, name length = 3
.AS "RAM"
access .DA #$C3 destroy, rename, read enabled
.HS 27 entry length
.HS 0D
.HS 0000
.HS 0300 block 3
.HS 7F 128 blocks
exitcard lda RRAMWRAMBNK1 restore language card
lda RRAMWRAMBNK1
pla get 80store
bpl L52EA 80store wasn't on
sta SET80STORE enable 80store
L52EA jmp bypass jump around passit
passit .HS 0000
bypass lda #noerr set up return to noerr
sta passit
lda /noerr
ex1 sta passit+1 also used by blockwrite
clc transfer card to main
clv use standard zeropage/stack
jmp xfer jmp back from language card.
* NOTE: the previous section of code MUST NOT use $3FE or $3FF
* since the interrupt vector must go there if aux interrupts
* are to be used. no room for expansion here !!
.HS 0000 $3FE-$3FF
* end of obj ram_0
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.RAMX
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

297
ProDOS.FX/ProDOS.S.SEL0.txt Normal file
View File

@ -0,0 +1,297 @@
NEW
AUTO 3,1
* object code = sel_0
*
* dispatcher 1 - this code org's and operates at 'dispadr' (=$1000) but
* is resident in memory at 'displc2' (=$D100) in the alternate 4k bank
* of the language card. the quit call vectors to a routine high in the
* mli that moves dispatcher 1 down and jumps to it. the move routine
* must remain somewhere between $E000-$F7FF. this routine must be less
* than 3 pages in length.
SEL0.START lda RROMBNK2 read ROM
sta CLR80DISP disable 80 col hardware
sta CLRALTCHAR normal LC, flashing UC
sta CLR80STORE disable 80 column store
jsr setnorm set normal text mode
jsr init init text screen
jsr setvid reset output to screen
jsr setkbd reset input to keyboard
ldx #$17 clear the memory bitmap
lda #$01 but protect page $BF00.
sta memmap,x P8 memory bitmap
dex
lda #$00
L5A22 sta memmap,x
dex
bpl L5A22
lda #$CF protect zero page, stack and
sta memmap $400-$7FF (text screen display)
L5A2D jsr home clear screen
jsr crout position top/left
ldx #dsp1msg0-dsp1msgs
jsr prntmsg 'enter prefix...'
lda #$03 line 3
sta cv
jsr crout
jsr MLI get prefix
.DA #$C7
.DA dsp1pfx
ldx pbuf get prefix length
lda #$00 put 0 at end of prefix
sta pbuf+1,x
ldx pbuf get length.
beq L5A5D if no prefix to display.
L5A52 lda pbuf,x display prefix directly to screen
ora #$80 normal text
sta vline5-1,x line 5
dex
bne L5A52
L5A5D ldx #$00
dec cv
jsr crout
getkey jsr rdkey input char with cursor
cmp #$8D cr ?
beq L5ABD yes, accept what is entered.
pha no, save the char.
jsr clreol clear rest of line.
pla get char back
cmp #$9B esc ?
beq L5A2D yes, start over
cmp #$98 ctrl-x ?
L5A76 beq L5A2D then start over
cmp #$89 tab ?
beq badkey
cmp #$FF delete ?
beq L5A84 if yes
cmp #$88 backspace ?
bne L5A91 if not
L5A84 cpx #$00 at column 0 ?
beq L5A8B if so, do nothing
dec ch else move left
dex dec char count
L5A8B jsr clreol clear rest of line
jmp getkey get another char
L5A91 bcs L5A99
badkey jsr bell output bell for bad key
jmp getkey and get another.
L5A99 cmp #$DB below 'Z' ?
bcc L5A9F if yes
and #$DF else shift to uppercase.
L5A9F cmp #$AE below '.' ?
bcc badkey
cmp #$DB above 'Z' ?
bcs badkey
cmp #$BA below ':' ?
bcc goodkey
cmp #$C1 at or above 'A' ?
bcc badkey
goodkey inx
cpx #$27 more than 39 chars ?
bcs L5A76 then too many, go restart.
sta pbuf,x save it
jsr cout
jmp getkey get another.
L5ABD cpx #$00 prefix length = 0 ?
beq L5AD3 if yes, don't set length.
stx pbuf set prefix length.
jsr MLI call mli to set prefix.
.DA #$C6
.DA dsp1pfx
bcc L5AD3 if ok, go get filename.
jsr bell if not, ring bell
lda #$00 and try again for prefix.
L5AD1 beq L5A76
L5AD3 jsr home clear screen for application name.
jsr crout
ldx #disp1msg-dsp1msgs
jsr prntmsg 'enter pathname...'
retryrich lda #$03 line 3
sta cv
jsr crout
ldx #$00
loop1 jsr rdkey input char with cursor.
cmp #$9B esc ?
bne L5AF4 if not esc.
lda ch esc pressed in column 0 ?
bne L5AD3 if not, get pathname again.
beq L5AD1 if so, get prefix again.
L5AF4 cmp #$98 ctrl-x ?
L5AF6 beq L5AD3 then cancel and get pathname again.
cmp #$89 tab ?
beq L5B09 not good.
cmp #$FF delete ?
beq L5B04 delete char.
cmp #$88 backspace ?
bne L5B07
L5B04 jmp delchar delete char.
L5B07 bcs L5B0F if > $88 then char may be acceptable.
L5B09 jsr bell output bell (ctl-G)
jmp loop1 not good.
L5B0F cmp #$8D cr ?
beq L5B3C then done.
cmp #$DB less than 'Z' ?
bcc L5B19 no.
and #$DF make sure it's uppercase.
L5B19 cmp #$AE '.' ?
bcc L5B09 not good if less.
cmp #$DB less than '[' ?
bcs L5B09 not good.
cmp #$BA <= '9' ?
bcc L5B29 then ok.
cmp #$C1 greater than 'A' ?
bcc L5B09 if not, then no good.
L5B29 pha it's good, save it.
jsr clreol clear to end of line
pla
jsr cout print it
inx
cpx #$27 more than 39 chars ?
bcs L5AF6 too long, get pathname again.
sta pbuf,x store it.
jmp loop1 get another char
L5B3C lda #$A0
jsr cout after cr, blank out the cursor.
stx pbuf put length in front of the name.
jsr MLI get file info for pathname in pbuf
.DA #$C4
.DA dsp1info
bcc L5B4F if no errors.
jmp dsp1error
L5B4F lda dsp1type
cmp #$FF is it a SYS file ?
beq L5B5B yes.
lda #$01 not SYS file error.
jmp dsp1error
L5B5B lda #$00 it's a system file
sta dsp1cln
jsr MLI close all open files
.DA #$CC
.DA dsp1cls
bcc L5B6B
jmp dsp1error
L5B6B lda dsp1acess check for proper access.
and #$01 is read disabled ?
bne L5B77 no, access ok.
lda #$27 i/o error
jmp dsp1error
L5B77 jsr MLI open the file
.DA #$C8
.DA dsp1open
bcc L5B82
jmp dsp1error
L5B82 lda dsp1refn copy the reference number
sta dsp1rdn
sta dsp1eofn
jsr MLI get eof
.DA #$D1
.DA dsp1eof
bcs dsp1error
lda dsp1eofb+2 3rd of 3 bytes.
beq L5B9C if 0 then ok
lda #$27 else i/o error because
bne dsp1error file is too large.
L5B9C lda dsp1eofb move eof to # of bytes to read.
sta dsp1cnt
lda dsp1eofb+1
sta dsp1cnt+1
jsr MLI read the file
.DA #$CA
.DA dsp1read
php save the status.
jsr MLI close the file.
.DA #$CC
.DA dsp1cls
bcc L5BBB
L5BB7 plp get status (it is irrelevant now)
bne dsp1error if close generated an error
plp here if close was ok.
L5BBB bcs L5BB7 error.
jmp sysentry execute system file
delchar lda ch is cursor in column 0 ?
beq L5BD3 yes, ignore it.
dex
lda #$A0 blank out the cursor
jsr cout
dec ch
dec ch point to last char entered
jsr cout and blank it too.
dec ch point to that location.
L5BD3 jmp loop1 get next char.
prntmsg lda dsp1msgs,x
beq L5BE1
jsr cout
inx
bne prntmsg
L5BE1 rts
* dispatcher 1 error handler
dsp1error sta errnum
lda #$0C display error message on line 13
sta cv
jsr crout
lda errnum
cmp #$01
bne L5BF5
ldx #dsp1err1-dsp1msgs not a type 'sys' file
bne L5C0B handled separately.
L5BF5 cmp #$40 syntax error in pathname ?
beq L5C09
cmp #$44 bad subdirectory path ?
beq L5C09
cmp #$45 volume not found ?
beq L5C09
cmp #$46 file not found ?
beq L5C09
ldx #dsp1err2-dsp1msgs if not the errors above then 'i/o error'
bne L5C0B
L5C09 ldx #dsp1err3-dsp1msgs otherwise display 'file/path not found'
L5C0B jsr prntmsg
jmp retryrich retry for application pathname
dsp1msgs .EQ *
dsp1msg0 .EQ *
.AS -'ENTER PREFIX (PRESS "RETURN" TO ACCEPT)'
.HS 00
disp1msg .AS -"ENTER PATHNAME OF NEXT APPLICATION"
.HS 00
dsp1err1 .DA #$87
.AS -'NOT A TYPE "SYS" FILE'
.HS 00
dsp1err2 .DA #$87
.AS -"I/O ERROR "
.HS 00
dsp1err3 .DA #$87
.AS -"FILE/PATH NOT FOUND "
.HS 00
dsp1info .DA #$0A 10 parameters
.DA pbuf pathname buffer
dsp1acess .HS 00 access
dsp1type .HS 00 file type
.BS 13 the rest are unimportant
dsp1open .HS 03 3 parameters for open
.DA pbuf pathname buffer
.DA fbuf fcb buffer
dsp1refn .HS 00 reference #
dsp1cls .DA #01 1 parameter for close
dsp1cln .HS 00 reference #
dsp1read .HS 04 4 parameters for read
dsp1rdn .HS 00 reference #
.DA sysentry .SYS load address
dsp1cnt .HS 0000 byte count
.HS 0000
dsp1eof .HS 02 2 parameters
dsp1eofn .HS 00 reference #
dsp1eofb .HS 000000 3 byte eof
dsp1pfx .DA #01 1 parameter
.DA pbuf prefix buffer
.BS $1300-* fill to page boundary
* end of obj sel_0
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.SEL0
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

404
ProDOS.FX/ProDOS.S.SEL1.txt Normal file
View File

@ -0,0 +1,404 @@
NEW
AUTO 3,1
* object code = sel_1
* Bird's Better Bye at org = dispadr
*--------------------------------------
birdbye cld
lda RROMBNK2 read ROM
stz softev
lda /dispadr set reset vector to 'dispadr'
sta softev+1 jsr setpwrc create power-up byte
lda #$A0
jsr $C300 initialize 80 column text card
ldx #$17
* set up memory bitmap in global page
L5D16 stz memmap,x P8 memory bitmap
dex
bpl L5D16
inc memmap+$17 protect global page
lda #$CF protect zero page, stack and page 1
sta memmap
lda #$02
sta smparms init set mark parms pcount.
* drive selector
ldx numdevs get device count and
stx lstpntr store in zero page.
lda devnum get last slot/drive
bne volname
ds2 ldx lstpntr get device list pointer.
lda devlist,x get unit number from list.
cpx #$01 make sure it's real.
bcs L5D3F if so, change list pointer.
ldx numdevs get device count.
inx
L5D3F dex decrement list pointer and restore.
stx lstpntr
* get and store volume name
volname sta ol_unit store unit number for online.
jsr MLI
.DA #$C5 online call
.DA ol_parms
bcs ds2 error check.
stz dlevel haven't read root directory yet.
lda pbuf+1 load description byte.
and #$0F mask for name length.
beq ds2 if 0, then try next unit.
adc #$02 add 2 to length.
tax name length in x.
vnam1 stx pbuf save the name length
lda #$2F '/'
sta pbuf+1 slash before and
sta pbuf,x after name.
stz pbuf+1,x null after complete name.
* open and read directory
jsr MLI
.DA #$C8 open
.DA op_parms
bcc L5D7F good open.
lda dlevel trying to open root directory ?
beq ds2 yes, just move to next volume.
jsr bell1 no, generate bell tone
jsr popdir and stay at same level.
stx pbuf
jmp keyloop
L5D7F inc dlevel
stz filecount zero file count.
lda op_refn get file reference number
sta rd_refn store in read
sta sm_refn and setmark parm lists.
lda #$2B set read parm list for
sta dhdr_len directory header length.
stz dhdr_len+1
jsr doread read directory
bcs L5DB3
ldx #$03
L5D9A lda sysentry+$23,x copy directory info
sta entlen,x to zero page.
dex
bpl L5D9A
sta dhdr_len put entry length in read parm list.
lda #$01 set block file counter to 1.
sta blkfl
stz fpos_mid zero out msb's of file position
stz fpos_hi in setmark parm list.
lda filecnt any files in directory ?
ora filecnt+1
bne L5DB5 if so, continue
L5DB3 bra L5E29 else go close directory file.
L5DB5 bit filecnt+1 check msb of file count.
bmi L5DB3 if set then done.
L5DB9 lda fpos_mid get mid byte of setmark file position.
and #$FE reset lsb
sta fpos_mid and save.
ldy blkfl block file counter
lda #$00
cpy entblk have we read all entries in this block ?
bcc L5DCE if not, continue.
tay if so, zero y-reg and
sty blkfl reset block counter / flag
inc fpos_mid
* set up setmark parameters for next file to be read.
* if transfer to second sector, handle it.
L5DCC inc fpos_mid
L5DCE dey decrement file block counter
clc
bmi L5DD8
adc entlen add entry length to acc.
bcc L5DCE determine if we flopped into 2nd half of
bcs L5DCC block, if so inc mid byte position.
L5DD8 adc #$04 add 4 and put in
sta fpos_lo low byte of setmark.
jsr MLI call mli
.DA #$CE set mark
.DA #smparms parameters address = $0060
.HS 00
bcs L5DB3 error
jsr doread
bcs L5DB3 error.
inc blkfl increase count of files read.
lda sysentry file type/length.
and #$F0 mask off high nibble.
beq L5DB9 deleted file, try next one.
dec filecnt decrement low file count.
bne L5DF8
dec filecnt+1 and high if necessary.
L5DF8 ror sysentry+$1E check access bit.
bcc L5DB5 if no read, try next file.
lda sysentry+$10 get file type.
cmp #$0F directory file ?
beq L5E08 then continue.
cmp #$FF system file ?
bne L5DB5 no, read next file.
L5E08 ldx filecount get valid files read.
cpx #$80 if greater than size of filename buffer
bcs L5E29 then close directory
sta filetyps,x else store filetype in zero page
jsr namecalc and go set up storage area.
ldy #$0F
L5E15 lda sysentry,y get byte of filename
sta (fnstore),y store in directed area
dey
bpl L5E15
iny y = 0
and #$0F mask off low nibble (name length)
sta (fnstore),y restore in name buffer
inc filecount increment valid file counter
bne L5DB5 get next file (branch always)
L5E26 jmp ds2 error. try next unit.
L5E29 jsr MLI close directory file
.DA #$CC
.DA cl_parms
bcs L5E26 error.
jsr settxt use full screen for windows
jsr home
lda #$17 cursor at bottom of screen.
jsr TABV set vertical position.
ldy #$00
lda #$14 horizontal position.
jsr sethorz print message.
jsr homecurs cursor to upper/left.
ldx #$00
L5E48 lda pbuf+1,x
beq showfiles
jsr output
inx
bne L5E48
showfiles stz valcnt
stz topname init top filename index.
lda filecount # of valid files.
beq keyloop if no files.
cmp #$15 more than what will fit on screen ?
bcc L5E61 no.
lda #$14 limit to 20 files on the screen.
L5E61 sta gp_cnt
lda #$02 set window dimensions
sta wndtop
sta wndlft
lda #$16
sta wndwdth
sta wndbtm
L5E6F jsr nameprnt output filename to screen
inc valcnt
dec gp_cnt file counter.
bne L5E6F continue printing names.
stz valcnt
beq L5EAA if last file, it needs to be inverse.
uparrow jsr nameprnt print old name in normal.
ldx valcnt get old name number.
beq L5EAA if already at the top name
dec valcnt else fix index.
lda cv current cursor line.
cmp #$02 at top line of window ?
bne L5EAA no, move up normally.
dec topname fix offset index
lda #$16 else sroll windows down a line.
bne L5EA7 branch always.
dnarrow jsr nameprnt print old name in normal.
ldx valcnt get old name number.
inx add one.
cpx filecount
bcs L5EAA if already at last filename
stx valcnt else update index.
lda cv current cursor line.
cmp #$15 at bottom line of window ?
bne L5EAA no, move cursor normally.
inc topname update offset index
lda #$17 else scroll up a line.
L5EA7 jsr cout
L5EAA jsr setinv set inverse text mode.
jsr nameprnt output last filename.
keyloop lda kbd get keyboard input.
bpl keyloop loop until key pressed.
sta KBDSTROBE clear strobe.
jsr setnorm set normal text mode.
ldx filecount are any files displayed ?
beq L5ECB no, don't accept arrow keys or return.
cmp #$8D return ?
beq L5EF4 then run selected file.
cmp #$8A down ?
beq dnarrow move down a name.
cmp #$8B up ?
beq uparrow move up a name.
L5ECB cmp #$89 tab ?
beq L5EED new volume.
cmp #$9B esc ?
bne keyloop no, try again else pop up a directory.
* pop a directory level
jsr popdir
dec dlevel
bra L5EF1
popdir ldx pbuf
L5EDD dex
lda pbuf,x
cmp #$2F slash
bne L5EDD
cpx #$01
bne L5EEC
ldx pbuf
L5EEC rts
L5EED jmp ds2 set up new unit number.
L5EF0 inx
L5EF1 jmp vnam1 get new directory info.
* run selected file
L5EF4 jsr MLI set prefix
.DA #$C6
.DA pf_parms
bcs L5EED error.
ldx valcnt get name number.
jsr namecalc set up name storage area (on return y=0)
ldx pbuf get prefix length.
L5F04 iny start at y = 1.
lda (fnstore),y get character of name.
inx
sta pbuf,x store in prefix buffer.
cpy namelen check length of name.
bcc L5F04 loop until all transferred.
stx pbuf put prefix length into buffer.
ldy valcnt get file number.
lda filetyps,y get file type.
bpl L5EF0 branch if directory.
jsr settxt reset to full window.
jsr home makes for no flash.
lda #$95 ctrl-u
jsr cout turn off 80 columns.
jsr MLI open file
.DA #$C8
.DA op_parms
bcs L5EED if error.
lda op_refn move reference number
sta rd_refn for read.
lda #$FF read the entire file.
sta dhdr_len
sta dhdr_len+1
jsr doread read selected file.
php save possible error.
jsr MLI close file. ignore any error from close
.DA #$CC
.DA cl_parms
plp restore status from read.
bcs L5EED if any errors.
jmp sysentry execute selected system file.
* output messages. on entry: acc = horizontal position,
* y = index to message teminated by 0.
sethorz sta ch
msgout lda dsp2msg,y
beq L5F57
jsr cout
iny
bne msgout
L5F57 rts
* name pointer calculator for name storage area
namecalc stz fnstore+1 init high byte of 16-bit shift
txa
asl shift to high nibble
rol fnstore+1
asl
rol fnstore+1
asl
rol fnstore+1
asl
rol fnstore+1
sta fnstore low pointer
lda /iobuf
clc
adc fnstore+1
sta fnstore+1
ldy #$00
lda (fnstore),y file name length
sta namelen
rts
* output a filename line
nameprnt lda #$02
sta ch80col horizontal position = 2.
ldx valcnt filename number
txa
sec
sbc topname calculate line # to display name
inc
inc
jsr TABV set vertical position.
lda filetyps,x get filetype (x is unchanged by tabv).
bmi L5F99 branch if system file.
stz ch80col adjust cursor position.
lda invflg ave current inverse setting
pha
ldy #fldrmsg-dsp2msg
jsr msgout display the folder.
pla restore inverse setting.
sta invflg
L5F99 jsr outsp output a space.
jsr namecalc calc name location.
L5F9F iny y = 1 (first time).
lda (fnstore),y get name character.
jsr output put on screen.
cpy namelen end of name ?
bcc L5F9F no.
outsp lda #$A0
bne L5FB1 branch always.
homecurs lda #$99
output ora #$80 set high bit.
L5FB1 jmp cout output to screen.
doread jsr MLI mli read call
.DA #$CA
.DA rd_parms
rts
* data area
dsp2msg .AS -"RETURN: Select | TAB: Chg Vol | "
.AS -"ESC: Back"
.DA #$00
fldrmsg .DA #$0F inverse control code
.HS 1B enable mousetext
.AS -"XY" folder characters
.HS 18 disable mousetext
.HS 0E normal control code
.HS 00
op_parms .DA #$03 3 parms
.DA pbuf pathname
.DA op_buf file buffer
op_refn .HS 00 reference number
cl_parms .HS 01 1 parm
.HS 00 reference number.
ol_parms .HS 02 2 parms
ol_unit .HS 60 unit number, default = s6, d1
.DA pbuf+1 data buffer
pf_parms .DA #01 one parm
.DA pbuf pathname
rd_parms .DA #04 4 parms
rd_refn .HS 01 reference number
.DA sysentry data buffer
* these last 2 parms (4 bytes) may extend past $300 length limit since
* the request count is set prior to using the parm block and the transfer
* count isn't used at all (except by prodos)
* .HS 0000 requested length
* .HS 0000 actual length
dhdr_len .HS 00 directory header length (actually uses 2 bytes)
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.SEL1
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

440
ProDOS.FX/ProDOS.S.SEL2.txt Normal file
View File

@ -0,0 +1,440 @@
NEW
AUTO 3,1
* object code = sel_2
*
* Alternate program selector segment for P8 when used in conjunction with
* gs/os. This code is used in place of the standard P8 interactive program
* selector when P8 is started up by GQuit. It is called when passing control
* from one application to another and the new application is 8-bit. This
* code first loads the specified P8 application at $2000 in bank 0 of memory.
* It then checks the message center for a possible name of a file. this file
* is passed on to the 8-bit application. This segment then passes control to
* the freshly loaded app. This code does NOT start with a CLD instruction
* (as other replacement quit code is supposed to do) because GQuit checks
* this to see if this version of quit code is available.
GQdisp lda RRAMWRAMBNK1 read/write LC bank 1
clc
xce 16 bit native mode.
jmp P8QUIT go to GQuit.
.HS 0000000000 offset to paragraph boundary.
.AS "GQ" id bytes so GQuit can identify this
* load application
*
* Entry is in 16-bit native mode. Exit is in emulation mode.
*
* On entry and exit:
* Data bank register is set to $00.
* Direct register is set to $0000.
* Stack pointer is set to $01FB.
*
* Inputs: acc = value of E1_OS_Switch (0 or 1, 1 = yes to switch)
*
* This code is moved to $00/1010 and executed there.
* first, copy the prefix passed from gs/os to our own volume name buffer
* so in case of an error setting the P8 prefix, it can be displayed in the
* error message.
>SHORTM 8 bit accumulator
pha save the switch status.
ldx ##inbuf point to passed prefix.
jsr copyvol copy the name into the buffer.
pla retrieve the switch status
* go into emulation mode to load and run Prodos 8 application
sec
xce 8 bit emulation mode
ora #$00 switching from P16 to P8 ?
beq L602D no.
* switching from P16 to P8 so pass prefix 0 from P16 to the P8 prefix. the
* prefix is passed at $00/0200 by GQuit.
L6020 jsr MLI set prefix
.DA #$C6
.DA pfxparms
bcc L602D if prefix ok.
jsr gqerror error handler.
bra L6020 try again
* load application at $2000
L602D xce native mode (carry clear)
>LONGX 16 bit regs, 8 bit acc.
lda pbuf+1 is the application name
cmp #$2F a complete pathname ?
bne L603D no, use prefix as volume name
ldx ##pbuf else use the application name.
jsr copyvol copy the volume name to buffer.
L603D sec back to emulation mode.
xce
L603F jsr MLI open the application file
.DA #$C8
.DA opnparms
bcc L604C if open ok.
jsr gqerror handle error.
bra L603F try again.
L604C lda oprefnum copy ref number to parameter lists
sta eofrefn
sta rdrefnum
sta closeref
* do a geteof call for how many bytes to read
L6058 jsr MLI get eof
.DA #$D1
.DA eofparms
bcc L6065 eof ok.
jsr gqerror handle error.
bra L6058 try again.
* store the size of the file in the read parameter list
L6065 lda eofval
sta rdcount
lda eofval+1
sta rdcount+1
L6071 jsr MLI read
.DA #$CA
.DA readparm
bcc L607E read ok
jsr gqerror
bra L6071
L607E jsr MLI close
.DA #$CC
.DA closeprm
bcc L608B close ok
jsr gqerror
bra L607E
L608B jsr dolaunch check for possible 2nd pathname.
bne L6099 if none then run program
jsr ckfordrv else make sure the file is online.
bcc L6099 if so then run the program.
lda #$45 volume not found error.
bra L60AB
L6099 lda RROMBNK2 enable ROM
jmp sysentry execute the system application
gqerror clc
xce 16 bit native mode
>LONGMX
jsr mountvol mount volume.
bcs L60AB if error.
sec back to emulation mode.
xce
rts
* generate a fatal error while running under Prodos 8.
* on input, acc = error code. this routine does not return.
L60AB clc native mode
xce
>LONGMX
and ##$00FF mask off high byte of error code.
pha put on stack for IntMath tool call.
pea $0000 errval>>16
pea errval push address of string buffer.
pea $0004 make string 4 digits long.
>IIGS Int2Hex convert value to hex string.
pha make space for return value.
pea $0000 quitstr1>>16
pea quitstr1 push first error message address
pea $0000 quitstr2>>16
pea quitstr2 push second error message address
pea $0000 button1>>16
pea button1 push first button text address
pea $0000 quitbtn2>>16
pea quitbtn2 push 2nd button text address (null)
>IIGS TLTextMountVolume make the dialog box
pla retrieve button press (not used)
sec emulation mode
xce
jsr MLI quit back to GQuit
.DA #$65
.DA quitparms
* p8 mount volume
*
* on entry: volbuf = name of volume to mount.
* on exit: carry clear if mount volume displayed and 'return' was pressed.
* carry set if no window displayed or if had window and 'esc' pressed.
mountvol ldy ##$0000 volbuf>>16
ldx ##volbuf set up pointer to volume name.
* if error is 'volume not found' or 'no disk in drive' then display the
* Mount Volume window, otherwise return with carry set.
and ##$00FF mask just in case.
cmp ##$0045 volume not found ?
beq L6101 yes
cmp ##$002F no disk in drive ?
beq L6101 yes
sec indicate error not handled.
rts return with error code still in acc.
L6101 pha save error code in case esc pressed.
phy pointer to volume name.
phx
tsc
phd save D reg.
tcd point D reg at stack.
lda [$01] get length byte and leading separator.
dec don't count leading separator.
xba then swap the bytes so the volume name
sta [$01] doesn't cpntain the separator.
pha room for result.
pea $0000 mountmsg>>16
pea mountmsg
phy hi word of pointer to volume name.
inx skip separator.
phx lo word of pointer to volume name.
pea $0000 button1>>16
pea button1 'Return'
pea $0000 button2>>16
pea button2 'Escape'
>IIGS TLTextMountVolume
lda [$01] restore first 2 bytes of vilume name
xba back to their original positions
inc and values.
sta [$01]
pla which button: 1=Return 2=Escape.
pld restore D reg.
plx pull volume name pointer off stack
plx
cmp ##$0001 which button was pressed ?
bne L613C if Escape pressed.
clc indicate Return was pressed.
pla pull original error code off stack.
rts return with carry clear.
L613C sec indicate Escape was pressed.
pla restore error code.
rts return with carry set.
* copy the volume name from the given pathname to the volume name buffer.
*
* inputs: x = length byte of complete pathname containing volume name.
* output: volume name is stored in volbuf.
copyvol lda >1,x get the first slash
sta volbuf+1
ldy ##$0002 initialize the length count.
L6148 lda >2,x now copy the volume name up to
cmp #$2F the separating slash.
beq L6156
sta volbuf,y
inx
iny
bra L6148
L6156 dey fix character count.
tya length.
sta volbuf store the resultant string length.
rts
* translate a filename message from the message center to the currently
* launching P8 application if it can accept a second filename. If found,
* copy the filename into the application's filename buffer.
* on exit, the z-flag is set if a filename was correctly passed to the
* application elst the z-flag is clear if it couldn't be done.
dolaunch lda sysentry does the app start with a jump ?
cmp #$4C
bne L616F no, doesn't follow the convention.
lda #$EE check for the signature bytes.
cmp sysentry+3
bne L616F 1st one doesn't match, skip it.
cmp sysentry+4
beq L6170 both match, go get a filename message.
L616F rts just return to launch the app.
L6170 lda #$FF put flag conditioning value on
pha the stack (assume error).
clc native 16-bit mode.
xce
>LONGMX
pha make room on stack for user id.
>IIGS MMStartUp start up the memory manager.
pla get the user id and
pha leave it on the stack.
pha
pha make room on stack for new handle.
pea $0000
pea $000A get a 10 byte block of memory.
pha put user id on stack.
pea $0000 totally unrestricted block.
pha LocationPtr (not used)
pha
>IIGS NewHandle go get the block of memory.
pla get the handle from the stack.
plx
bcs L620A branch if error, no memory available.
phx leave the handle on the stack.
pha
pea $0002 'get' a message.
pea $0001 get a type 1 (filename) message.
phx put the message handle on the stack
pha (still in acc and x regs)
>IIGS MessageCenter
bcs L6203 branch if no message.
pha leave 4 bytes free on stack
pha (will be used as a direct page pointer)
tsc get the stack pointer.
phd save current direct register.
inc point to new direct page space.
tcd make a new direct page.
lda [$04] de-reference the handle.
sta $00
ldy ##$0002
lda [$04],y
sta $02
ldy ##$0006 get the message command.
lda [$00],y
bne bad_msg if print, then skip it.
lda $00 adjust pointer to filename string.
clc
adc ##$0008
sta $00
bcc L61D1
inc $02
L61D1 lda [$00] get the length of the string.
and ##$00FF mask off high (leaving just the length)
>SHORTM 8 bit accumulator
cmp sysentry+5 check against length of app buffer.
beq L61DF if equal then continue with move.
bcs bad_msg if too long then bad message.
L61DF tay string length.
L61E0 lda [$00],y get a character.
sta sysentry+6,y store it in the app's filename buffer
sta inbuf,y and in prefix buffer.
dey
bpl L61E0
lda #$00 change flag conditioning value on stack
sta $0D,s to indicate a filename is passed.
bad_msg
>LONGM 16-bit acc.
pld restore direct register.
pla fix stack because handle and userid
pla still on stack.
pea $0003 now delete the message (done with it).
pea $0001 message type 1.
pha garbage handle (not used).
pha
>IIGS MessageCenter go delete the message.
L6203 >IIGS DisposeHandle throw away message (handle is on stack)
L620A >IIGS MMShutDown shutdown the memory manager (userid is
sec on stack).
xce back to emulation mode.
pla condition z-flag with value on stack.
bne L6231 then done.
ldx inbuf get length of pathname.
lda #$2F look for slash.
L621B cmp inbuf,x
beq L6225 when found, set prefix.
dex
bne L621B
bra L6231 if no slash, just skip it.
L6225 dex don't include trailing slash.
stx inbuf set new length.
jsr MLI set the P8 prefix.
.DA #$C6
.DA pfxparms
lda #$00 set z-flag
L6231 rts and go launch the app.
* check for disk volume
*
* on exit:
* carry clear = disk was found
* carry set = disk not found
ckfordrv clc native mode
xce
>LONGX 16-bit regs, 8-bit acc.
ldx ##sysentry+6 point to pathname buffer.
jsr copyvol copy volume name to pathname buffer.
.1 sec emulation mode.
xce
jsr MLI get info on the volume.
.DA #$C4
.DA gfiparms
bcc .2 branch if volume found,
clc (native mode)
xce
>LONGMX
jsr mountvol else ask user to mount the volume.
bcc .1 if <return> pressed, then try again.
sec emulation mode.
xce
sec disk not found.
.2 rts
* Prodos 8 parameter lists
pfxparms .DA #01 one parm.
.DA inbuf address of prefix.
opnparms .DA #3 3 parms.
.DA pbuf pathname
.DA op_buf i/o buffer
oprefnum .HS 00 reference #
eofparms .DA #02 2 parms
eofrefn .HS 00 reference #
eofval .HS 000000 3 byte eof value
readparm .DA #04 4 parms
rdrefnum .HS 00 reference #
.DA sysentry read into $2000 (bank 0).
rdcount .HS 0000 # of bytes to read.
.HS 0000 transfer count
closeprm .DA #1 1 parm
closeref .HS 00 reference #
quitparms .DA #04 4 parms.
.HS 00 quit back to launcher (GQuit)
.HS 0000
.HS 00
.HS 0000
gfiparms .DA #$0A 10 parms
.DA volbuf volume buffer
.DA #0 access
.DA #0 file type
.DA 0 aux type
.DA #0 storage type
.DA 0 blocks used
.DA 0 modification date
.DA 0 modification time
.DA 0 creation date
.DA 0 creation time
* messages for P8 fatal error. maximum length of message is 35 characters.
* the error code will be displayed immediately after the final character.
quitstr1 .DA #$1B
.AS "Can't run next application."
quitstr2 .DA #$14
.AS "ProDOS Error = $"
errval .AS " "
quitbtn2 .HS 00
* messages for P8 mount volume. maximum length of message is 35 characters.
* the button labels must not be more than 16 characters.
mountmsg .DA #$17
.AS "Please insert the disk:"
button1 .DA #$0D
.AS "Accept: "
.DA #$1B mousetext on
.DA #$0F inverse on
.DA #$4D mousetext return
.DA #$0E normal on
.DA #$18 mousetext off
button2 .DA #$0B
.AS "Cancel: Esc"
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.SEL2
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

104
ProDOS.FX/ProDOS.S.TCLK.txt Normal file
View File

@ -0,0 +1,104 @@
NEW
AUTO 3,1
* object code = tclock_0
* Thunderclock driver
* hard coded for slot 1
* $2F00-2F7C moved to $D742
TCLK.START ldx TCLK.Cx2+2 clock slot = $C1.
lda clkmode,x save current mode
pha
lda #$A3 send numeric mode byte to Thunderclock
TCLK.Cx1 jsr wttcp
TCLK.Cx2 jsr rdtcp read month, day of week, day of month
clc and time into input buffer.
ldx #$04 index for 5 values.
ldy #$0C read minutes 1st, month last.
.1 lda inbuf,y convert values to binary.
and #$07 no value > 5 decimal.
sta pcl 'tens' place value
asl multiply by 10
asl
adc pcl
asl
adc inbuf+1,y add to ascii 'ones' place
sec and subtract out the ascii
sbc #$B0
sta pcl,x save converted value.
dey index to next lowest value
dey
dey
dex are there more values?
bpl .1 if yes.
tay contains month
lsr
ror
ror
ror high bit of month held in carry
ora A1L
sta p8date save low value of date.
php save high bit of month.
and #$1F isolate day.
adc tdays-1,y (y = month)
bcc .2 branch if not Sept 13 thru 30th
adc #$03 adj for mod 7 when day > 256
.2 sec
.3 sbc #$07
bcs .3 loop until < 0.
adc #$07 make it in the range of 0-6.
sbc pch the delta provides years offset.
bcs .4 branch if positive
adc #$07 else make it positive again.
.4 tay
lda yradj,y look up year
plp and combine it with hi bit of month
rol
sta p8date+1 P8 date
lda A1L+1 hour
sta p8time+1 P8 time
lda A2L minute
sta p8time
pla restore previous mode.
ldx TCLK.Cx2+2 clock slot = $C1
sta clkmode,x
TCLK.CEND rts
* this table contains entries for the cumulative # of days in a year,
* one entry for each month. the values are modulo 256.
tdays .DA #$00 January
.DA #$1F February
.DA #$3B March
.DA #$5A April
.DA #$78 May
.DA #$97 June
.DA #$B5 July
.DA #$D3 August
.DA #$F2 September
.DA #$14 October (MOD 256)
.DA #$33 November
.DA #$51 December
* the following table is used to look up the current year, based on
* the current month, day and day of week. The 1st entry corresponds
* to the year in which January 1st falls on a Monday. The 2nd entry
* is the year which January 1st is Sunday, and so on backwards thru
* the days of the week.
yradj .DA #$07 Monday
.DA #$0C Sunday
.DA #$0B Saturday
.DA #$0A Friday
.DA #$09 Thursday
.DA #$08 Wednesday
.DA #$08 Tuesday
TCLK.END .HS 000000 pad
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.TCLK
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

670
ProDOS.FX/ProDOS.S.XDOS.A.txt Normal file
View File

@ -0,0 +1,670 @@
NEW
AUTO 3,1
*--------------------------------------
XDOS.MLI cld no decimal.
pla get processor status
sta spare1 save it temporarily
sty mliy save x and y
stx mlix
pla find out the address of the caller
sta A3L
clc preserve the address of the call spec.
adc #$04
sta mliretn last MLI call return address
pla
sta A3L+1
adc #$00
sta mliretn+1
lda spare1
pha pull processor status
plp to re-enable interrupts.
cld still no decimal
stz p8error clear any previous errors.
ldy #$01 find out if command is valid.
lda (A3L),y get command #
lsr and hash it to a range of 0-$1F
lsr
lsr
lsr
clc
adc (A3L),y
and #$1F
tax
lda (A3L),y check result to see if valid command #
cmp scnums,x
bne scnerr
iny index to call spec parm list.
lda (A3L),y make A3L point to parameter count byte
pha in parameter block.
iny
lda (A3L),y
sta A3L+1
pla
sta A3L
* ldy #$00
lda pcntbl,x make sure parameter list has the correct # of parameters.
beq goclock clock has 0 parameters.
cmp (A3L) ,y
bne scperr error if wrong count.
lda scnums,x get call # again
cmp #MLIQUIT is it quit?
beq special if so, then call quit dispatcher
asl carry set if bfm or dev mgr
bpl godevmgr
bcs gobfmgr
lsr shift back down for interrupt manager
and #$03 valid calls are 0 and 1
jsr XDOS.intmgr
bra exitmli
special jmp jspare P8 system death vector
goclock jsr clockv go read clock.
bra exitmli no errors possible
godevmgr lsr shift back down for device manager.
adc #$01 valid commands are 1 and 2.
sta A4L save command #.
jsr XDOS.devmgr execute read or write request.
bra exitmli
gobfmgr lsr shift back down for block file manager.
and #$1F valid commands are 0-$13
tax
jsr XDOS.bfmgr
exitmli stz bubit clear backup bit
ldy p8error P8 error code
cpy #$01 if > 0 then set carry
tya and set z flag.
php disable interrupts until exit complete.
sei
lsr mliact indicate MLI done.
plx save status register until return.
lda mliretn+1 place last MLI call return address
pha on stack. return is done via 'rti'
lda mliretn so the status register is restored
pha at the same time, so
phx place status back on stack
tya return error, if any.
ldx mlix MLI X register savearea
ldy mliy MLI Y register savearea
pha
lda bnkbyt1 restore language card status
jmp HBFA0 and return.
nodevice lda #MLI.E.NODEV no device connected.
.HS 2C BIT ABS
scnerr lda #MLI.E.BADCALL
.HS 2C BIT ABS
scperr lda #MLI.E.BADCNT
jsr GP.P8errv
bra exitmli
*--------------------------------------
* ProDOS Device Manager
*--------------------------------------
XDOS.devmgr php do not allow interrupts.
sei the call spec for devices must
ldy #$05
.1 lda (A3L),y be passed to drivers in page zero:
sta A4L,y
dey
bne .1
ldx buf+1 buffer page
stx usrbuf+1 to user buffer
inx
inx
lda buf is buffer page aligned (nn00) ?
beq .2 branch if it is
inx else account for 3-page straddle
.2 jsr vldbuf1 make sure user buffer is not
bcs dvmgrerr conflicting with protected ram.
jsr dmgr call internal entry for device dispatch
bcs dvmgrerr branch if error
plp
clc no error
rts
dvmgrerr plp restore interrupt status
gosyserr jsr GP.P8errv
*--------------------------------------
dmgr lda unitnum get device # and
and #$F0 strip misc lower nibble
sta unitnum then save it.
lsr use as index to device table
lsr
lsr
tax
gocmd jmp (drivertbl1,x) goto driver (or error if no driver)
*--------------------------------------
* ProDOS interrupt manager
*--------------------------------------
XDOS.intmgr sta A4L interrupt command
lsr allocate interrupt or deallocate?
bcs dealcint branch if deallocate.
ldx #$03 test for a free interrupt space in tbl.
.1 lda inttbl-2,x test high address for 0.
bne .2 branch if spot occupied.
ldy #$03 get address of routine.
lda (A3L),y must not be zero page.
beq badint error if it is.
sta inttbl-2,x save high address
dey
lda (A3L),y
sta inttbl-3,x and low address.
txa return interrupt # in range 1-4
lsr
dey
sta (A3L),y pass back to user.
clc no errors.
rts
.2 inx
inx next lower priority spot
cpx #$0B are all 4 already allocated?
bne .1 branch if not.
lda #MLI.E.IRQFULL interrupt table full
.HS 2C BIT ABS
badint lda #MLI.E.INVPARAM invalid parameter.
jsr GP.P8errv
dealcint ldy #$01 zero out interrupt vector
lda (A3L),y but make sure it is a valid #.
beq badint error if < 1
cmp #$05 or > 4
bcs badint
asl
tax
lda #$00 now clear it
sta inttbl-2,x
sta inttbl-1,x
clc
rts
*--------------------------------------
irqrecev lda accsav get acc from where old ROM put it.
sta p8areg
stx p8xreg entry point on ram card interrupt
sty p8yreg
tsx
stx p8sreg
lda irqflag irq flag = 0 if old roms
bne .1 and 1 if new roms.
pla restore return address and p-reg.
sta p8preg
pla
sta intadr interrupt return address
pla
sta intadr+1
.1 txs
lda mslot set up to re-enable $Cn00 rom
sta irqdev+2
ldx #$FA save 6 bytes of page 0
.2 lda $00,x
sta svzerop-$FA,x
inx
bne .2
* poll interrupt routines for a claimer
ldx #0
.3 stx irqXindex
lda inttbl+1,x test for a valid routine.
beq .4 branch if no routine.
jsr gointX execute
bcc irqdone
.4 ldx irqXindex
inx
inx
cpx #10
bne .3
inc irqcount allow 255 unclaimed interrupts
bne irqdone before system death.
lda #$01 bad irq so
jsr sysdeath kill the system.
irqdone ldx #$FA
H31AE lda svzerop-$FA,x restore the zero page
sta $00,x
inx
bne H31AE
lda irqflag check for old roms.
bne H31DD branch if new roms.
ldy p8yreg restore registers.
ldx p8xreg
lda CLRC8ROM re-enable i/o card.
irqdev lda $C100 Cn is self modifying.
lda irqdev+2 restore device id.
sta mslot slot being accessed.
H31DD jmp GP.IrqExit do necessary bank switches and return.
irqflag .HS 00 0 = old roms. 1 = new roms.
irqcount .HS 00 # of unclaimed interrupts.
irqXindex .HS 00
svzerop .HS 000000000000
gointX jmp (inttbl,x) interrupt routine x
XDOS.syserr sta p8error P8 error code
plx
plx pop 1 level of return
sec
rts
sysdeath1 tax death error code.
sta CLR80DISP disable 80 col hardware.
lda SETTEXT switch in text.
lda cortflag is this a Cortland?
beq H321A if not, don't use super hires switch.
stz newvideo force off super hires.
H321A lda CLRPAGE2 switch in text page 1.
ldy #$13
H321F lda #$20 inverse space border
sta vline11+10,y
sta vline13+10,y
lda deathmsg,y
sta vline12+10,y 'RESTART SYSTEM-$0x'
dey
bpl H321F
txa x = death error code
and #$0F convert to ascii
ora #$B0
cmp #$BA
bcc H323B branch if not > 9.
adc #$06 inc to alpha a-f
H323B sta vline12+28 death error code 1 to F
bra * end of xdos mli
*--------------------------------------
* ProDOS Block File Manager
*--------------------------------------
XDOS.bfmgr lda disptch,x translate into command address.
asl bit 7 indicates pathname to process
sta cmdtemp
and #$3F bit 6 is refnum, 5 is time to process
tax
lda cmdtable,x move address to indirect jump
sta H3274+1
lda cmdtable+1,x high byte
sta H3274+2
lda #$20 init backup bit flag
sta bkbitflg to say 'file modified'
bcc nopath
jsr setpath process pathname before calling command
bcs errorsys branch if bad name.
nopath asl cmdtemp test for refnum processing
bcc nopreref
jsr findfcb set pointers to fcb and vcb of file
bcs errorsys
nopreref asl cmdtemp check for necessity of time stamp
bcc H3274
jsr clockv date/time
H3274 jsr $FFFF SELF MODIFIED : execute command
bcc goodop
errorsys jsr GP.P8errv
goodop rts
setpath ldy #$01 index to pathname pointer
lda (A3L),y low pointer address
sta zpt
iny
lda (A3L),y hi pointer address
sta zpt+1
* entry used by rename for 2nd pathname.
synpath ldx #$00 x = index to pathbuf
ldy #$00 y = index to input pathname.
stx prfxflg assume prefix is in use.
stx pathbuf mark pathbuf = nothing processed.
lda (zpt),y validate pathname length > 0 and < 65
beq errsyn
cmp #$41
bcs errsyn
sta pathcnt this is used to compare for
inc pathcnt end of pathname processing.
iny now check for full pathname...
lda (zpt),y (full name if starts with '/')
ora #$80
cmp #$AF
bne H32AD branch if prefix appended.
sta prfxflg set prefix flag = prefix not used.
iny index to 1st character of pathname.
H32AD lda #$FF set current position of pathbuf
sta pathbuf,x to indicate end of pathname.
sta namcnt $FF = no chars processed in local name.
stx namptr pointer to local name length byte.
H32B8 cpy pathcnt done with pathname processing?
bcs endpath
lda (zpt),y get character
and #$7F
inx prepare for next char
iny
cmp #$2F is it delimiter '/' ?
beq endname yes
cmp #$61 lowercase?
bcc H32CD no
and #$5F shift to uppercase
H32CD sta pathbuf,x store char
inc namcnt is it the 1st char of a local name?
bne H32DA no
inc namcnt increment to 1
bne H32E6 1st char must be alpha (always taken)
H32DA cmp #$2E is it '.' ?
beq H32B8 ok, then do next char
cmp #$30 at least a '0' ?
bcc errsyn error if not
cmp #$3A is it numeric?
bcc H32B8 yes, get next char
H32E6 cmp #$41 at least an 'a' ?
bcc errsyn error if not
cmp #$5B is it > 'z' ?
bcc H32B8 branch if valid alpha to get next char
errsyn sec bad pathname
lda #$40
rts
endpath lda #$00 end pathname with a 0
bit namcnt also make sure count is positive
bpl H32FD
sta namcnt
dex
H32FD inx
sta pathbuf,x
beq errsyn error if '/' only.
stx pathcnt save length of pathname
tax
endname lda namcnt validate local name < 16
cmp #$10
bcs errsyn
phx save pointer
ldx namptr get index to beginning of local name
sta pathbuf,x save local name's length
plx restore pointer
bne H32AD branch if more names to process
clc probably no error, but
lda prfxflg make sure all pathnames are prefixed
bne H3323 or begin with a '/'.
lda newpfxptr must be non-zero
beq errsyn
H3323 rts
* set prefix command
setprefx jsr setpath call is made to detect if a null path.
bcc H3333 path ok.
ldy pathbuf is it a null pathname?
bne pfxerr error if not
jsr stypfx indicate null prefix
clc no error
rts
H3333 jsr findfile go find specified prefix directory.
bcc H333C if no error.
cmp #$40 bad pathname.
bne pfxerr branch if error is not root directory.
H333C lda d_stor make sure last local name is dir type
and #$D0 (either root or sub).
eor #$D0 directory?
bne ptyperr wrong type
ldy prfxflg new or appended prefix?
bne H334D
lda newpfxptr append new prefix to old
H334D tay
sec find new beginning of prefix
sbc pathcnt
cmp #$C0 too long?
bcc errsyn then error
tax
jsr stapfx
lda d_dev save device #
sta p_dev
lda d_frst and address of 1st block
sta p_blok
lda d_frst+1
sta p_blok+1
movprfx lda pathbuf,y
sta pathbuf,x
iny
inx
bne movprfx
clc good prefix
rts
ptyperr lda #$4B filetype error (not a directory)
pfxerr sec
rts
* get prefix command
getprefx clc calc how big a buffer is needed.
ldy #$01 get index to users pathname buffer
lda (A3L),y
sta usrbuf user buffer ptr
iny
lda (A3L),y
sta usrbuf+1
stz cbytes+1 set buffer length at 64 char max
lda #$40
sta cbytes
jsr valdbuf go validate prefix buffer address
bcs pfxerr
ldy #$00 y = indirect index to user buffer.
lda newpfxptr get address of beginning of prefix
tax
beq nulprfx if null prefix.
eor #$FF get total length of prefix
adc #$02 add 2 for leading and trailing slashes.
nulprfx sta (usrbuf),y store length in user's buffer.
beq gotprfx branch if null prefix.
sendprfx iny inc to next user buffer location.
lda pathbuf,x get next char of prefix.
sndlimit sta (usrbuf),y give char to user.
and #$F0 check for length descriptor.
bne H33B3 branch if regular character
lda #$2F otherwise, substitute a slash.
bne sndlimit branch always
H33B3 inx
bne sendprfx branch if more to send.
iny
lda #$2F end with '/'
sta (usrbuf),y
gotprfx clc no error
rts
findfcb ldy #$01 index to ref#
lda (A3L),y is it a valid file# ?
beq badref must not be 0.
cmp #$09 must be 1 to 8 only.
bcs badref
pha
dec
lsr
ror
ror
ror multiply by 32.
sta fcbptr used as an index to fcb
tay
pla restore ref# in acc
cmp fcbbuf,y
bne errnoref
fndfcbuf lda fcbbuf+11,y get page address of file buffer.
jsr getbufadr get file's address into bufaddrl,h
ldx bufaddrh (y=fcbptr preserved)
beq fcbdead fcb corrupted
stx datptr+1 save ptr to data area of buffer
inx
inx index block always 2 pages after data
stx zpt+1
lda fcbbuf+1,y also set up device #
sta devnum
lda bufaddrl
sta datptr index and data buffers always on
sta zpt page boundaries.
fndfvol tax search for associated vcb
lda vcbbuf+16,x
cmp fcbbuf+1,y is this vcb the same device?
beq tstvopen if it is, make sure volume is active.
nxtfvol txa adjust index to next vcb.
clc
adc #$20
bcc fndfvol loop until volume found.
lda #$0A open file has no volume so
jsr sysdeath kill the system.
fcbdead lda #$0B fcb error so
jsr sysdeath kill the system.
tstvopen lda vcbbuf,x make sure this vcb is open.
beq nxtfvol branch if it is not active.
stx vcbptr save ptr to good vcb.
clc no error
rts
errnoref lda #$00 put a zero into this fcb to
sta fcbbuf,y show free fcb.
badref lda #MLI.E.BADREF requested refnum is
sec illegal (out of range)
rts
* online command
online jsr mvdbufr figure out how big buffer has to be.
stz cbytes set this for valdbuf routine.
stz cbytes+1
ldy #$01
lda (A3L),y if 0 then cbytes=$100 else $010 for one
and #$F0 device. mask out unused nibble.
sta devnum last device used.
beq H343C branch if all devices.
lda #$10 cbytes = $010
sta cbytes
bne H343F always taken
H343C inc cbytes+1 cbytes = $100
H343F jsr valdbuf go validate buffer range against
bcs onlinerr allocated memory.
lda #$00 zero out user buffer space
ldy cbytes
H3449 dey
sta (usrbuf),y
bne H3449
sta namptr used as pointer to user buffer.
lda devnum get device # again.
bne online1 branch if only 1 device to process.
jsr mvdevnums get list of currently recognized dev's.
H3459 phx save index to last item on list
lda loklst,x
sta devnum save desired device to look at.
jsr online1 log this volume and return it's name.
lda namptr inc pointer for next device
clc
adc #$10
sta namptr
plx get index to device list.
dex next device.
bpl H3459 branch if there is another device.
lda #$00 no errors for multiple on-line
clc
onlinerr rts
online1 jsr fnddvcb see if it has already been logged in.
bcs olinerr1 branch if vcb is full.
ldx #$00 read in root (volume) directory
lda #$02
jsr rdblk read it into general purpose buffer.
ldx vcbptr index to the vcb entry.
bcc volfound branch if read was ok.
tay error value.
lda vcbbuf+17,x don't take the vcb offline if
bne rtrnerr there are active files present.
sta vcbbuf,x now take the volume offline
sta vcbbuf+16,x
rtrnerr tya error value.
bcs olinerr1 branch if unable to read.
volfound lda vcbbuf,x has it been logged in before?
beq H349E if not.
lda vcbbuf+17,x it has, are there active files?
bmi H34AA branch if volume is currently busy.
H349E jsr logvcb1 go log it in.
bcs olinerr1 branch if there is a problem.
lda #$57 anticipate a duplicate active volume
bit duplflag exits.
bmi olinerr1 branch if so.
H34AA ldx vcbptr
jsr cmpvcb does vol read compare with logged vol?
lda #$2E anticipate wrong volume mounted.
bcc H34D0 branch if ok.
olinerr1 pha save error code.
jsr svdevn report what device has problem.
pla error code.
iny tell what error was encountered.
sta (usrbuf),y
cmp #$57 duplicate volume error?
bne H34CE no.
iny report which other device has same name
ldx vcbentry
lda vcbbuf+16,x
sta (usrbuf),y
stz duplflag clear duplicate flag.
lda #$57 duplicate volume error code.
H34CE sec flag error
rts
H34D0 lda vcbbuf,x get volume name count
sta namcnt
ldy namptr index to user's buffer.
H34D9 lda vcbbuf,x move name to user's buffer
sta (usrbuf),y
inx
iny
dec namcnt
bpl H34D9
svdevn ldy namptr index to 1st byte of this entry.
lda devnum upper nibble = device# and
ora (usrbuf),y lower nibble = name length.
sta (usrbuf),y
clc no errors
rts end of block file manager
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.A
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

890
ProDOS.FX/ProDOS.S.XDOS.B.txt Normal file
View File

@ -0,0 +1,890 @@
NEW
AUTO 3,1
* create file
create jsr lookfile check for duplicate, get free entry
bcs tstfnf error code may be 'file not found'
lda #MLI.E.DUPFILE name already exists
crerr1 sec
rts
tstfnf cmp #MLI.E.FNOTFND 'file not found' is ok
bne crerr1 otherwise exit with error.
ldy #$07 test for tree or directory file,
lda (A3L),y no other kinds are legal.
cmp #$04 is it seed, sapling or tree?
bcc tstdspc branch if it is
cmp #$0D
bne ctyperr report type error if not directory.
tstdspc lda devnum make sure destination device
jsr twrprot1 is not write protected.
bcs H351D
lda nofree is there space in directory to
beq xtndir add this file? branch if not
jmp creat1 otherwise, go create file.
ctyperr lda #MLI.E.UNSUPST filetype error
sec
H351D rts
xtndir lda own_blk before extending directory,
ora own_blk+1 make sure it's a subdirectory.
bne H352A
lda #MLI.E.DIRFULL otherwise, directory full error
sec
rts
H352A lda bloknml preserve disk address of current (last)
pha directory link, before allocating an
lda bloknml+1 extended block.
pha
jsr alc1blk allocate a block for extending directory
plx
stx bloknml+1 restore block addr of dir info in gbuf
plx
stx bloknml
bcs H351D unable to allocate.
sta gbuf+2 save block address in y,a to
sty gbuf+3 current directory.
jsr wrtgbuf update directory block with new link.
bcs H351D if error
ldx #$01
swpbloks lda bloknml,x prepare new directory block
sta gbuf,x using current block as back link
lda gbuf+2,x
sta bloknml,x and save new block as next to be written
dex
bpl swpbloks
inx
txa x and a = 0
clrdir sta gbuf+2,x
sta gbuf+$100,x
inx
bne clrdir
jsr wrtgbuf write prepared directory extension.
bcs H351D if error
lda own_blk
ldx own_blk+1
jsr rdblk read in parent directory block
ldx own_ent and calc entry address.
lda /gbuf
sta zpt+1
lda #$04
ocalc clc
dex has entry address been calulated?
beq H3584 if yes.
adc own_len next entry address
bcc ocalc
inc zpt+1 entry must be in 2nd 256 bytes of block
bcs ocalc always taken.
H3584 sta zpt
ldy #$13 index to block count
H3588 lda (zpt),y
adc dinctbl-$13,y add 1 to block count and
sta (zpt),y
iny
tya $200 to the directory's eof.
eor #$18 done with usage/eof update?
bne H3588 branch if not.
jsr wrtgbuf go update parent.
bcs crerr2
jmp create
crerr2 rts return and report errors
creat1 ldx #$00 zero out gbuf
H35A0 stz gbuf,x
stz gbuf+$100,x and data block of file.
inx
bne H35A0
ldy #$0B move user specified date/time
cmvtime lda (A3L),y to directory.
sta d_filid,y
txa if all 4 bytes of date/time = 0
ora (A3L),y then use built-in date/time.
tax
dey
cpy #$07
bne cmvtime
txa does user want default time?
bne cmvname if not.
ldx #$03
mvdftime lda p8date,x move current default date/time
sta d_credt,x
dex
bpl mvdftime
cmvname lda (A3L),y y = index to file kind.
cmp #$04
lda #$10 assume tree type
bcc csvfkind
lda #$D0 it's directory.
csvfkind ldx namptr index to local name of pathname.
ora pathbuf,x combine file kind with name length.
sta d_stor sos calls this 'storage type'.
and #$0F strip back to name length
tay and use as counter for move.
clc
adc namptr calc end of name
tax
crname lda pathbuf,x move local name as filename
sta d_stor,y
dex
dey
bne crname
ldy #$03 index to 'access' parameter
lda (A3L),y
sta d_attr
iny also move 'file identification'
lda (A3L),y
sta d_filid
cmvauxid iny move auxillary identification bytes
lda (A3L),y
sta d_auxid-5,y
cpy #$06
bne cmvauxid
lda xdosver save current xdos version #
sta d_sosver
lda compat and backward compatibility #
sta d_comp
lda #$01 usage is always 1 block
sta d_usage
lda d_head place back pointer to header block
sta d_dhdr
lda d_head+1
sta d_dhdr+1
lda d_stor storage type.
and #$E0 is it a directory?
beq cralcblk branch if seed file.
ldx #$1E move header to data block
cmvheadr lda d_stor,x
sta gbuf+4,x
dex
bpl cmvheadr
eor #$30
sta gbuf+4 make it a directory header mark.
ldx #$07 overwrite password area and other
cmvpass lda pass,x header info.
sta gbuf+20,x
lda xdosver,x
sta gbuf+32,x
dex
bpl cmvpass
ldx #$02 and include info about parent directory
stx d_eof+1
cmvparnt lda d_entblk,x
sta gbuf+39,x
dex
bpl cmvparnt
lda h_entln lastly, the length of parent's
sta gbuf+42 directory entries.
cralcblk jsr alc1blk get address of file's data block
bcs crerr3
sta d_frst
sty d_frst+1
sta bloknml
sty bloknml+1
jsr wrtgbuf go write data block of file
bcs crerr3
inc h_fcnt add 1 to total # of files in this dir
bne credone
inc h_fcnt+1
credone jsr drevise go revise directories with new file
bcs crerr3
jmp upbmap lastly, update volume bitmap
entcalc lda /gbuf set high address of dir entry
sta zpt+1 index pointer.
lda #$04 calc address of entry based
ldx d_entnum on the entry #.
H3689 clc
H368A dex addr = gbuf + ((d_entnum-1) * h_entln)
beq H3696 branch with carry clear = no errors.
adc h_entln
bcc H368A
inc zpt+1 inc hi address.
bcs H3689 always.
H3696 sta zpt newly calculated low address.
crerr3 rts carry set if error.
drevise lda p8date
beq drevise1 if no clock, then don't mod date/time.
ldx #$03
modtime lda p8date,x move last modification date/time
sta d_moddt,x to entry being updated.
dex
bpl modtime
drevise1 lda d_attr mark entry as backupable
ora bkbitflg (bit 5 = backup needed)
sta d_attr
lda d_dev get device # of directory
sta devnum to be revised
lda d_entblk and address of direcotry block.
ldx d_entblk+1
jsr rdblk read block into general purpose buffer
bcs crerr3
jsr entcalc fix up ptr to entry location within gbuf.
ldy h_entln now move 'd.' info to directory.
dey
H36CA lda d_stor,y
sta (zpt),y
dey
bpl H36CA
lda d_head is the entry block same as
cmp bloknml the entry's header block?
bne H36E0 if no, go save entry block
lda d_head+1 then maybe, so test high addresses.
cmp bloknml+1
beq uphead branch if they are the same block.
H36E0 jsr wrtgbuf go write updated directory block.
bcs crerr3
lda d_head get address of header block and
ldx d_head+1
jsr rdblk go read in header block to modify.
bcs crerr3
uphead ldy #$01 update current # of files in this dir.
H36F2 lda h_fcnt,y
sta gbuf+37,y (current entry count)
dey
bpl H36F2
lda h_attr also update header's attributes.
sta gbuf+34
jsr wrtgbuf go write updated header
bcs H375A
ripple lda gbuf+4 test for 'root' directory because
and #$F0 if it is, then directory revision
eor #$F0 is complete (leaves carry clear).
beq H3770 branch if done.
lda gbuf+41 get entry #
sta d_entnum
lda gbuf+42 and the length of ertries in that dir
sta h_entln
lda gbuf+39 get addr of parent entry's dir block
ldx gbuf+40
jsr rdblk read it
bcs H375A
jsr entcalc get indirect ptr to parent entry in gbuf
lda p8date don't touch mod
beq H373B if no clock...
ldx #$03 update the modification date & time
ldy #$24 for this entry too
H3732 lda p8date,x
sta (zpt),y
dey
dex
bpl H3732
H373B jsr wrtgbuf write updated entry back to disk.
bcs H375A if error.
ldy #$25 compare current block # to this
lda (zpt),y entry's header block.
iny
cmp bloknml are low addresses the same?
sta bloknml
bne H3751 branch if entry doesn't reside in same
lda (zpt),y block as header.
cmp bloknml+1 are high address the same?
beq ripple they are the same, continue to root dir.
H3751 lda (zpt),y not same so read in this dir's header.
sta bloknml+1
jsr rdgbuf
bcc ripple continue if read was good
H375A rts
tsterr lda #$52 not tree or dir, unrecognized type
sec
rts
tstsos lda gbuf pointer to previous dir block
ora gbuf+1 must be null
bne tsterr
lda gbuf+4 test for header
and #$E0
cmp #$E0
bne tsterr
H3770 clc no error
rts
findfile jsr lookfile see if file exists
bcs nofind
moventry ldy h_entln
H377A lda (zpt),y move entry into storage
sta d_stor,y
dey
bpl H377A
lda #$00 no errors
nofind rts
lookfile jsr preproot go find volume
bcs fnderr
bne lookfil0 branch if more than root
lda /gbuf otherwise, report a bad path error
sta zpt+1 (but 1st create a phantom entry
lda #$04 for open)
sta zpt
ldy #$1F move in id and date info
phantm1 lda (zpt),y
sta d_stor,y
dey
cpy #$17
bne phantm1
phantm2 lda rootstuf-$10,y
sta d_stor,y
dey
cpy #$0F
bne phantm2
lda #$D0 fake directory file
sta d_stor
lda gbuf+2 check forward link.
ora gbuf+3 if non-zero, assume full sized directory
bne H37C2 else assume it's the slot 3 /RAM volume
lda #$02 so reset eof and blocks_used fields
sta d_eof+1
lda #$01
sta d_usage
H37C2 lda #MLI.E.INVPATH bad path (carry set)
rts
lookfil0 stz nofree reset free entry indicator.
sec dir to be searched has header in this block.
L37C9 stz totent reset entry counter.
jsr looknam look for name pointed to by pnptr.
bcc namfound if name was found.
lda entcntl have we looked at all of the
sbc totent entries in this directory?
bcc L37E2 maybe, check hi count.
bne L37EB no, read next directory block.
cmp entcnth has the last entry been looked at?
beq errfnf yes, give 'file not found' error
bne L37EB or branch always.
L37E2 dec entcnth should be at least one
bpl L37EB so this should be branch always...
errdir lda #MLI.E.BADDIR directory error
fnderr sec
rts
L37EB sta entcntl keep a running count.
lda /gbuf reset indirect pointer
sta zpt+1
lda gbuf+2 get link to next dir block
bne L37FC (if there is one).
cmp gbuf+3 are both zero, i.e. no link? if so,
beq errdir then not all entries were acct'd for.
L37FC ldx gbuf+3 acc has value for block# (low).
jsr rdblk go read the next linked directory.
bcc L37C9 if no error.
rts return error in acc.
errfnf lda nofree was any free entry found?
bne fnf0
lda gbuf+2 test link
bne L3814
cmp gbuf+3 if both are 0 then give up.
beq fnf0 report 'not found'.
L3814 sta d_entblk
lda gbuf+3
sta d_entblk+1 assume 1st entry of next block
lda #$01 is free for use.
sta d_entnum mark as valid (for create)
sta nofree
fnf0 jsr nxtpnam1 'file not found' or 'path not found'?
errpath1 sec if non-zero then 'path not found'
beq fnf1
lda #MLI.E.PNOTFND path not found
rts
fnf1 lda #MLI.E.FNOTFND file not found
rts
namfound jsr nxtpname adj index to next name in path.
beq filfound branch if that was the last name.
ldy #$00 be sure this is a directory entry.
lda (zpt),y high nibble will tell.
and #$F0
cmp #$D0 is it a subdirectory?
bne errpath1 error if not.
ldy #$11 get address of 1st subdirectory block
lda (zpt),y
sta bloknml (no checking done for a valid block#)
iny
sta d_head save as file's header block too
lda (zpt),y
sta bloknml+1
sta d_head+1
jsr rdgbuf read subdirectory into gbuf.
bcs fnderr1 if error.
lda gbuf+37 get the # of files contained in this
sta entcntl directory.
lda gbuf+38
sta entcnth
lda gbuf+20 make sure password is disabled
ldx #$00
sec
rol
L3869 bcc L386C
inx
L386C asl
bne L3869
cpx #$05 is password disabled?
beq movhead
lda #MLI.E.INCFF directory is not compatible
fnderr1 sec
rts
movhead jsr movhed0 move directory info.
jmp lookfil0 do next local pathname.
movhed0 ldx #$0A move this directory info
L387F lda gbuf+28,x
sta h_credt,x
dex
bpl L387F
lda gbuf+4 if this is root, then nothing to do
and #$F0
eor #$F0 test header type.
beq L389C branch if root
ldx #$03 otherwise, save owner info about
L3893 lda gbuf+39,x this header.
sta own_blk,x
dex
bpl L3893
L389C rts
filfound lda h_maxent figure out which entry # this is
sec
sbc cntent max entries - count entries + 1
adc #$00 = entry # (carry was set)
sta d_entnum
lda bloknml and indicate block # of this directory
sta d_entblk
lda bloknml+1
sta d_entblk+1
clc
rts
looknam lda h_maxent reset count of files per block
sta cntent
lda /gbuf
sta zpt+1
lda #$04
L38C1 sta zpt reset indirect pointer to gbuf
bcs L38F8 branch if this block contains a header
ldy #$00
lda (zpt),y get length of name in directory.
bne isname branch if there is a name.
lda nofree test if a free entry has been declared.
bne L38F8 yes, inc to next entry.
jsr filfound set address for current entry.
inc nofree indicate a free spot has been found.
bne L38F8 always.
isname and #$0F strip byte (is checked by 'filfound')
inc totent inc count of valid files found.
sta namcnt save name length as counter.
ldx namptr get index to current path.
cmp pathbuf,x are both names the same length?
bne L38F8 no, inc to next entry.
cmpname inx (first) next letter index
iny
lda (zpt),y compare names letter by letter
cmp pathbuf,x
bne L38F8
dec namcnt all letters compared?
bne cmpname no, continue.
clc a match is found.
noname rts
L38F8 dec cntent checked all entries in this block?
sec
beq noname yes, no name match.
lda h_entln add entry length to current pointer
clc
adc zpt
bcc L38C1 branch if still in 1st page.
inc zpt+1 look on 2nd page.
clc carry should always be clear before
bcc L38C1 looking at next.
preproot jsr findvol search vcb's and dev's for spec'd volume
bcs novolume
lda #$00 zero out directory temps
ldy #$42
L3914 sta own_blk,y and owner info
dey
bpl L3914
lda devnum setup device # for this directory
sta d_dev
jsr movhed0 setup other header info from directory
ldy #$01 in gbuf and clean up misc info.
ldx vcbptr
inx
L3929 lda vcbbuf+18,x misc info includes
sta h_tblk,y total # of blocks,
lda vcbbuf+26,x the address of the 1st bitmap,
sta h_bmap,y
lda bloknml,y directory's disk address,
sta d_head,y
lda h_fcnt,y and setting up a counter for the # of
sta entcntl,y files in this directory.
dex
dey
bpl L3929
nxtpname jsr nxtpnam1 get new namptr in y and namlen in acc.
sty namptr save new pathname pointer.
rts (status reg according to accumulator)
nxtpnam1 ldy namptr inc pathname pointer to next name
lda pathbuf,y in the path.
sec
adc namptr if this addition results in zero,
tay then prefixed directory has been moved
bne L395F to another device. branch if not.
lda devnum revise devnum for prefixed directory
sta p_dev
L395F lda pathbuf,y test for end of name.
clc no errors
novolume rts
findvol lda #$00
ldy preflag use prefix volume name to look up vcb.
bit prfxflg is this a prefixed path?
bpl L396F branch if it is
tay set ptr to volume name
L396F sty vnptr and save.
sta devnum zero out dev# until vcb located.
L3975 pha acc now used as vcb lookup index.
tax index pointer to x.
lda vcbbuf,x get vcb volume name length.
bne L3987 branch if claimed vcb to be tested.
L397C ldy vnptr restore pointer to requested vol name.
pla now adj vcb index to next vcb entry.
clc
adc #$20
bcc L3975 branch if more vcb's to check
bcs L39D4 otherwise go look for unlogged volumes.
L3987 sta namcnt save length of vol name to be compared.
L398A cmp pathbuf,y is it the same as requested vol name?
bne L397C branch if not
inx
iny next character
lda vcbbuf,x
dec namcnt last character?
bpl L398A if not.
plx restore pointer to matching vcb.
stx vcbptr save it for future reference.
lda vcbbuf+16,x get it's device #
sta devnum and save it.
stz bloknml+1 assume prefix is not used and
lda #$02 that root directory is to be used.
sta bloknml
lda vnptr = 0 if no prefix.
L39AC tay if prefix then find ptr to prefixed
sta namptr dir name. save path ptr.
beq L39C2 branch if no prefix.
sec
adc pathbuf,y inc to next dir in prefix path.
bcc L39AC branch if another dir in prefix.
lda p_blok volume verification will occur at
sta bloknml subdirectory level.
lda p_blok+1
sta bloknml+1
* verify volume name
L39C2 jsr rdgbuf read in directory (or prefix dir)
bcs L39CC if error then look on other devices.
jsr cmppnam compare dir name with path name.
bcc L39F0 if they match, stop looking.
L39CC ldx vcbptr check if current (matched) vcb is active
lda vcbbuf+17,x i.e. does it have open files?
bmi L39ED report not found if active.
L39D4 lda vnptr make path ptr same as volume ptr
sta namptr
jsr mvdevnums copy all device #'s to be examined.
lda devnum log current device 1st before searching
bne L39F1 others.
L39E2 ldx numdevs scan look list for devices we need
L39E5 lda loklst,x to search for the requested volume.
bne L39F4 branch if we've a device to look at.
dex
bpl L39E5 look at next one.
L39ED lda #MLI.E.VNOTFND no mounted volume
sec error
L39F0 rts
L39F1 ldx numdevs now remove the device from the list
L39F4 cmp loklst,x of prospective devices.
beq L39FE branch if match.
dex look until found.
bpl L39F4 always taken (usually) unless
bmi L39ED if dev was removed from devlst (/RAM).
L39FE sta devnum preserve device to be checked next.
stz loklst,x mark this one as tested.
jsr fnddvcb find vcb that claims this dev (if any).
bcs L3A29 branch if vcb full.
ldx vcbptr did fndvcb find it or return free vcb?
lda vcbbuf,x
beq L3A16 if free vcb.
lda vcbbuf+17,x is this volume active?
bmi L39E2 if so, no need to re-log.
L3A16 lda #$02 go read root dir into gbuf
ldx #$00
jsr rdblk
bcs L39E2 ignore if unable to read.
jsr logvcb go log in volume name.
bcs L39E2 look at next if non-xdos disk mounted.
jsr cmppnam is this the volume ?
bcs L39E2 if not
L3A29 rts
mvdevnums ldx numdevs copy all dev #'s to be checked.
L3A2D lda devlist,x active device list.
and #$F0 strip device type info.
sta loklst,x copy them to a temp workspace
dex
bpl L3A2D
ldx numdevs
rts
fnddvcb lda #$00 look for vcb with this device#
ldy #$FF
L3A40 tax new index to next vcb
lda vcbbuf+16,x check all devnums
cmp devnum is this the vcb?
bne L3A4E if not
stx vcbptr
clc indicates found
rts
L3A4E lda vcbbuf,x is this a free vcb?
bne L3A57 if not
iny
stx vcbptr
L3A57 txa
clc inc index to next vcb
adc #$20
bne L3A40
tya any free vcb's available?
bpl L3A79 yes
lda #$00 look for an entry to kick out
L3A62 tax
lda vcbbuf+17,x any open files?
bpl L3A70 no, kick this one out.
txa next vcb
clc
adc #$20 (vcb entry size)
bne L3A62
beq L3A7A all vcb entries have open files
L3A70 stx vcbptr save entry index.
stz vcbbuf,x free this entry
stz vcbbuf+16,x
L3A79 clc no error.
L3A7A lda #$55 # vcb full error
rts
cmppnam ldx #$00 index to directory name.
ldy namptr index to pathname.
lda gbuf+4 get dir name length and type.
cmp #$E0 is it a directory?
bcc L3A90 if not.
and #$0F isolate name length and
sta namcnt save as a counter.
bne L3A95 branch if valid length.
L3A90 sec indicate not found
rts
L3A92 lda gbuf+4,x next char
L3A95 cmp pathbuf,y
bne L3A90 if not the same.
inx check next char
iny
dec namcnt
bpl L3A92 if more to compare.
clc match found
rts
logvcb ldx vcbptr previously logged in volume?
lda vcbbuf,x (acc = 0?)
beq logvcb1 no, go prepare vcb.
jsr cmpvcb does vcb match vol read?
bcc L3B05 yes, do not disturb.
logvcb1 ldy #$1F zero out vcb entry
L3AB2 stz vcbbuf,x
inx
dey
bpl L3AB2
jsr tstsos make sure it's an xdos disk
bcs L3B05 if not, return carry set.
jsr tstdupvol does a duplicate with open files
bcs L3B04 already exist? branch if yes.
lda gbuf+4 move volume name to vcb.
and #$0F strip root marker
tay
pha
ora vcbptr
tax
L3ACE lda gbuf+4,y
sta vcbbuf,x
dex
dey
bne L3ACE
pla get length again
sta vcbbuf,x and save.
lda devnum last device used.
sta vcbbuf+16,x save device # and
lda gbuf+41 total # of blocks on this unit.
sta vcbbuf+18,x
lda gbuf+42
sta vcbbuf+19,x
lda bloknml save address of root directory.
sta vcbbuf+22,x
lda bloknml+1
sta vcbbuf+23,x
lda gbuf+39 save address of the 1st bitmap.
sta vcbbuf+26,x
lda gbuf+40
sta vcbbuf+27,x
L3B04 clc indicate logged if possible
L3B05 rts
cmpvcb lda gbuf+4 with name in directory.
and #$0F
cmp vcbbuf,x are they the same length?
stx xvcbptr (see rev note #23)
bne L3B1E if not the same.
tay
ora xvcbptr
tax
L3B18 lda gbuf+4,y
cmp vcbbuf,x
L3B1E sec anticipate different names.
bne L3B26 if not the same.
dex
dey
bne L3B18
clc indicate match.
L3B26 ldx xvcbptr offset to start of vcb (rev note #23)
rts
tstdupvol lda #$00 check for other logged in volumes with the same name.
L3B2C tax
jsr cmpvcb
bcs L3B41 if no match.
lda vcbbuf+17,x test for any open files.
bmi L3B4B cannot look at this volume.
lda #$00 take duplicate offline if no open files
sta vcbbuf,x
sta vcbbuf+16,x
beq L3B49 ok to log in new volume.
L3B41 txa index to next vcb
clc
and #$E0 strip odd stuff.
adc #$20 inc to next entry.
bcc L3B2C branch if more to check
L3B49 clc
rts
L3B4B sta duplflag duplicate has been found.
stx vcbentry save pointer to conflicting vcb.
sec error.
rts
tstfrblk ldx vcbptr test if enough free blocks available for request.
lda vcbbuf+21,x check if proper count for this volume.
ora vcbbuf+20,x
bne L3BAD branch if count is non-zero.
tkfrecnt jsr cntbms get # of bitmaps
sta bmcnt and save.
stz scrtch start count at 0
stz scrtch+1
lda #$FF mark 'first free' temp as unknown
sta nofree
jsr upbmap update volume bitmap.
bcs L3BC1 if error.
ldx vcbptr get address of 1st bitmap
lda vcbbuf+26,x
sta bloknml
lda vcbbuf+27,x
sta bloknml+1
L3B81 jsr rdgbuf use general buffer for temp space to
bcs L3BC1 count free blocks (bits).
jsr count
dec bmcnt was that the last bitmap?
bmi L3B96 if so, go change fcb so not done again.
inc bloknml
bne L3B81
inc bloknml+1
bra L3B81
L3B96 ldx vcbptr mark which block had 1st free space
lda nofree
bmi L3BBE if no free space was found.
sta vcbbuf+28,x update the free count.
lda scrtch+1 sta vcbbuf+21,x update volume control byte.
lda scrtch
sta vcbbuf+20,x
L3BAD lda vcbbuf+20,x compare total available free blocks
sec on this volume.
sbc reql
lda vcbbuf+21,x
sbc reqh
bcc L3BBE
clc
rts
L3BBE lda #MLI.E.VOLFULL
sec
L3BC1 rts
count ldy #$00
L3BC4 lda gbuf,y bit pattern.
beq L3BCC don't count
jsr cntfree
L3BCC lda gbuf+$100,y do both pages with same loop
beq L3BD4
jsr cntfree
L3BD4 iny
bne L3BC4 loop until all 512 bytes counted.
bit nofree has 1st block w/free space been found?
bpl L3BEE if yes.
lda scrtch test to see if any blocks were counted
ora scrtch+1
beq L3BEE branch if none counted.
jsr cntbms get total # of maps.
sec subtract countdown from total bitmaps
sbc bmcnt
sta nofree
L3BEE rts
cntfree asl count the # of bits in this byte
bcc L3BFA
inc scrtch
bne L3BFA
inc scrtch+1
L3BFA ora #$00
bne cntfree loop until all bits counted
rts
cntbms ldx vcbptr
ldy vcbbuf+19,x return the # of bitmaps
lda vcbbuf+18,x possible with the total count
bne L3C0B found in the vcb.
dey adj for bitmap block boundary
L3C0B tya
lsr divide by 16. the result is
lsr the # of bitmaps.
lsr
lsr
rts
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.B
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

720
ProDOS.FX/ProDOS.S.XDOS.C.txt Normal file
View File

@ -0,0 +1,720 @@
NEW
AUTO 3,1
* deallocate a block's entry in bitmap
* on entry, x,a = address of block
dealloc stx bmcnt high address of block.
pha save low address.
ldx vcbptr check that bitmap block address is
lda vcbbuf+19,x valid given the total # of blocks
cmp bmcnt on the volume.
pla
bcc L3C8C branch if invalid
tax
and #$07 bit to be or'd in
tay
lda whichbit,y (shifting takes 7 bytes, but is slower)
sta nofree save bit pattern.
txa low block address.
lsr bmcnt
ror get pointer to byte in block that
lsr bmcnt represents the block address.
ror
lsr bmcnt
ror
sta bmptr save pointer.
lsr bmcnt transfer bit which is page of bitmap
rol half
jsr fndbmap make sure device is correct one.
bcs L3C8B error.
lda bmacmap current map.
cmp bmcnt is in-core bitmap the correct one ?
beq L3C64 branch if yes.
jsr upbmap put current map away.
bcs L3C8B error.
lda bmcnt get map #
ldx vcbptr
sta vcbbuf+28,x and make it current.
lda bmadev
jsr gtbmap read it into buffer
bcs L3C8B
L3C64 ldy bmptr index to byte
lsr half
lda nofree (get indiviual bit)
bcc bmbufhi branch if on page 1 of bitmap
ora bmbuf+$100,y
sta bmbuf+$100,y
bcs L3C7D always.
bmbufhi ora bmbuf,y this address + 2 is used as an absolute reference to bmbuf high byte.
sta bmbuf,y
L3C7D lda #$80 mark bitmap as modified
tsb bmastat
inc deblock inc count of blocks deallocated
bne L3C8A
inc deblock+1
L3C8A clc
L3C8B rts
L3C8C lda #$5A bitmap block # impossible.
sec bitmap disk address wrong
rts (maybe data masquerading as indx block)
alc1blk jsr fndbmap get address of bitmap.
bcs L3CB8 error.
L3C95 ldy #$00 begin search at start of bitmap block.
sty half which half (page) to search
L3C9A lda bmbuf,y
bne L3CB9 free blocks indicated by 'on' bits
iny
bne L3C9A check all in 1st page.
inc half now search page 2.
inc basval base value = base address / 2048.
L3CA8 lda bmbuf+$100,y search 2nd half for free block
bne L3CB9
iny
bne L3CA8
inc basval add 2048 offset for next page.
jsr nxtbmap get next bitmap (if exists) and
bcc L3C95 update vcb. branch if no error.
L3CB8 rts return error.
L3CB9 sty bmptr save index pointer to valid bit group.
lda basval prep for block address calculation
sta scrtch+1
tya address of bit pattern.
asl multiply this and basval by 8
rol scrtch+1
asl
rol scrtch+1
asl
rol scrtch+1
tax low address within 7 of actual address
sec
lda half
beq L3CDB branch if allocating from 1st half.
lda bmbuf+$100,y get pattern from 2nd page.
bcs L3CDE always.
L3CDB lda bmbuf,y get bit pattern from 1st page.
L3CDE rol find left most 'on' bit
bcs L3CE4 if found.
inx adjust low address.
bne L3CDE always.
L3CE4 lsr restore pos'n of all but left most bit.
bcc L3CE4 loop until mark moves into carry.
stx scrtch save low address.
ldx half which half of bitmap ?
bne L3CF4 if page 2.
sta bmbuf,y
beq L3CF7 always.
L3CF4 sta bmbuf+$100,y update to show allocated block in use.
L3CF7 lda #$80 indicate map is modified.
tsb bmastat
ldy vcbptr subtract 1 from total free vcb blocks
lda vcbbuf+20,y to account for newly allocated block.
sbc #$01 (carry is set)
sta vcbbuf+20,y
bcs L3D10 if high free count doesn't need adj.
lda vcbbuf+21,y adjust high count
dec
sta vcbbuf+21,y
L3D10 clc no errors.
lda scrtch return address in y,a of newly
ldy scrtch+1 allocated block.
rts
nxtbmap ldy vcbptr inc to next bitmap, but 1st make sure there is another one.
lda vcbbuf+19,y
lsr
lsr
lsr
lsr
cmp vcbbuf+28,y are there more maps ?
beq L3D60 if no more to look at.
lda vcbbuf+28,y add 1 to current map
inc
sta vcbbuf+28,y
jsr upbmap
fndbmap ldy vcbptr
lda vcbbuf+16,y get device #.
cmp bmadev does this map match this device ?
beq L3D4A yes.
jsr upbmap otherwise, save other volume's bitmap
bcs L3D5F
ldy vcbptr
lda vcbbuf+16,y
sta bmadev and read in fresh bitmap for this dev.
L3D4A ldy bmastat is it already modified ?
bmi L3D54 yes, return pointer
jsr gtbmap otherwise read in fresh bitmap.
bcs L3D5F if error.
L3D54 ldy vcbptr get relative block # of bitmap.
lda vcbbuf+28,y
asl 2 pages per block
sta basval
clc no errors.
L3D5F rts
L3D60 lda #$48 request can't be filled
sec error
rts
upbmap clc
lda bmastat is current map modified ?
bpl L3D5F no.
jsr wrtbmap update device.
bcs L3D5F if error on writing.
lda #$00
sta bmastat mark bitmap buffer as free
rts
gtbmap sta bmadev read bitmap specified by dev and vcb.
ldy vcbptr get lowest map # with free blocks in it
lda vcbbuf+28,y
sta bmacmap associate offset with bitmap ctrl block.
clc add this # to the base address of
adc vcbbuf+26,y 1st bitmap and save in bmadadr which
sta bmadadr is address of bitmap to be used.
lda vcbbuf+27,y
adc #$00
sta bmadadr+1
lda #$01 read device command
L3D92 sta A4L
lda devnum save current dev #
pha
lda bmadev get bitmap's dev #
sta devnum
lda bmadadr and disk address
sta bloknml
lda bmadadr+1
sta bloknml+1
lda bmbufhi+2 address of the buffer (low = 0)
jsr dobitmap
tax error code (if any).
pla restore current dev #
sta devnum
bcc L3DB6 and return it if no error.
txa error code
L3DB6 rts
rdblk sta bloknml
stx bloknml+1
jsr rdgbuf
rts
wrtbmap lda #$02 write command.
bne L3D92 always.
wrtgbuf lda #$02 write command
bne L3DC9 always.
rdgbuf lda #$01 read command.
L3DC9 sta A4L pass to device handler.
lda /gbuf general buffer.
dobitmap php no interrupts
sei
sta buf+1 buffer high.
stz buf buffer low (always on page boundary)
stz p8error clear global error code.
lda #$FF indicates reg call made to dev handler
sta ioaccess
lda devnum transfer dev # for dispatcher to
sta unitnum convert to unit #.
jsr dmgr call the driver.
bcs L3DE8 if error.
plp restore interrupts.
clc
rts
L3DE8 plp file i/o error. restore interrupts.
sec
rts
* get mark command
getmark ldx fcbptr index to open fcb.
ldy #$02 index to user's mark parmeter.
.1 lda fcbbuf+18,x transfer current position
sta (A3L),y to user's parameter list
inx
iny
cpy #$05 transfer 3 bytes
bne .1
clc
rts
L3DFD lda #$4D invalid position
sec
rts
* set mark command
setmark ldy #$04 index to user's desired position.
ldx fcbptr file's control block index.
inx inc by 2 for index to hi eof
inx
sec indicate comparisons are necessary.
.1 lda (A3L),y move it to 'tpos'
sta tposll-2,y
bcc .2 branch if mark < eof
cmp fcbbuf+21,x
bcc .2 branch if mark qualifies.
bne L3DFD branch if mark > eof (invalid position)
dex
.2 dey move/compare next lower byte of mark.
tya test for all bytes moved/tested.
eor #$01 preserves carry status.
bne .1 branch if more.
rdposn ldy fcbptr test to see if new position is
lda fcbbuf+19,y within the same (current) data block.
and #$FE
sta scrtch
lda tposlh middle byte of new position
sec
sbc scrtch
sta scrtch
bcc L3E44 branch if < current position.
cmp #$02 must be within 512 bytes of beginning
bcs L3E44 of current position.
lda tposhi make sure within the same 64k.
cmp fcbbuf+20,y
bne L3E44 branch if not.
jmp svmark if so, adj fcb, position ptr and return.
L3E44 lda fcbbuf+7,y determine file type for positioning.
beq L3E50 0 = invalid file type.
cmp #$04 tree class file?
bcc L3E59 yes, go position.
jmp dirmark no, test for dir type.
L3E50 ldy #$A4 clear illegal filetype entry in fcb
sta fcbbuf,y
lda #$43 and report error
sec
rts
L3E59 lda fcbbuf+7,y use storage type as # of index levels
sta levels since 1=seed, 2=sapling, 3=tree.
lda fcbbuf+8,y
and #$40 if previous data was modified then
beq L3E6B disk must be updated.
jsr wfcbdat
bcs L3ED4 if error.
L3E6B ldy fcbptr test to see if current index block
lda fcbbuf+20,y is usable by checking if new
and #$FE position is within 128k of the
sta scrtch beginning of current sapling level
lda tposhi chunk.
sec
sbc scrtch
bcc L3E9D branch if a new index block is needed.
cmp #$02 is new position within 128k of old ?
bcs L3E9D branch if not.
ldx levels is it a seed file ?
dex
bne datlevel no, use current indexes.
L3E89 lda tposlh is new position < 512 ?
lsr
ora tposhi
bne L3EEF no, mark both data and index block as
lda fcbbuf+12,y unallocated. 1st block is only block
sta bloknml and it's data.
lda fcbbuf+13,y high block address.
jmp rnewpos go read in block and set statuses.
L3E9D lda fcbbuf+8,y check to see if previous index block
and #$80 was modified.
beq L3EA9 read in over it if current up to date.
jsr wfcbidx go update index on disk (fcb block addr)
bcs L3ED4
L3EA9 ldx levels be sure there is a top index
cpx #$03 before reading it...
beq posindex branch if file is a tree.
lda tposhi is new position within range of a
lsr sapling file (less than 128k) ?
php save results
lda #$07 (no level is allocated for new pos'n)
plp restore z-flag.
bne L3F18 go mark all as dummy.
jsr clrstats clr status bits 0,1,2 (index/data/alloc)
dex check for seed
beq L3E89 if seed, check for position < 512.
jsr rfcbfst go get only index block.
bcs L3ED4 if error.
ldy fcbptr save newly loaded index block's address.
lda bloknml
sta fcbbuf+14,y
lda bloknml+1
sta fcbbuf+15,y
bcc datlevel branch always
L3ED4 rts
posindex jsr clrstats clr all alloc requirements for previous
jsr rfcbfst position. get highest level index block
bcs L3ED4
lda tposhi then test for a sap level index block
lsr
tay
lda (zpt),y
inc zpt+1
cmp (zpt),y (both high and low = 0 if no index exists)
bne saplevel
tax are both bytes 0 ?
bne saplevel
dec zpt+1
L3EEF lda #$03 show neither index or data block alloc'd
bra L3F18
saplevel sta bloknml read in next lower index block.
lda (zpt),y (high address)
sta bloknml+1
dec zpt+1
jsr rfcbidx read in sapling level
bcs L3ED4
datlevel lda tposhi get block address of data block
lsr
lda tposlh ( if there is one )
ror
tay
lda (zpt),y data block address low
inc zpt+1
cmp (zpt),y
bne L3F51
tax
bne L3F51
lda #$01 show data block as never been allocated
dec zpt+1
L3F18 ldy fcbptr set status to show what's missing
ora fcbbuf+8,y
sta fcbbuf+8,y
lsr discard bit that says data block
lsr unallocated because carry indicates if
jsr zipdata index block is invalid and needs to be
bcc svmark zeroed. branch if it doesn't need zeroed
jsr zeroindex zero index block in user's i/o buffer
bra svmark
zeroindex lda #$00
tay
L3F30 sta (zpt),y zero out the index half of the user's
iny i/o buffer
bne L3F30
inc zpt+1
L3F37 sta (zpt),y
iny
bne L3F37
dec zpt+1 restore proper address
rts
zipdata lda #$00
tay
L3F42 sta (datptr),y zero out data area
iny
bne L3F42
inc datptr+1
L3F49 sta (datptr),y
iny
bne L3F49
dec datptr+1
rts
L3F51 sta bloknml get data block of new position
lda (zpt),y (high address)
dec zpt+1
rnewpos sta bloknml+1
jsr rfcbdat
bcs L3F86 if error.
jsr clrstats show whole chain is allocated.
svmark ldy fcbptr update position in fcb
iny
iny
ldx #$02
L3F68 lda fcbbuf+18,y save old mark in case calling routine
sta oldmark,x fails later.
lda tposll,x
sta fcbbuf+18,y
dey
dex move 3 byte position marker
bpl L3F68
clc set up indirect address to buffer
lda datptr page pointed to by the current
sta sos position marker.
lda tposlh
and #$01
adc datptr+1
sta sos+1
L3F86 rts carry set if error
clrstats ldy fcbptr clear allocation states for data block
lda fcbbuf+8,y and both levels of indexes/
and #$F8
sta fcbbuf+8,y indicates that either they exist now
rts or unnecessary for current position.
dirmark cmp #$0D is it a directory ?
beq L3F9C yes...
lda #$4A no, so compatability problem.
jsr GP.P8errv should not have been opened !!!
L3F9C lda scrtch recover results of previous subtraction.
lsr use difference as counter for how many
sta cntent blocks must be read to get to new pos'n.
lda fcbbuf+19,y test for positive direction
cmp tposlh indicated by carry.
bcc L3FB9 if set, position forward. otherwise,
L3FAB ldy #$00 read directory file in reverse order.
jsr dirpos1 read previous block.
bcs L3FD6 if error.
inc cntent count up to 128.
bpl L3FAB loop if more blocks to pass over.
bmi svmark always.
L3FB9 ldy #$02 position is forward from current.
jsr dirpos1 read next directory block
bcs L3FD6 if error.
dec cntent
bne L3FB9 loop if position not found in this block
beq svmark branch always.
dirpos1 lda (datptr),y get link address of previous or next
sta bloknml directory block.
cmp #$01 test for null byte into carry
iny but first be sure there is a link.
lda (datptr),y get the rest of the link.
bne L3FD8 branch if certain link exists.
bcs L3FD8 was the low part null as well ?
lda #$4C something is wrong with directory file!
L3FD6 sec error.
rts
L3FD8 sta bloknml+1
* read file's data block
rfcbdat lda #$01 read command
sta A4L
ldx #datptr points at address of data buffer.
jsr fileio1 go do file input.
bcs L3FF2 error.
ldy fcbptr
lda bloknml
sta fcbbuf+16,y save block # just read in fcb.
lda bloknml+1
sta fcbbuf+17,y
L3FF2 rts
rfcbidx lda #$01 prepare to read index block : read command
sta A4L
ldx #$48 address of current index buffer.
jsr fileio1 go read index block.
bcs L400C error
ldy fcbptr
lda bloknml
sta fcbbuf+14,y save block address of this index in fcb
lda bloknml+1
sta fcbbuf+15,y
clc
L400C rts
L400D lda #$02 write command
.HS 2C skip next instruction
rfcbfst lda #$01 read command.
pha save the command
lda #$0C
ora fcbptr add offset to fcbptr
tay
pla
ldx #$48 rd block into index portion of file buf
dofileio sta A4L command
lda fcbbuf,y get disk block address from fcb.
sta bloknml block 0 not legal
cmp fcbbuf+1,y
bne L4031
cmp #$00 are both bytes 0 ?
bne L4031 no, continue request
lda #$0C otherwise, allocation error.
jsr sysdeath doesn't return...
L4031 lda fcbbuf+1,y high address of disk block
sta bloknml+1
fileio1 php no interrupts
sei
lda $00,x get memory address of buffer from
sta buf page zero pointed to by x register
lda $01,x
sta buf+1 and pass address to device handler
ldy fcbptr
lda fcbbuf+1,y
sta devnum along with device #.
lda #$FF also, set to indicate reg call made to
sta ioaccess device handler.
lda devnum transfer device # for dispatcher
sta unitnum to convert to unit #.
stz p8error clear global error code.
jsr dmgr call the driver.
bcs L405E if error.
plp restore interrupts
clc
rts
L405E plp restore interrupts
sec
rts
wfcbfst jsr upbmap update the bitmap
bra L400D and write file's 1st block.
wfcbdat ldx #datptr point at memory address with x and
lda #$10 disk address with y.
ora fcbptr add offset to fcbptr
tay and put in y.
lda #$02 write data block.
jsr dofileio
bcs L4096 if errors.
lda #$BF mark data status as current.
bra L408D
wfcbidx jsr upbmap update bitmap.
ldx #$48 point to address of index buffer
lda #$0E and block address of that index block.
ora fcbptr
tay
lda #$02
jsr dofileio go write out index block.
bcs L4096 if errors.
lda #$7F mark index status as current.
L408D ldy fcbptr change status byte to reflect
and fcbbuf+8,y successful disk file update.
sta fcbbuf+8,y (carry is unaffected)
L4096 rts
openf jsr findfile look up the file.
bcc L40A0 if ok.
cmp #$40 is this opening a root directory ?
bne L40A7 if not, then error.
L40A0 jsr tstopen are any other files writing to this
bcc L40AD same file ? branch if not.
L40A5 lda #$50 file is busy, shared access not allowed.
L40A7 sec
rts
L40A9 lda #$4B file is wrong storage type.
sec
rts
L40AD ldy fcbptr get address of 1st free fcb found.
lda fcbflg if this byte <> 0 then free fcb found
bne L40B9 and available for use.
lda #$42 fcb full error.
sec
rts
L40B9 ldx #$1F assign fcb,
lda #$00 but clean it first.
L40BD sta fcbbuf,y
iny
dex
bpl L40BD
lda #$06 start claiming it by moving in file info
tax using x as source index
ora fcbptr and y as destination (fcb).
tay
L40CB lda d_dev-1,x move ownership info.
sta fcbbuf,y note: this code depends upon the defined
dey order of both the fcb and directory
dex entry buffer.
bne L40CB
lda d_stor get storage type and
lsr strip off file name length
lsr by dividing by 16.
lsr
lsr
tax save in x for later comparison
sta fcbbuf+7,y and in fcb for future access.
lda d_attr get file's attributes and use it
and #$03 as a default access request.
cpx #$0D if directory, don't allow write enable.
bne L40EB
and #$01 read enabled bit
L40EB sta fcbbuf+9,y
and #$02 check for write enabled request.
beq L40F7 branch for open as read-only
lda totent otherwise, be sure no one else is
bne L40A5 reading the same file. branch if busy.
L40F7 cpx #$04 is it a tree file type ?
bcc L40FF yes.
cpx #$0D is it a directory type ?
bne L40A9 if not, wrong storage type.
L40FF ldx #$06 move address of 1st block of file, end
L4101 sta bloknml+1 of file and current usage count.
lda fcbptr
ora ofcbtbl,x this is done via a translation table
tay between directory info and fcb.
lda d_frst,x
sta fcbbuf,y
dex
bpl L4101 last loop stores hi address of 1st block
sta bloknml and this is the low one.
ldy fcbptr
lda cntent this was set up by 'tstopen'.
sta fcbbuf,y claim fcb for this file.
jsr alcbuffr go allocate buffer in memory tables.
bcs L4147 if errors.
jsr fndfcbuf rtn addr of bufs in data & index ptrs.
lda flevel mark level at which
sta fcbbuf+27,y file was opened.
lda fcbbuf+7,y file must be positioned at beginning.
cmp #$04 is it a tree file ?
bcs L415E no, assume a directory.
lda #$FF fool the position routine into giving
sta fcbbuf+20,y a valid position with preloaded data,
ldy #$02 etc. set desired position to 0.
lda #$00
L413C sta tposll,y
dey
bpl L413C
jsr rdposn let tree position routine do the rest.
bcc L4163 if successful.
L4147 pha save error code.
ldy fcbptr free buffer space.
lda fcbbuf+11,y
beq L4156 if no bufnum, ok because never alloc'd.
jsr relbuffr go release buffer.
ldy fcbptr since error was before file was
L4156 lda #$00 successfully opened, then it is
sta fcbbuf,y necessary to release fcb also.
pla error code.
sec
rts
L415E jsr rfcbdat read in 1st block of directory file.
bcs L4147 return error after freeing buffer & fcb.
L4163 ldx vcbptr index to vcb.
inc vcbbuf+30,x add 1 to # of files currently open
lda vcbbuf+17,x and indicate that this volume has at
ora #$80 least 1 file active.
sta vcbbuf+17,x
ldy fcbptr index to fcb.
lda fcbbuf,y return ref # to user.
ldy #$05
sta (A3L),y
clc open is successful
rts
* test open
* is there an open file?
tstopen lda #$00
sta cntent returns the ref # of a free fcb.
sta totent flag to indicate file already open.
sta fcbflg flag indicates a free fcb is available.
L4188 tay index to next fcb.
ldx fcbflg test for free fcb found.
bne L4191 if already found.
inc cntent
L4191 lda fcbbuf,y is this fcb in use ?
bne L41A3 yes.
txa if not, should we claim it ?
bne L41C1 branch if free fcb already found.
sty fcbptr save index to new free fcb.
lda #$FF set fcb flag to indicate
sta fcbflg free fcb found.
bne L41C1 branch always to test next fcb.
L41A3 tya add offset to index to ownership info
ora #$06
tay and put it back in y.
ldx #$06 index to directory entry owner info.
L41A9 lda fcbbuf,y all bytes must match to say that it's
cmp d_dev-1,x the same file again.
bne L41C1 if not, then next fcb.
dey index to next lower bytes.
dex
bne L41A9 loop to check all owner info.
inc totent file is already open, now see
lda fcbbuf+9,y if it's already opened for write. and #$02 if so report file busy (with carry set).
and #$02 if so report file busy (with carry set).
beq L41C1 branch if this file is read access only.
sec
rts
L41C1 tya calc position of next fcb.
and #$E0 first strip any possible index offsets.
clc
adc #$20 inc to next fcb.
bne L4188 branch if more to compare.
clc report no conflicts.
rts
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.C
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

576
ProDOS.FX/ProDOS.S.XDOS.D.txt Normal file
View File

@ -0,0 +1,576 @@
NEW
AUTO 3,1
* read command
readf jsr mvdbufr xfer buffer address and request count
jsr mvcbytes to a more accessable location, also
pha get fcb attributes and save on stack.
jsr calcmrk calc mark after read, test if mark > eof
pla carry set means end mark > eof.
and #$01 test for read enabled.
bne L41DE branch if ok to read.
lda #$4E illegal access.
bne L4202 always.
L41DE bcc L4205 branch if result mark < eof. adjust
ldy fcbptr request to read until just before eof.
lda fcbbuf+21,y result = (eof-1) - position
sbc tposll
sta cbytes
sta rwreql
lda fcbbuf+22,y
sbc tposlh
sta cbytes+1
sta rwreqh
ora cbytes if both bytes = 0 then eof error
bne L4210
lda #$4C eof error
L4202 jmp errfix1
L4205 lda cbytes
ora cbytes+1
bne L4210 if read request definitely non-zero.
L420D jmp rwdone do nothing.
L4210 jsr valdbuf validate user's data buffer range.
bcs L4202 branch if memory conflict.
jsr gfcbstyp get storage type
cmp #$04 and find out if it's a tree or other.
bcc L421F branch if a tree file
jmp dread otherwise assume it's a directory.
L421F jsr rdposn set up data pointer.
bcs L4202 errors.
jsr preprw test for newline, setup for partial
jsr readpart read. move current data buffer contents
bvs L420D to user area. branch if satisfied.
bcs L421F indicates newline is set.
lda rwreqh how many blocks are to be read ?
lsr if < 2 then use the slow way.
beq L421F
sta cmdtemp save bulk block count.
jsr gfcbstat make sure current data area doesn't
and #$40 need writing before resetting ptr to
bne L421F read into user's area. branch if data
sta ioaccess needs to be written to force 1st call
lda usrbuf thru all dev handler checking. make
sta datptr the data buffer the user's space.
lda usrbuf+1
sta datptr+1
L4249 jsr rdposn get next block directly into user space.
bcs L42B7 if error.
L424E inc datptr+1 incll ptrs by one block (512 bytes)
inc datptr+1
dec rwreqh
dec rwreqh
inc tposlh
inc tposlh
bne L4269 if pos'n doesn't get to a 64k boundary
inc tposhi otherwise, must check for a 128k one.
lda tposhi carry set if 128k boundary reached.
eor #$01
lsr
L4269 dec cmdtemp has all been read fast ?
bne L427B branch if more to read.
jsr fxdatptr go fix up data pointer to xdos buffer.
lda rwreql test for end of read.
ora rwreqh are both 0 ?
beq rwdone yes, done.
bne L421F no, read last partial block
L427B bcs L4249
lda tposhi get index to next block address
lsr
lda tposlh
ror
tay index to address = int(pos/512)
lda (zpt),y get low address
sta bloknml
inc zpt+1
cmp (zpt),y are hi and low address the same?
bne L4299 no, it's a real block address.
cmp #$00 are both bytes 0 ?
bne L4299 no, must be real data.
sta ioaccess don't do repeat io just after sparse.
beq L429C branch always (carry set).
L4299 lda (zpt),y get high address
clc
L429C dec zpt+1
bcs L4249 if no block to read.
sta bloknml+1
lda ioaccess has 1st call gone to device yet ?
beq L4249 no, go thru normal route
clc
php interrupts can't occur during dmgr call
sei
lda datptr+1 reset hi buffer address for dev handler
sta buf+1
jsr dmgr
bcs L42B6 if error
plp
bcc L424E no errors, branch always.
L42B6 plp restore interrupts.
L42B7 pha save error code.
jsr fxdatptr go restore data pointers, etc.
pla
errfix1 pha save error code
jsr rwdone pass back # of bytes actually read
pla
sec error
rts
rwdone ldy #$06 return total # of bytes actually read
sec derived from cbytes-rwreq.
lda cbytes
sbc rwreql
sta (A3L),y
iny
lda cbytes+1
sbc rwreqh
sta (A3L),y
jmp rdposn leave with valid position in fcb.
preprw ldy fcbptr adj pointer to user's buffer to make
sec the transfer
lda usrbuf
sbc tposll
sta usrbuf
bcs L42E9 if no adjustment to hi address needed
dec usrbuf+1
L42E9 lda fcbbuf+31,y test for new line enabled.
clc
beq L42F9 if new line not enabled.
sec carry indicates new line enabled
sta nlmask
lda fcbbuf+10,y move newline character to more
sta nlchar accesible spot.
L42F9 ldy tposll index to 1st data.
lda datptr reset low order of position pointer to
sta sos beginning of page.
ldx rwreql get low order count of requested bytes.
rts return statuses.
readpart txa x = low count of bytes to move.
bne L430F branch if request is not an even page.
lda rwreqh a call of 0 bytes should never get here!
beq L435D branch if nothing to do.
dec rwreqh
L430F dex
L4310 lda (sos),y move data to user's buffer
sta (usrbuf),y
bcs tstnewl test for newline 1st !
L4316 txa note: x must be unchanged from tstnewl !
beq L4332 go see if read request is satified...
L4319 dex dec # of bytes left to move.
iny page crossed ?
bne L4310 no, move next byte.
lda sos+1 test for end of buffer, but first
inc usrbuf+1 adjust user buffer pointer
inc tposlh and position
bne L4329
inc tposhi
L4329 inc sos+1 and sos buffer high address.
eor datptr+1 (carry is undisturbed)
beq L4310 branch if more to read in buffer.
clv indicate not finished.
bvc L4360 always.
L4332 lda rwreqh
beq L4350 branch if request is satisfied.
iny done with this block of data ?
bne L4340 no, adjust high byte of request.
lda sos+1 maybe, check for end of block buffer.
eor datptr+1 (don't disturb carry).
bne L4343 if hi count can be dealt with next time
L4340 dec rwreqh
L4343 dey restore proper value
bra L4319
tstnewl lda (sos),y get last byte transferred again.
and nlmask only bits on in mask are significant.
eor nlchar does it match newline character?
bne L4316 no, read next.
L4350 iny adjust position.
bne L435D
inc usrbuf+1 inc pointers
inc tposlh
bne L435D
inc tposhi
L435D bit setvflg (sets v flag)
L4360 sty tposll save low position
bvs L4366
inx leave request as +1 for next call
L4366 stx rwreql and remainder of request count.
php save statuses
clc adjust user's low buffer address
tya
adc usrbuf
sta usrbuf
bcc L4374
inc usrbuf+1 adjust hi address as needed.
L4374 plp restore return statuses.
setvflg rts this byte ($60) is used to set v flag.
fxdatptr lda datptr put current user buffer address back to normal
sta usrbuf
lda datptr+1
sta usrbuf+1 bank pair byte should be moved also.
ldy fcbptr restore buffer address
jmp fndfcbuf
* read directory file
dread jsr rdposn
bcs L43B8 pass back any errors.
jsr preprw prepare for transfer.
jsr readpart move data to user's buffer.
bvc dread repeat until request is satisfied.
jsr rwdone update fcb as to new position.
bcc L43B6 branch if done with no errors.
cmp #$4C was last read to end of file ?
sec anticipate some other error.
bne L43B7 branch if not eof error.
jsr svmark
jsr zipdata clear out data block.
ldy #$00 provide dummy back pointer for future
ldx fcbptr re-position. x = hi byte of last block
L43A6 lda fcbbuf+16,x
sta (datptr),y
lda #$00 mark current block as impossible
sta fcbbuf+16,x
inx
iny inc indexes to do both hi and low bytes
cpy #$02
bne L43A6
L43B6 clc no error
L43B7 rts
L43B8 jmp errfix1 report how much xfer'd before error.
mvcbytes ldy #$04 move request count to a more accessable location
lda (A3L),y
sta cbytes
sta rwreql
iny
lda (A3L),y
sta cbytes+1
sta rwreqh
ldy fcbptr return y = val(fcbptr),
lda fcbbuf+9,y a = attributes
clc and carry clear...
rts
mvdbufr ldy #$02 move the pointer to user's buffer
lda (A3L),y to the block file manager
sta usrbuf z-page area
iny
lda (A3L),y
sta usrbuf+1
gfcbstyp ldy fcbptr return storage type
lda fcbbuf+7,y
rts
* this subroutine adds the requested byte count to mark and returns sum
* in scrtch and also returns mark in tpos and oldmark.
*
* on exit:
* y,x,a is unknown
* carry set indicates scrtch > eof
calcmrk ldx #$00
ldy fcbptr
clc
L43EE lda fcbbuf+18,y
sta tposll,x
sta oldmark,x
adc cbytes,x
sta scrtch,x
txa
eor #$02 cbytes+2 always=0
beq eoftest
iny
inx
bne L43EE always.
eoftest lda scrtch,x new mark in scrtch.
cmp fcbbuf+21,y is new position > eof ?
bcc L4414 no, proceed.
bne L4414 yes, adjust 'cbytes' request
dey
dex all tree bytes compared ?
bpl eoftest no, test next lowest
L4414 rts
werreof jsr plus2fcb reset eof to pre-error position.
L4418 lda oldeof,x place oldeof back into fcb
sta fcbbuf+21,y
lda oldmark,x also reset mark to last best
sta fcbbuf+18,y write position
sta scrtch,x and copy mark to scrtch for test of
dey eof less than mark.
dex
bpl L4418
jsr plus2fcb get pointers to test eof < mark.
jsr eoftest carry set means mark > eof !!
* drop into wadjeof to adjust eof to mark if necessary
wadjeof jsr plus2fcb get y=fcbptr+2, x=2, a=y.
L4434 lda fcbbuf+21,y copy eof to old eof
sta oldeof,x
bcc L4442 and if carry set...
lda scrtch,x then copy scrtch to fcb's eof.
sta fcbbuf+21,y
L4442 dey
dex copy all 3 bytes
bpl L4434
rts
plus2fcb lda #$02 on exit both a and y = fcbptr+2.
tax x = 2
ora fcbptr
tay
rts
* write command
writef jsr mvcbytes first determine if requested write is legal.
pha
jsr calcmrk save a copy of eof to old eof, set/clr
jsr wadjeof carry to determine if new mark > eof.
pla get attributes again.
and #$02 is write enabled ?
bne L4462 yes, continue...
L445E lda #$4E illegal access error.
bne L44A2
L4462 jsr tstwprot otherwise, make sure device is not
bcs L44A2 write protected. if so, branch to abort.
lda cbytes
ora cbytes+1 anything to write ?
bne L4472 branch if so,
jmp rwdone else do nothing.
L4472 jsr mvdbufr move the user's buffer ptr to bfm zero
cmp #$04 page area, also get storage type.
bcs L445E if not tree, return an access error.
L4479 jsr rdposn
bcs L44A2
jsr gfcbstat
and #$07
beq L44E9
ldy #$00 is enough disk space available for
L4487 iny indexes and data block ?
lsr
bne L4487
sty reql
sta reqh
jsr tstfrblk
bcs L44A2 pass back any errors.
jsr gfcbstat now get more specific.
and #$04 are we lacking a tree top ?
beq L44AC no, test for lack of sapling level index
jsr topdown go allocate tree top and adj file type.
bcc L44B8 continue with allocation of data block.
L44A2 pha save error.
jsr errfix1 error return.
jsr werreof adjust eof and mark to pre-error state.
pla restore error code.
sec
rts
L44AC jsr gfcbstat get status byte again.
and #$02 do we need a sapling level index block ?
beq L44B8 no, assume it's just a data block needed
jsr sapdown go alloc an indx blk and update tree top
bcs L44A2 if error.
L44B8 jsr alcwblk go allocate for data block.
bcs L44A2
jsr gfcbstat clear allocation required bits in status
ora #$80 but first indicate index block is dirty.
and #$F8
sta fcbbuf+8,y
lda tposhi calculate position within index block.
lsr
lda tposlh
ror
tay now put block address into index block.
inc zpt+1 high byte first.
lda scrtch+1
tax
sta (zpt),y
dec zpt+1 restore pointer to lower page of index
lda scrtch block. get low block address.
sta (zpt),y store low address.
ldy fcbptr update fcb to indicate that this block
sta fcbbuf+16,y is allocated.
txa get high address again.
sta fcbbuf+17,y
L44E9 jsr preprw
jsr wrtpart
bvc L4479
jmp rwdone update fcb with new position
wrtpart txa
bne L44FF branch if request is not even pages
lda rwreqh a call of 0 bytes should never get here!
beq L4546 do nothing
dec rwreqh
L44FF dex
lda (usrbuf),y move data from user's buffer
sta (sos),y
txa
beq L4525
L4507 iny page crossed ?
bne L44FF no, keep moving.
lda sos+1 test for end of buffer
inc usrbuf+1 but first adjust user buffer pointer
inc tposlh and position
bne L451C
inc tposhi
bne L451C
lda #$4D out of range if > 32MB
bne L44A2
L451C inc sos+1 adjust sos buffer high address
eor datptr+1 (carry is undisturbed)
beq L44FF branch if more to write to buffer.
clv indicates not finished.
bvc L4549 always.
L4525 lda rwreqh
beq L4539 branch if request satisfied.
iny done with this block of data ?
bne L4533 if not.
lda sos+1 this is necessary for proper
eor datptr+1 adjustment of request count
bne L4536
L4533 dec rwreqh
L4536 dey reset modified y
bra L4507
L4539 iny and position
bne L4546
inc usrbuf+1 inc pointers
inc tposlh
bne L4546
inc tposhi
L4546 bit setvflg set v flag
L4549 sty tposll save low position
stx rwreql and remainder of request count.
php save statuses
jsr gfcbstat
ora #$50
sta fcbbuf+8,y
clc adjust user's low buffer address
lda tposll
adc usrbuf
sta usrbuf
bcc L4564
inc usrbuf+1 adjust high address as needed.
L4564 jsr fcbused set directory flush bit.
plp restore return statuses
rts
topdown jsr swapdown make current 1st block an entry in new
bcs L45B1 top. branch if errors.
jsr gfcbstyp get storage type
* has storage type been changed to 'tree' ? if not, assume it was originally
* a seed and both levels need to be built. otherwise, only an index needs
* to be allocated.
cmp #$03 tree type
beq L457A
jsr swapdown make previous swap a sap level index
bcs L45B1 block. branch if errors.
L457A jsr alcwblk get another block address for the sap
bcs L45B1 level index. branch if errors.
lda tposhi calculate position of new index block
lsr in the top of the tree.
tay
lda scrtch get address of newly allocated index
tax block again.
sta (zpt),y
inc zpt+1
lda scrtch+1
sta (zpt),y save hi address
dec zpt+1
ldy fcbptr make newly allocated block the current
sta fcbbuf+15,y index block.
txa
sta fcbbuf+14,y
jsr wfcbfst save new top of tree
bcs L45B1
jmp zeroindex zero index block in user's i/o buffer.
sapdown jsr gfcbstyp find out if dealing with a tree.
cmp #$01 if seed then adj to file type is needed.
beq swapdown branch if seed
jsr rfcbfst otherwise read in top of tree.
bcc L457A if no error.
L45B1 rts return errors.
swapdown jsr alcwblk make current seed into a sapling, allocate a block before swap.
bcs L45F6 return errors.
ldy fcbptr get previous first block
lda fcbbuf+12,y address into index block.
pha save temporarily while swapping in new
lda scrtch top index. get new block address (low)
tax
sta fcbbuf+12,y
lda fcbbuf+13,y
pha
lda scrtch+1 and high address too
sta fcbbuf+13,y
sta fcbbuf+15,y make new top also the current index in
txa memory. get low address again.
sta fcbbuf+14,y
inc zpt+1 make previous the 1st entry in sub index
pla
sta (zpt)
dec zpt+1
pla
sta (zpt)
jsr wfcbfst save new file top.
bcs L45F6 if error.
jsr gfcbstyp now adjust storage type by adding 1
adc #$01 (seed becomes sapling becomes tree)
sta fcbbuf+7,y
lda fcbbuf+8,y mark storage type modified
ora #$08
sta fcbbuf+8,y
clc no error
L45F6 rts
alcwblk jsr alc1blk
bcs L4616
jsr gfcbstat mark usage as modified
ora #$10
sta fcbbuf+8,y
lda fcbbuf+24,y inc current usage count by 1
clc
adc #$01
sta fcbbuf+24,y
lda fcbbuf+25,y
adc #$00
sta fcbbuf+25,y
L4615 clc no error
L4616 rts
tstwprot jsr gfcbstat check for 'never been modified' condition
and #$F0
bne L4615 ordinary rts if known write ok.
lda fcbbuf+1,y get file's dev #.
sta devnum get current status of block device.
twrprot1 sta unitnum make the device status call
lda bloknml+1
pha
lda bloknml save the current block values
pha
stz A4L
stz bloknml zero the block #
stz bloknml+1
php
sei
jsr dmgr
bcs .1 branch if write protect error
lda #$00 otherwise, assume no errors.
.1 plp restore interrupt status
clc
tax save error.
beq .2 branch if no error
sec else, set carry to show error.
.2 pla
sta bloknml restore the block #
pla
sta bloknml+1
txa
rts carry is indeterminate.
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.D
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

603
ProDOS.FX/ProDOS.S.XDOS.E.txt Normal file
View File

@ -0,0 +1,603 @@
NEW
AUTO 3,1
* close command
closef ldy #$01 close all ?
lda (A3L),y
bne L4683 no, just one of them.
sta cferr clear global close error.
lda #$00 start at the beginning.
L4654 sta fcbptr save current low byte of pointer.
tay get the level at which the file
lda fcbbuf+27,y was opened.
cmp flevel if file's level is < global level
bcc L4675 then don't close.
lda fcbbuf,y is this reference file open ?
beq L4675 no, try next.
jsr flush2 clean it out...
bcs L46B6 return flush errors.
jsr close2 update fcb & vcb
ldy #$01
lda (A3L),y
beq L4675 no error if close all.
bcs L46B6 close error.
L4675 lda fcbptr inc pointer to next fcb
clc
adc #$20
bcc L4654 branch if within same page.
lda cferr on final close report logged errors.
beq L46B4 branch if errors.
rts (carry already set).
L4683 jsr flush1 flush file 1st (including updating
bcs L46B6 bitmap). branch if errors.
close2 ldy fcbptr
lda fcbbuf+11,y release file buffer
jsr relbuffr
bcs L46B6
lda #$00
ldy fcbptr
sta fcbbuf,y free fcb too
lda fcbbuf+1,y
sta devnum go look for associated vcb
jsr fnddvcb
ldx vcbptr get vcb pointer.
dec vcbbuf+30,x indicate one less file open.
bne L46B4 branch if that wasn't the last...
lda vcbbuf+17,x
and #$7F strip 'files open' bit
sta vcbbuf+17,x
L46B4 clc
rts
L46B6 bcs L46E6 don't report close all error now.
* flush command
flushf ldy #$01 flush all ?
lda (A3L),y
bne flush1 no, just one of them.
sta cferr clear global flush error.
lda #$00 start at the beginning.
L46C3 sta fcbptr save current low byte of pointer.
tay index to ref #.
lda fcbbuf,y is this reference file open ?
beq L46D1 no, try next.
jsr flush2 clean it out...
bcs L46E6 return anty errors.
L46D1 lda fcbptr inc pointer to next fcb.
clc
adc #$20
bcc L46C3 branch if within same page
L46D9 clc
lda cferr on last flush,
beq L46E0 branch if no logged errors.
sec report error now
L46E0 rts
flush2 jsr fndfcbuf must set up vcb & buffer locations 1st.
bcc L46F1 branch if no error.
L46E6 jmp glberr error so check for close or flush all.
flush1 stz cferr for normal refnum flush, clear global error.
jsr findfcb setup pointer to fcb user references.
bcs L46E6 return any errors.
L46F1 lda fcbbuf+9,y test to see if file is modified.
and #$02 is it write enabled ?
beq L46D9 branch if 'read only'
lda fcbbuf+28,y has eof been modified ?
bmi L4704 if yes.
jsr gfcbstat has data been modified ?
and #$70 (was written to while it's been open?)
beq L46D9 if not.
L4704 jsr gfcbstat
and #$40 does current data buffer need to be
beq L4710 written ? branch if not.
jsr wfcbdat if so, go write it.
bcs L46E6 if error.
L4710 jsr gfcbstat check to see if the index block (tree
and #$80 files only) needs to be written.
beq L471C branch if not.
jsr wfcbidx
bcs L46E6 return any errors.
L471C lda #$06 prepare to update directory
tax
ora fcbptr
tay
L4723 lda fcbbuf,y note: this code depends on the defined
sta d_dev-1,x order of the file control block and the
dey temporary directory area in 'work space'
dex
bne L4723
sta devnum
lda d_head read the directory header for this file
ldx d_head+1
jsr rdblk into the general purpose buffer.
bcs L46E6 if error.
jsr movhed0 move header info.
lda d_entblk get address of directory block that
ldy d_entblk+1 contains the file entry.
cmp d_head test to see if it's the same block the
bne L474E header is in. branch if not.
cpy d_head+1
beq L4755 branch if header block = entry block
L474E sta bloknml
sty bloknml+1
jsr rdgbuf get block with file entry in general
L4755 jsr entcalc buffer. set up pointer to entry.
jsr moventry move entry to temp entry buffer in
ldy fcbptr 'work space'. update 'blocks used' count
lda fcbbuf+24,y
sta d_usage
lda fcbbuf+25,y
sta d_usage+1
ldx #$00 and move in end of file mark whether
L476C lda fcbbuf+21,y needed or not.
sta d_eof,x
inx
cpx #$03 move all 3 bytes
beq L4780
lda fcbbuf+12,y also move in the address of the file's
sta d_filid,x first block since it might have changed
iny since the file first opened.
bne L476C branch always.
L4780 lda fcbbuf+5,y the last thing to update is storage
asl type (y=fcbptr+2). shift into high
asl nibble.
asl
asl
sta scrtch
lda d_stor get old type byte (might be the same).
and #$0F strip off old type,
ora scrtch add in the new type
sta d_stor and put it away.
jsr drevise go update directory.
bcs glberr error.
ldy fcbptr mark
lda fcbbuf+28,y fcb/directory
and #$7F as
sta fcbbuf+28,y undirty.
lda d_dev see if bitmap should be written.
cmp bmadev is it in same as current file ?
bne L47B2 yes, put it on the disk if necessary.
jsr upbmap go put it away.
bcs glberr flush error
L47B2 clc
rts
* report error only if not a close all or flush all
glberr ldy #$01
pha
lda (A3L),y
bne L47C1 not an 'all' so report now
clc
pla
sta cferr save for later
rts
L47C1 pla
rts
gfcbstat ldy fcbptr index to fcb.
lda fcbbuf+8,y return status byte.
rts
L47CA lda #$4E access error
sec
L47CD rts
seteof jsr gfcbstyp can only move end of tree, sapling or seed.
cmp #$04 tree type ?
bcs L47CA if not then access error
asl
asl
asl
asl
sta stortyp may be used later.
lda fcbbuf+9,y
and #$02 is write enabled to set new eof ?
beq L47CA no, access error.
jsr tstwprot hardware write protected ?
bcs L47CA yes, access error.
ldy fcbptr save old eof so it can be seen
iny whether blocks need to be released
iny upon contraction.
ldx #$02 all 3 bytes of the eof
L47EF lda fcbbuf+21,y
sta oldeof,x
dey
dex
bpl L47EF
ldy #$04
ldx #$02
L47FD lda (A3L),y position mark to new eof
sta tposll,x
dey
dex
bpl L47FD
ldx #$02 point to 3rd byte.
L4808 lda oldeof,x see if eof moved backwards so blocks
cmp tposll,x can be released.
bcc eofset (branch if not)
bne purge branch if blocks to be released
dex
bpl L4808 all 3 bytes
eofset ldy #$04
ldx fcbptr place new end of file into fcb
inx
inx
L481C lda (A3L),y
sta fcbbuf+21,x
dex
dey
cpy #$02 all 3 bytes moved ?
bcs L481C no.
jmp fcbused mark fcb as dirty.
purge jsr flush1 make sure file is current
bcs L47CD
ldx datptr+1 pointer to index block
inx
inx
stx zpt+1 (zero page conflict with dir buf ptr)
ldx datptr
stx zpt
ldy fcbptr check if eof < mark
iny
iny
ldx #$02
L4840 lda fcbbuf+18,y
cmp tposll,x compare until not equal or carry clear.
bcc L485F branch if eof > mark.
bne L484E branch if eof < mark.
dey
dex
bpl L4840 compare all 3 bytes
L484E ldy fcbptr
ldx #$00
L4853 lda tposll,x fake position, correct position will
sta fcbbuf+18,y be made below...
iny
inx
cpx #$03 move all 3 bytes
bne L4853
L485F jsr tkfrecnt force free block count before releasing
lda tposll blocks. prepare for purge of excess...
sta dseed all blocks and bytes beyond new eof
lda tposlh must be zero'd
sta dsap
and #$01
sta dseed+1
lda tposhi
lsr
sta dtree
ror dsap pass position in terms of block & bytes.
lda dseed now adjust for boundaries of $200
ora dseed+1
bne L48A2 branch if no adjustment necessary.
lda dsap get correct block ositions for sap
sec and tree levels.
sbc #$01
sta dsap deallocate for last (phantom) block
lda #$02 and don't modify last data block.
bcs L489F branch if tree level unaffected.
dec dtree
bpl L489F branch if new eof not zero
lda #$00
sta dtree otherwise, make a null seed out of it.
sta dsap
L489F sta dseed+1
L48A2 ldy fcbptr also must pass file's 1st block address.
lda fcbbuf+12,y
sta firstbl
lda fcbbuf+13,y
sta firstbh
stz deblock lastly, initialize # of blocks to
stz deblock+1 be free'd.
jsr detree deallocate blocks from tree.
php save any error status until fcb
pha is cleaned up.
sec
ldy fcbptr
ldx #$00
L48C2 lda firstbl,x
sta fcbbuf+12,y move in possible new first file block
lda fcbbuf+24,y address. adjust usage count also
sbc deblock,x
sta fcbbuf+24,y
iny
inx
txa
and #$01 test for both bytes adjusted
bne L48C2 without disturbing carry.
lda stortyp get possibly modified storage type
lsr
lsr
lsr
lsr
ldy fcbptr and save it in fcb.
sta fcbbuf+7,y
jsr clrstats make it look as though position has
jsr dvcbrev nothing allocated, update total blocks
ldy fcbptr in fcb and correct position.
iny
iny
ldx #$02
L48F2 lda fcbbuf+18,y tell 'rdposn' to go to correct
sta tposll,x
eor #$80 position from incorrect place.
sta fcbbuf+18,y
dey
dex
bpl L48F2
jsr rdposn go to correct position.
bcc L490D if no error.
tax otherwise, report latest error.
pla
plp
txa restore latest error code to stack
sec
php
pha save new error.
* mark file as in need of a flush and update fcb with new end of file,
* then flush it.
L490D jsr eofset go mark and update
jsr flush1 then go do the flush.
bcc L491C branch if no error.
tax save latest error.
pla clean previous error off stack
plp
txa and restore latest error to stack.
sec show error condition.
php restore error status to stack
pha and the error code.
L491C pla report any errors that may have
plp appeared.
rts
geteof ldx fcbptr index to end of file mark
ldy #$02 and index to user's call parameters
L4924 lda fcbbuf+21,x
sta (A3L),y
inx
iny
cpy #$05
bne L4924 loop until all 3 bytes moved
clc no errors
rts
newline ldy #$02 adjust newline status for open file.
lda (A3L),y on or off ?
ldx fcbptr it will be 0 if off.
sta fcbbuf+31,x set new line mask
iny
lda (A3L),y and move in 'new-line' byte
sta fcbbuf+10,x
clc no error possible
rts
getinfo jsr findfile look for file.
bcc L4988 no error.
cmp #$40 was it a root directory file ?
sec (in case of no match)
bne L49A4 if not, then error.
lda #$F0
sta d_stor for get info, report proper storage
stz reql type. forca a count of free blocks.
stz reqh
ldx vcbptr
jsr tkfrecnt get a fresh count of free blocks on
ldx vcbptr this volume.
lda vcbbuf+21,x return total blocks and total in use.
sta reqh 1st transfer 'free' blocks to zpage
lda vcbbuf+20,x for later subtraction to determine
sta reql the 'used' count.
lda vcbbuf+19,x transfer to 'd.' table as aux id
sta d_auxid+1 (total block count is considered aux id
pha for the volume)
lda vcbbuf+18,x
sta d_auxid
sec subtract and report the number of
sbc reql blocks 'in use'
sta d_usage
pla
sbc reqh
sta d_usage+1
L4988 lda d_stor transfer bytes from internal order to
lsr call spec via 'inftabl' translation
lsr table but first change storage type to
lsr external (low nibble) format.
lsr
sta d_stor
ldy #$11 index to last of user's spec table.
L4994 lda inftabl-3,y
and #$7F strip bit used by setinfo
tax
lda d_stor,x move directory info to call spec. table
sta (A3L),y
dey
cpy #$03
bcs L4994 if all info bytes moved, retn carry clr
L49A4 rts
setinfo jsr findfile get the file to work on.
bcs L49CF if error.
lda bubit see if backup bit can be cleared
eor #$20
and d_attr
and #$20
sta bkbitflg or preserve current...
ldy #$0D init pointer to user supplied list.
L49B9 ldx inftabl-3,y get index to corresponding 'd.' table.
bmi L49C3 branch if parameter can't be set.
lda (A3L),y
sta d_stor,x
L49C3 dey has user's request been satisfied ?
cpy #$03
bcs L49B9 no, move next byte.
and #$18 make sure no illegal access bits were
beq L49D0 set !! branch if legal access.
lda #$4E otherwise, access error.
sec
L49CF rts
L49D0 ldy #$0B
lda (A3L),y was clock null input ?
beq L49D9 if yes.
jmp drevise1 end by updating directory.
L49D9 jmp drevise update with clock also...
rename jsr lookfile look for source (original) file.
bcc L4A1E if found.
cmp #$40 trying to rename a volume ?
bne L49FD no, return error.
jsr renpath syntax new name.
bcs L49FD rename error.
ldy pathbuf find out if only rootname for new name
iny
lda pathbuf,y must be $FF if volume name only.
bne L4A72 if not single name
ldx vcbptr check for open files before changing.
lda vcbbuf+17,x
bpl L49FF if volume not busy.
lda #$50 file busy error.
L49FD sec
rts
L49FF ldy #$00 get newname's length
lda pathbuf,y
ora #$F0 (root file storage type)
jsr mvrotnam update root directory.
bcs L4A74 rename error.
ldy #$00
ldx vcbptr update vcb also.
L4A10 lda pathbuf,y move new name to vcb.
beq L4A1C
sta vcbbuf,x
iny next character
inx
bne L4A10 always.
L4A1C clc no errors
rts
L4A1E jsr getnamptr set y = 1st char of path, x = 0.
L4A21 lda pathbuf,y move original name to gbuf
sta gbuf,x for later comparison to new name.
bmi L4A2D if last character has been moved
iny otherwise, get the next one.
inx
bne L4A21 always.
L4A2D jsr renpath get new name syntaxed.
bcs L4A74 rename error.
jsr getnamptr set y = path, x = 0.
lda pathbuf,y now compare new name with old name
L4A38 cmp gbuf,x to make sure they are in the same dir.
php save result of comparison.
and #$F0 was last char really a count ?
bne L4A46 if not.
sty rnptr save pointer to next name, it might
stx namptr be the last.
L4A46 plp result of last comparison ?
bne L4A52 branch if different character or count.
inx bump pointers.
iny
lda pathbuf,y was it the last character ?
bne L4A38 if not.
clc no operation, names were the same.
rts
L4A52 ldy rnptr index to last name in the chain.
lda pathbuf,y get last name length.
sec
adc rnptr
tay
lda pathbuf,y this byte should be $00 !
bne L4A72 if not, bad path error.
ldx namptr index to last of original name
lda gbuf,x
sec
adc namptr
tax
lda gbuf,x this byte should also be $00.
beq L4A76 if so, continue processing.
L4A72 lda #$40 bad pathname error.
L4A74 sec
rts
L4A76 jsr lookfile test for duplicate file name.
bcs L4A7F branch if file not found, which is ok !!
lda #$47 duplicate name error.
sec
rts
L4A7F cmp #$46 was it a valid file not found ?
bne L4A74 no, rename error.
jsr setpath syntax pathname of file to be changed.
jsr findfile get all the info on this file.
bcs L4A74 rename error.
jsr tstopen is file in use ?
lda #$50 anticipate file busy error.
bcs L4A74 error if in use.
lda d_attr test bit which allows rename.
and #$40
bne L4A9D branch if ok to rename
lda #$4E otherwise, illegal access.
L4A9B sec
rts
L4A9D lda d_stor find out which storage type.
and #$F0 strip off name length.
cmp #$D0 is it a directory ?
beq L4AAE then ok.
cmp #$40 is it a seed, sapling or tree ?
bcc L4AAE then ok.
lda #$4A file incompatible error.
bne L4A9B always.
L4AAE jsr renpath since both names go into the directory,
bcs L4A74 syntax the new name to get the local
ldy rnptr name address. y = index to local name
ldx pathbuf,y length. adj y to last char of new name. tya
tya
adc pathbuf,y
tay
L4ABE lda pathbuf,y move local name to dir entry workspace.
sta d_stor,x
dey
dex
bne L4ABE
lda d_stor preserve file storage type.
and #$F0 strip off old name length.
tax
ora pathbuf,y add in new name's length.
sta d_stor
cpx #$D0 that file must be changed also.
bne L4AF0 branch if not directory type.
lda d_frst read in 1st header block of subdir
ldx d_frst+1
jsr rdblk
bcs L4A74 errors.
ldy rnptr change the header's name to match the
lda pathbuf,y owner's new name. get local name length.
ora #$E0 assume it's a header.
jsr mvrotnam
bcs L4A74
L4AF0 jmp drevise1 end by updating all path directories.
mvrotnam ldx #$00
L4AF5 sta gbuf+4,x
inx
iny
lda pathbuf,y
bne L4AF5
jmp wrtgbuf write changed header block.
renpath ldy #$03 get address to new pathname
lda (A3L),y
iny
sta zpt
lda (A3L),y set up for syntaxing routine (synpath)
sta zpt+1
jmp synpath do syntax (returns y = local namelength)
getnamptr ldy #$00 return pointer to 1st name of path.
bit prfxflg is this a prefixed name ?
bmi L4B1A branch if not.
ldy newpfxptr
L4B1A ldx #$00
rts
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.E
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

765
ProDOS.FX/ProDOS.S.XDOS.F.txt Normal file
View File

@ -0,0 +1,765 @@
NEW
AUTO 3,1
destroy jsr findfile look for file to be destroyed.
bcs L4B66 if error.
jsr tstopen is it open ?
lda totent
bne L4B64 error if open.
stz reql force proper free count in volume.
stz reqh (no disk access occurs if already
jsr tstfrblk proper)
bcc L4B39 no errors.
cmp #$48 was error a full disk ?
bne L4B66 no, report error.
L4B39 lda d_attr make sure ok to destroy file.
and #$80
bne L4B45 branch if ok to destroy.
lda #MLI.E.LOCKED access error
jsr GP.P8errv
L4B45 lda devnum last device used.
jsr twrprot1 test for write protected hardware
bcs L4B66 before going thru deallocation.
lda d_frst 'detree' needs first block address
sta firstbl
lda d_frst+1
sta firstbh
lda d_stor find out which storage type.
and #$F0 strip off name length.
cmp #$40 is it a seed, sapling or tree ?
bcc L4B68 branch if it is.
bra L4BCF otherwise, test for directory destroy.
L4B64 lda #$50 file busy error.
L4B66 sec can't be destroyed
rts
L4B68 sta stortyp destroy a tree file. save storage type.
ldx #$05
lda #$00 set 'detree' input variables, must be
L4B6F sta stortyp,x in order: deblock, dtree, dsap, dseed.
dex
bne L4B6F loop until all zero'd.
lda #$02 this avoids an extra file i/o and pre-
sta dseed+1 vents destruction of any deleted data.
inc delflag don't allow detree to zero index blocks.
jsr detree make trees and saplings into seeds.
dec delflag reset flag.
bcs L4B93 (de-evolution)
L4B85 ldx firstbh
lda firstbl now deallocate seed.
jsr dealloc
bcs L4B93
jsr upbmap
L4B93 pha save possible error code.
lda #$00 update directory to free entry space.
sta d_stor
cmp h_fcnt file entry wrap ?
bne L4BA1 branch if no carry adjustment.
dec h_fcnt+1 take carry from hi byte of file entries.
L4BA1 dec h_fcnt mark header with one less file.
jsr dvcbrev go update block count in vcb (ignore
jsr drevise error, if any) and update dir last.
tax save possible new error code,
pla restore possible old error code.
bcc L4BAF branch if last call succeeded.
txa last call failed, use it's error code.
L4BAF cmp #$01 adjust carry accordingly
rts
dvcbrev ldy vcbptr update block free count in vcb. point to vcb of correct device.
lda deblock get # of blocks recently freed.
adc vcbbuf+20,y
sta vcbbuf+20,y update current free block count.
lda deblock+1
adc vcbbuf+21,y
sta vcbbuf+21,y
lda #$00 force re-scan from 1st bitmap
sta vcbbuf+28,y
rts
L4BCD bcc L4B85 branch widened (always taken)
L4BCF cmp #$D0 is this a directory file ?
bne L4C1B no, file incompatible.
jsr fndbmap make sure a buffer available for bitmap
bcs L4C1A if error.
lda d_frst read 1st block of directory into gbuf
sta bloknml
lda d_frst+1
sta bloknml+1
jsr rdgbuf
bcs L4C1A
lda gbuf+37 do any files exist in this directory ?
bne L4BF1 if so, access error.
lda gbuf+38
beq L4BF6
L4BF1 lda #$4E access error.
jsr GP.P8errv
L4BF6 sta gbuf+4 make it an invalid subdirectory
jsr wrtgbuf
bcs L4C1A
L4BFE lda gbuf+2 get forward link.
cmp #$01 test for null block into carry.
ldx gbuf+3 get the rest of the block address.
bne L4C0A branch if not null.
bcc L4BCD was the low part null as well ?
L4C0A jsr dealloc free this block.
bcs L4C1A
lda gbuf+2
ldx gbuf+3
jsr rdblk
bcc L4BFE loop until all freed
L4C1A rts
L4C1B lda #MLI.E.INCFF file incompatible
jsr GP.P8errv
fcbused pha mark fcb as dirty so the directory will be flushed on 'flush'.
tya save regs.
pha
ldy fcbptr
lda fcbbuf+28,y fetch current fcb dirty byte.
ora #$80 mark fcb as dirty.
sta fcbbuf+28,y save it back
pla and restore regs.
tay
pla
rts
* 'detree' deallocates blocks from tree files. it is assumed that the device has
* been pre-selected and the 'gbuf' may be used.
*
* on entry:
* stortype = storage type in upper nibble, lower nibble is undisturbed.
* firstbl & firstbh = first block of file (index or data).
* deblock = 0
* dtree = ptr to 1st block with data to be deallocated at tree level.
* dsap = ptr to 1st block at sapling level.
* dseed = byte (0-511) position to be zeroed from (inclusive).
*
* on exit:
* stortype = modified result of storage type (if applicable).
* firstbl & h = modified if storage type changed.
* deblock = total number of blocks freed at all levels.
* dtree, dsap, deseed unchanged.
*
* to trim a tree to a seed file, both dtree and dsap must be zero.
* to go from tree to sapling, dtree alone must be zero.
detree lda stortyp which kind of tree ?
cmp #$20 is it a 'seed' ?
bcc L4C46 if yes.
cmp #$30 a sapling ?
bcc L4C51 if yes.
cmp #$40 is it at least a 'tree' ?
bcc L4C59 branch if it is.
lda #$0C block allocation error.
jsr sysdeath P8 system death vector
* seedling file type - make sure first desireable block is the only
* block available in a seedling file.
L4C46 lda dsap
ora dtree
bne L4CC2
jmp seedel0
* sapling file type - make sure first desireable block is within the range of
* blocks available in a sapling file
L4C51 lda dtree can't have any blocks in this range
bne L4CC2 if so then done
jmp sapdel0 else go deallocate
L4C59 lda #$80
sta topdest for tree top start at end, work backwards.
L4C5E jsr drdfrst read specified first block into gbuf.
bcs L4CC2 return errors.
ldy topdest get current pointer to top indexes.
cpy dtree have enough sapling indexes been
beq L4CC3 deallocated? yes, now deallocate blocks
ldx #$07 buffer up to 8 sapling index block
L4C6D lda gbuf,y addresses. fetch low block address
sta dealbufl,x and save it.
ora gbuf+$100,y is it a real block that is allocated?
beq L4C81 branch if phantom block.
lda gbuf+$100,y fetch high block address
sta dealbufh,x and save it.
dex decrement and test for dealc buf filled.
bmi L4C93 branch if 8 addresses fetched.
L4C81 dey look for end of deallocation limit.
cpy dtree is this the last position on tree level?
bne L4C6D if not.
iny
lda #$00 fill rest of dealc buffer with null addresses.
L4C8A sta dealbufl,x
sta dealbufh,x
dex
bpl L4C8A
L4C93 dey decrement to prepare for next time.
sty topdest save index.
ldx #$07
L4C99 stx dtmpx save index to dealc buf.
lda dealbufl,x
sta bloknml
ora dealbufh,x finished ?
beq L4C5E branch if done with this level.
lda dealbufh,x complete address with high byte,
sta bloknml+1
jsr rdgbuf read sapling level into gbuf.
bcs L4CC2 return errors.
jsr dealblk go free all data indexes in this block
bcs L4CC2
jsr wrtgbuf write the flipped index block
bcs L4CC2
ldx dtmpx restore index to dealc buff.
dex are there more to free?
bpl L4C99 branch if so.
bmi L4C5E branch always to get up to 8 more
L4CC2 rts sapling block numbers.
L4CC3 ldy dtree deallocate all sapling blocks greater
iny than specified block.
jsr dalblk1 (master index in gbuf)
bcs L4CC2 if errors.
jsr wrtgbuf write updated master index back to disk.
bcs L4CC2
ldy dtree figure out if tree can become sapling.
beq L4CEB branch if it can.
lda gbuf,y otherwise, continue with partial.
sta bloknml deallocation of last sapling index.
ora gbuf+$100,y is there such a sapling index block ?
beq L4CC2 all done if not.
lda gbuf+$100,y read in sapling level to be modified.
sta bloknml+1
jsr rdgbuf read highest sapling index into gbuf.
bcc L4CF5
rts
L4CEB jsr shrink shrink tree to sapling
bcs L4CC2
sapdel0 jsr drdfrst read specified sapling level index
bcs L4CC2 into gbuf. branch if error.
L4CF5 ldy dsap pointer to last of desirable indexes.
iny inc to 1st undesirable.
beq L4D05 branch if all are desirable.
jsr dalblk1 deallocate all indexes above specified.
bcs L4CC2
jsr wrtgbuf write out the index block
bcs L4CC2
L4D05 ldy dsap prepare to clean up last data block.
beq L4D1F branch if possibility of making a seed.
L4D0A lda gbuf,y fetch low order data block address.
sta bloknml
ora gbuf+$100,y is it a real block ?
beq L4CC2 if not, then done.
lda gbuf+$100,y
sta bloknml+1
jsr rdgbuf go read data block into gbuf.
bcc L4D2E branch if good read
rts or return error.
L4D1F lda dtree are both tree and sap levels zero ?
bne L4D0A if not.
jsr shrink reduce this sap to a seed.
bcs L4D52 if error.
seedel0 jsr drdfrst go read data block.
bcs L4D52 if error.
L4D2E ldy dseed+1 check high byte for no deletion.
beq L4D39 branch if all of 2nd page to be deleted.
dey if dseed > $200 then all were done.
bne L4D52 branch if that is the case.
ldy dseed clear only bytes >= dseed.
L4D39 lda #$00
L4D3B sta gbuf+$100,y zero out unwanted data
iny
bne L4D3B
ldy dseed+1 is that all ?
bne L4D4F yes.
ldy dseed
L4D49 sta gbuf,y
iny
bne L4D49
L4D4F jmp wrtgbuf update data block to disk.
L4D52 rts return error status.
drdfrst lda firstbl read specified 1st block into gbuf
ldx firstbh
jmp rdblk go read it
* beware that dealloc may bring in a new bitmap block and may destroy
* locations 46 and 47 which are used to point to the current index block.
shrink ldx firstbh first deallocate top index block
txa
pha
lda firstbl
pha save block address of this index block.
jsr dealloc free it from the bitmap
pla
sta bloknml set master of sapling
pla index block address.
sta bloknml+1
bcs L4D8D report errors.
lda gbuf get # of new 1st block from old index.
sta firstbl
lda gbuf+$100
sta firstbh
ldy #$00
jsr swapme flip that one entry in old top index.
sec now change file type,
lda stortyp from tree to sapling,
sbc #$10 or from sapling to seed.
sta stortyp
jsr wrtgbuf write the (deallocated) old top index.
L4D8D rts return error status.
dealblk ldy #$00 start at beginning.
dalblk1 lda bloknml save disk address of gbuf's data.
pha
lda bloknml+1
pha
L4D96 sty saptr save current index.
lda gbuf,y get low address of block to deallocate.
cmp #$01 test for null block into carry.
ldx gbuf+$100,y get remainder of block address.
bne L4DA5 branch if not null.
bcc L4DB0 was the low part null too ?
L4DA5 jsr dealloc free it up on volume bitmap.
bcs L4DB4 return any error.
ldy saptr get index to sapling level index block.
jsr swapme
L4DB0 iny next block address.
bne L4D96 if more to deallocate or test.
clc no error.
L4DB4 tax save error code, if any.
pla restore blocknm (16 bit)
sta bloknml+1
pla
sta bloknml
txa restore return code
rts
swapme lda delflag swapping or zeroing ?
bne L4DC5 skip if swapping.
tax make x = 0.
beq L4DCB zero the index (always taken).
L4DC5 ldx gbuf+$100,y index high
lda gbuf,y index low
L4DCB sta gbuf+$100,y save index high
txa
sta gbuf,y save index low
rts done.
* MEMMGR memory manager
*
* allocate buffer in memory tables
alcbuffr ldy #$04 index to user specified buffer.
alcbufr1 lda (A3L),y this buffer must be on a page boundary.
tax save for validation.
cmp #$08
bcc L4E1E cannot be lower than video !
cmp #$BC nor greater than $BB00
bcs L4E1E since it would wipe out globals...
sta datptr+1
dey
lda (A3L),y low address should be zero !
sta datptr
bne L4E1E error if not page boundary.
inx add 4 pages for 1k buffer.
inx
inx
inx
L4DED dex test for conflicts.
jsr cmembit test for free buffer space
and memmap,y P8 memory bitmap
bne L4E1E report memory conflict, if any.
cpx datptr+1 test all 4 pages.
bne L4DED
inx add 4 pages again for allocation.
inx
inx
inx
L4DFE dex set proper bits to 1
jsr cmembit
ora memmap,y to mark it's allocation.
sta memmap,y
cpx datptr+1 set all 4 pages
bne L4DFE
ldy fcbptr calculate buffer number
lda fcbbuf,y
asl buffer number = (entnum) * 2.
sta fcbbuf+11,y save it in fcb.
tax use entnum * 2 as index to global
lda datptr+1 buffer addr tables. get addr already
sta buftbl-1,x validated as good. store hi addr
clc (entnums start at 1, not 0)
rts
L4E1E lda #$56 buffer is in use or not legal
sec
rts
getbufadr tax index into global buffer table.
lda buftbl-2,x
sta bufaddrl
lda buftbl-1,x
sta bufaddrh
rts
relbuffr jsr getbufadr preserve buffer address in 'bufaddr'
tay returns high buffer address in acc.
beq L4E54 branch if unallocated buffer space.
stz buftbl-1,x take address out of buffer list.
stz buftbl-2,x (x was set up by getbufadr)
freebuf ldx bufaddrh get hi buffer address
inx add 4 pages to account for 1k space.
inx
inx
inx
L4E43 dex drop to next lower page.
jsr cmembit get bit and position to memtable of
eor #$FF this page. invert mask.
and memmap,y mark address as free space.
sta memmap,y
cpx bufaddrh all pages freed ?
bne L4E43 no.
L4E54 clc no error.
rts
* calculate memory allocation bit position.
* on entry: x = high address of buffer, low address assumed zero.
* on exit: acc = allocation bit mask, x = unchanged, y = pointer to memtabl byte
cmembit txa page address
and #$07 which page in any 2k set ?
tay use as index to determine
lda whichbit,y bit position representation.
pha save bit position mask for now.
txa page address.
lsr
lsr determine 2k set
lsr
tay return it in y.
pla restore bit mask. return bit position
rts in a & y, pointer to memtabl in x.
valdbuf lda usrbuf+1 high address of user's buffer
cmp #$02 must be greater than page 2.
bcc L4E1E report bad buffer
ldx cbytes+1
lda cbytes get cbytes-1 value.
sbc #$01 (carry is set)
bcs L4E76
dex
L4E76 clc
adc usrbuf calculate end of request address.
txa do high address.
adc usrbuf+1 the final address
tax must be less than $BFnn (globals)
cpx #$BF
bcs L4E1E report bad buffer.
inx loop thru all affected pages.
vldbuf1 dex check next lower page.
jsr cmembit
and memmap,y if 0 then no conflict.
bne L4E1E branch if conflict.
cpx usrbuf+1 was that the last (lowest) page ?
bne vldbuf1 if not.
clc all pages ok.
rts
getbuf ldy #$02 give user address of file buffer referenced by refnum.
lda bufaddrl
sta (A3L),y
iny
lda bufaddrh
sta (A3L),y
clc no errors possible
rts
setbuf ldy #$03
jsr alcbufr1 allocate new buffer address over old one
bcs L4EC7 report any errors immediately
lda bufaddrh
sta usrbuf+1
lda bufaddrl
sta usrbuf
jsr freebuf free address space of old buffer
ldy #$00
ldx #$03
L4EB8 lda (usrbuf),y move all 4 pages of the buffer to
sta (datptr),y new location.
iny
bne L4EB8
inc datptr+1
inc usrbuf+1
dex
bpl L4EB8
clc no errors
L4EC7 rts
* move 3 pages of dispatcher from 'displc2' to 'dispadr'
* this move routine must be resident above $E000 at all times
calldisp lda RRAMWRAMBNK2 read/write RAM bank 2
lda RRAMWRAMBNK2
lda /dispadr
sta A2L+1
lda #dispadr
sta A2L
lda /displc2
sta A1L+1
stz A1L
ldy #$00
ldx #$03 3 pages to move.
L4EE0 dey move a page of code.
lda (A1L),y
sta (A2L),y
tya
bne L4EE0
inc A1L+1 pointers to next page
inc A2L+1
dex move all pages needed
bne L4EE0
lda RRAMWRAMBNK1 read/write RAM bank 1
lda RRAMWRAMBNK1 swap mli space back in
stz mliact MLI active flag
stz softev
lda /dispadr point RESET to dispatch entry
sta softev+1
eor #$A5
sta pwredup power up byte
jmp dispadr
* translate a prodos call into a smartport call
* to access unseen smartport devices
remap_sp ldx #$03 assume 3 parameters.
lda A4L command number
sta cmdnum
bne L4F1B taken if not status call
ldy #spstatlist set up memory for the status list buffer
sty buf fake up the prodos parameters
ldy /spstatlist
sty buf+1
stz bloknml set statcode = 0 for simple status call
L4F1B cmp #$03 format command ?
bne L4F21 no.
ldx #$01 format has only 1 parameter.
L4F21 stx statparms set # of parms.
lda unitnum
lsr turn unit number into an index
lsr
lsr
lsr
tax
lda spunit-1,x get the smartport unit number and
sta sp_unitnum store into smartport parm list.
lda spvectlo-1,x
sta sp_vector+1 copy smartport entry address
lda spvecthi-1,x
sta sp_vector+2
ldx #$04 copy buffer pointer and block #
L4F3F lda buf-1,x from prodos parameters
sta sp_bufptr-1,x to smartport parameter block
dex
bne L4F3F
sp_vector jsr $0000 smartport call (entry address gets modified)
cmdnum .HS 00 command #
.DA statparms
bcs L4F6E
ldx cmdnum status call ?
bne L4F6E no...
ldx spstatlist+1 else get the block count
ldy spstatlist+2
lda spstatlist get the returned status.
bit #$10 is there a disk present ?
bne L4F65 yes, check for write protected.
lda #$2F return offline error.
bra L4F6D
L4F65 and #$44 mask all but write allowed and write
eor #$40 protected bits. if allowed and not
beq L4F6E protected, exit with carry clear
lda #$2B else return write protected error.
L4F6D sec
L4F6E rts
spvectlo .HS 0000000000000000 storage for low byte of smartport entry.
.HS 00000000000000
spvecthi .HS 0000000000000000 storage for high byte of smartport entry.
.HS 00000000000000
statparms .HS 03 # of parms (always 3 except format)
sp_unitnum .HS 00 unit number
sp_bufptr .HS 0000 data buffer
.HS 000000 block number (3 bytes)
* data tables
scnums .HS D3000000 table of valid mli command numbers.
.HS 40410000808182
.HS 65C0C1C2C3C4C5C6
.HS C7C8C9CACBCCCDCE
.HS CF00D0D1D2
pcntbl .HS 02FFFFFF parameter counts for the calls
.HS 0201FFFF030300
.HS 04070102070A0201
.HS 0103030404010102
.HS 02FF020202
* command table
cmdtable .DA create
.DA destroy
.DA rename
.DA setinfo
.DA getinfo
.DA online
.DA setprefx
.DA getprefx
.DA openf
.DA newline
.DA readf
.DA writef
.DA closef
.DA flushf
.DA setmark
.DA getmark
.DA seteof
.DA geteof
.DA setbuf
.DA getbuf
* corresponding command function bytes
disptch .HS A0A1A2A3
.HS 84050607
.HS 88494A4B
.HS 2C2D4E4F
.HS 50515253
dinctbl .HS 0100000200 table to increment directory usage/eof counts
pass .HS 75
xdosver .HS 00
compat .HS 00
.HS C3270D000000
rootstuf .HS 0F02000400000800
whichbit .HS 8040201008040201
ofcbtbl .HS 0C0D1819151617
inftabl .HS 1E101F2080939421
.HS 22232418191A1B
deathmsg .HS 20
.AS -"RESTART SYSTEM-$01"
.HS 20
*** work space ***
* note: this area is accessed by code that depends on the order of these
* variables in the file control block and temporary directory.
own_blk .HS 0000
own_ent .HS 00
own_len .HS 00
h_credt .HS 0000 directory creation date
.HS 0000 directory creation time
.HS 00 version under which this dir created
.HS 00 earliest version that it's compatible
h_attr .HS 00 attributes (protect bit, etc.)
h_entln .HS 00 length of each entry in this directory
h_maxent .HS 00 maximum number of entries per block
h_fcnt .HS 0000 current # of files in this directory
h_bmap .HS 0000 address of first allocation bitmap
h_tblk .HS 0000 total number of blocks on this unit
d_dev .HS 00 device number of this directory entry
d_head .HS 0000 address of <sub> directory header
d_entblk .HS 0000 address of block which contains entry
d_entnum .HS 00 entry number within block
d_stor .HS 0000000000000000 file name
.HS 0000000000000000
d_filid .HS 00 user's identification byte
d_frst .HS 0000 first block of file
d_usage .HS 0000 # of blocks allocated to this file
d_eof .HS 000000 current end of file marker
d_credt .HS 0000 file creation date
.HS 0000 file creation time
d_sosver .HS 00 sos version that created this file
d_comp .HS 00 backward version compatibility
d_attr .HS 00 attributes (protect, r/w, enable, etc.)
d_auxid .HS 0000 user auxilliary identification
d_moddt .HS 0000 file's last modification date
.HS 0000 file's last modification time
d_dhdr .HS 0000 file directory header block address
scrtch .HS 00000000 scratch area for allocation address conversion.
oldeof .HS 000000 temp used in r/w
oldmark .HS 000000
xvcbptr .HS 00 used in 'cmpvcb' as a temp
vcbptr .HS 00
fcbptr .HS 00
fcbflg .HS 00
reql .HS 00
reqh .HS 00
levels .HS 00
totent .HS 00
entcntl .HS 00
entcnth .HS 00
cntent .HS 00
nofree .HS 00
bmcnt .HS 00
saptr .HS 00
pathcnt .HS 00
p_dev .HS 00
p_blok .HS 0000
bmptr .HS 00
basval .HS 00
half .HS 00
* bitmap info tables
bmastat .HS 00
bmadev .HS 00
bmadadr .HS 0000
bmacmap .HS 00
tposll .HS 00
tposlh .HS 00
tposhi .HS 00
rwreql .HS 00
rwreqh .HS 00
nlchar .HS 00
nlmask .HS 00
ioaccess .HS 00 has a call been made to disk device handler ?
cmdtemp .HS 00
bkbitflg .HS 00 used to set or clear backup bit
duplflag .HS 00
vcbentry .HS 00
* xdos temporary variables
namcnt .HS 00
rnptr .HS 00
namptr .HS 00
vnptr .HS 00
prfxflg .HS 00
cferr .HS 00
* deallocation temporary variables
firstbl .HS 00
firstbh .HS 00
stortyp .HS 00
deblock .HS 0000
dtree .HS 00
dsap .HS 00
dseed .HS 0000
topdest .HS 00
dtmpx .HS 00
loklst .EQ * look list of recognized device numbers
dealbufl .HS 0000000000000000
dealbufh .HS 0000000000000000
cbytes .HS 0000
.HS 00 cbytes+2 must = 0
bufaddrl .HS 00
bufaddrh .HS 00
delflag .HS 00 used by 'detree' to know if called from delete (destroy).
* zero fill to page boundary - 3 ($FEFD). so that cortland flag stays within page boundary.
.LIST ON
XDOS.FREE .EQ $FEFD-* (ProDOS 2.0.3 = $0C)
.LIST OFF
.BS XDOS.FREE
.DA calldisp
cortflag .HS 00 cortland flag. 1 = Cortland system (must stay within page boundary)
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XDOS.F
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

882
ProDOS.FX/ProDOS.S.XRW.txt Normal file
View File

@ -0,0 +1,882 @@
NEW
AUTO 3,1
* disk ii driver. object code = xrw_0
* $5300-5A00 moved to language card bank 1 at $D000
*--------------------------------------
blockio cld $D8 to flag language card bank 1 (main)
jsr rsetphse
lda q7l,x turn off write enable
nop
nop
jsr docheck
bcs L5334 branch if block # is out of range
ldy #$05
L5310 asl
rol ibtrk
dey
bne L5310
asl
bcc L531C
ora #$10 adjust for upper 4 bits of track
L531C lsr
lsr
lsr
lsr
pha save sector # across call
jsr regrwts
pla
bcs L5330 if error
inc buf+1
adc #$02
jsr regrwts get 2nd half of block
dec buf+1
L5330 lda ibstat
rts
L5334 lda #MLI.E.IO
sec
rts
* read/write a track/sector
regrwts ldy #$01 retry count
sty seekcnt only one recalibrate per call
sta ibsect
lda unitnum get slot # for this operation
and #$70
sta A2L
* make sure other drives in other slots are stopped
jsr chkprev
* now check if the motor is on, then start it
jsr chkdrv
php save test results
lda #$E8
sta montimeh
lda unitnum determine drive 1 or 2.
cmp iobpdn same drive used before ?
sta iobpdn save it for next time.
php keep results of compare.
asl get drive # into carry.
lda motoron,x turn on the drive.
bcc L5362 branch if drive 1 selected.
inx select drive 2.
L5362 lda drv0en,x
plp was it the same drive ?
beq L5372 yes.
plp indicate drive off by setting z-flag.
ldy #$07 150ms delay before stepping.
L536B jsr mswait
dey
bne L536B
php now zero flag set.
L5372 lda A4L make sure this command needs seeking.
beq L537C branch if status check.
lda ibtrk get destination track
jsr myseek and go to it.
* now at desired track. was the motor already on ?
L537C plp was motor on ?
bne L538E if so, don't wait.
* motor was off, wait for it to speed up
L537F lda #$01 wait 100us for each count in montime
jsr mswait
lda montimeh
bmi L537F count up to 0000
* motor should be up to speed,
* if it looks stopped then the drive is not present
jsr chkdrv is drive present ?
beq hndlerr branch if no drive
* now check: if it is not the format disk command,
* locate the correct sector for this operation
L538E lda A4L get command #
beq L53FD if 0 then status command
lsr set carry = 1 for read, 0 for write.
bcs L5398 must prenibblize for write
jsr prenib16
L5398 ldy #$40 64 retries
sty retrycnt
L539D ldx A2L get slot #.
jsr rdadr16 read next address field.
bcc L53BE branch if read ok.
L53A4 dec retrycnt one less chance.
bpl L539D branch to retry.
lda #$27 anticipate a bad drive error.
dec seekcnt can only recalibrate once.
bne hndlerr
lda curtrk
pha save track
asl
adc #$10 pretend track is 8 > curtrk
ldy #$40
sty retrycnt reset retries to 64 max.
bne L53CC always.
* have now read an address field. make sure this is
* the correct track, sector and volume.
L53BE ldy track check track
cpy curtrk
beq L53D5 ok
* recalibrating from this track
lda curtrk preserve destination track
pha
tya
asl
L53CC jsr settrk
pla
jsr myseek
bcc L539D always taken, go recalibrate
* drive is on right track, check volume mismatch
L53D5 lda sect is this the right sector ?
cmp ibsect
bne L53A4 no, try another sector.
lda A4L read or write ?
lsr the carry will tell.
bcc L53F4 branch if write
jsr read16
bcs L53A4 if bad read
L53E7 lda #$00
.HS D0 bne branch never taken (skip 1 byte)
hndlerr sec
sta ibstat error #
ldx A2L slot offset
lda motoroff,x turn off
rts
L53F4 jsr write16 write nibbles
statdne bcc L53E7 if no errors.
lda #$2B disk write protected.
bne hndlerr always
L53FD ldx A2L
lda q6h,x test for write protected
lda q7l,x
rol write protect-->carry-->bit 0=1
lda q6l,x keep in read mode
jmp statdne
myseek asl assume two phase stepper
sta track save destination track * 2
jsr alloff turn all phases off to be sure.
jsr drvindx get index to previous track
lda iobpdn,x for current drive.
sta curtrk current position.
lda track where to go next.
sta iobpdn,x
jsr seek move head there
alloff ldy #$03 turn off all phases before returning.
L5427 tya (send phase in acc)
jsr clrphase carry clear, phases should be turned off
dey
bpl L5427
lsr curtrk divide back down
clc
rts
* fast seek subroutine
*
* on entry:
* x = slot# times $10
* acc = desired half-track (single phase)
* curtrk = current halftrack
*
* on exit:
* a,y = uncertain
* x = undisturbed
* curtrk & trkn = final halftrack.
* prior = prior halftrack if seek was required.
* montimel,h are incremented by the # of 100us quantums required by
* seek for motor on time overlap.
*
* variables used: curtrk, trkn, countn, prior, A2L, montimel, montimeh
seek sta trkn save target track.
cmp curtrk on desired track ?
beq setphase yes, energize phase and return
lda #$00
sta trkcnt half track count.
L5440 lda curtrk save curtrk for delayed turnoff
sta prior
sec
sbc trkn delta-tracks.
beq L5483 branch if curtrk = destination
bcs mvout move out, not in.
eor #$FF calculate tracks to go.
inc curtrk increment current track (in).
bcc L545A always taken.
mvout adc #$FE calculate tracks to go.
dec curtrk decrement current track (out).
L545A cmp trkcnt
bcc L5462 and 'tracks moved'
lda trkcnt
L5462 cmp #$09
bcs L5468 if trkcnt > 8 then leave y alone (y=8)
tay else set acceleration index in y
sec
L5468 jsr setphase
lda ontable,y for 'ontime'
jsr mswait (100us intervals)
lda prior
clc for phaseoff
jsr clrphase turn off prior phase
lda offtable,y then wait 'offtime'
jsr mswait (100us intervals)
inc trkcnt count of 'tracks moved'
bne L5440 always taken
L5483 jsr mswait settle 25 msec
clc set for phase off
setphase lda curtrk get current track
clrphase and #$03 mask for 1 of 4 phases
rol double for phaseon/off index
ora A2L
tax
lda phaseoff,x turn on/off one phase
ldx A2L restore x reg
rts and return
* 7-bit to 6-bit 'deniblize' table (16-sector format)
*
* valid codes are $96 to $FF only. codes with more than one pair of
* adjacent zeroes or with no adjacent ones (except bit 7) are excluded.
*
* nibles in the ranges of $A0-$A3, $C0-$C7, $E0-$E3 are used for
* other tables since no valid nibles are in these ranges.
dnibl .HS 0004FFFF080CFF10 aligned to page boundary minus $96
.HS 1418
twobit3 .HS 008040C0FFFF used in fast prenib as lookup for 2-bit quantities.
.HS 1C20FFFFFF24282C
.HS 3034FFFF383C4044
.HS 484CFF5054585C60
.HS 6468
twobit2 .HS 00201030 used in fast prenib.
endmrks .HS DEAAEBFF table using 'unused' nibbles ($C4,$C5,$C6,$C7)
.HS FFFFFF6CFF70
.HS 7478FFFFFF7CFFFF
.HS 8084FF888C909498
.HS 9CA0
twobit1 .HS 0008040CFFA4 used in fast prenib.
.HS A8ACFFB0B4B8BCC0
.HS C4C8FFFFCCD0D4D8
.HS DCE0FFE4E8ECF0F4
.HS F8FC
* 6-bit to 2-bit conversion tables:
*
* dnibl2 abcdef-->0000FE
* dnibl3 abcdef-->0000DC
* dnibl4 abcdef-->0000BA
* origin = $D200 (page boundary)
* page align the following tables:
dnibl2 .HS 00
dnibl3 .HS 00
dnibl4 .HS 00
* 6-bit to 7-bit nibl conversion table
*
* codes with more than one pair of adjacent zeroes
* or with no adjacent ones (except B7) are excluded.
nibl .HS 960200
.HS 00970100009A0300
.HS 009B0002009D0202
.HS 009E0102009F0302
.HS 00A6000100A70201
.HS 00AB010100AC0301
.HS 00AD000300AE0203
.HS 00AF010300B20303
.HS 00B3000002B40200
.HS 02B5010002B60300
.HS 02B7000202B90202
.HS 02BA010202BB0302
.HS 02BC000102BD0201
.HS 02BE010102BF0301
.HS 02CB000302CD0203
.HS 02CE010302CF0303
.HS 02D3000001D60200
.HS 01D7010001D90300
.HS 01DA000201DB0202
.HS 01DC010201DD0302
.HS 01DE000101DF0201
.HS 01E5010101E60301
.HS 01E7000301E90203
.HS 01EA010301EB0303
.HS 01EC000003ED0200
.HS 03EE010003EF0300
.HS 03F2000203F30202
.HS 03F4010203F50302
.HS 03F6000103F70201
.HS 03F9010103FA0301
.HS 03FB000303FC0203
.HS 03FD010303FE0303
.HS 03FF
* nibl buffer 'nbuf2' must be on a page boundary !!!
nbuf2 .BS 86 nibl buffer for read/write of low 2-bits of each byte.
ibtrk .HS 00
ibsect .HS 00
ibstat .HS 00
iobpdn .HS 00
curtrk .HS 00
.HS 00000000000000 for slots 1 thru 7
.HS 00000000000000 drives 1 & 2
retrycnt .HS 00
seekcnt .HS 00
trkcnt .EQ * halftracks moved count.
countn .EQ * 'must find' count.
last .HS 00 'odd bit' nibls.
csum .HS 00 used for address header cksum
csstv .HS 00
sect .HS 00
track .EQ *
montimel .HS 00
montimeh .HS 00 also 'volume'
prior .HS 00
trkn .HS 00
* phase on, off time tables
* in 100 usec intervals (seek)
ontable .HS 013028
.HS 24201E1D1C1C
offtable .HS 702C
.HS 26221F1E1D1C1C
* mswait subroutine
*
* delays a specified number of 100 usec intervals for motor timing.
* on entry: acc holds number of 100 usec intervals to delay.
* on exit: acc = 0, x = 0, y = unchanged, carry set.
* montimel, montimeh are incremented once per 100 usec interval
* for motor on timing.
mswait ldx #$11 delay 86 usec
.1 dex
bne .1
inc montimel
bne .2
inc montimeh
.2 sec
sbc #$01
bne mswait
rts
* read address field subroutine (16-sector format)
*
* reads volume, track and sector.
* on entry: x = slot# times $10, read mode (q6l,q7l)
* on exit: carry set if error, else if no error:
* acc=$AA, y=0, x=unchanged, carry clear,
* ccstv contains chksum,sector,track & volume read.
* uses temps: count,last,csum & 4 bytes at ccstv
* expects: original 10-sector normal density nibls (4-bit) odd bits then even.
* observe 'no page cross' warnings on some branches !!!
rdadr16 ldy #$FC
sty countn 'must find' count
L569D iny
bne L56A5 low order of count.
inc countn (2k nibles to find address mark
beq rderr else error)
L56A5 lda q6l,x read nibl
bpl L56A5 *** no page cross ***
L56AA cmp #$D5 address mark 1 ?
bne L569D
nop nibl delay
L56AF lda q6l,x
bpl L56AF *** no page cross ***
cmp #$AA address mark 2 ?
bne L56AA if not, is it address mark 1 ?
ldy #$03 index for 4 byte read
L56BA lda q6l,x
bpl L56BA *** no page cross ***
cmp #$96 address mark 3 ?
bne L56AA if not, is it address mark 1
sei no interrupts until address is tested.
lda #$00 init checksum
L56C6 sta csum
L56C9 lda q6l,x read 'odd bit' nibl
bpl L56C9 *** no page cross ***
rol align odd bits, '1' into lsb.
sta last save them.
L56D2 lda q6l,x read 'even bit' nibl
bpl L56D2 *** no page cross ***
and last merge odd and even bits.
sta csstv,y store data byte.
eor csum
dey
bpl L56C6 loop on 4 data bytes.
tay if final checksum non-zero,
bne rderr then error.
L56E6 lda q6l,x first bit-slip nibl
bpl L56E6 *** no page cross ***
cmp #$DE
bne rderr
nop delay
L56F0 lda q6l,x second bit-slip nible
bpl L56F0 *** no page cross ***
cmp #$AA
bne rderr
clc normal read ok
rts
rderr sec
rts
* read subroutine (16-sector format)
*
* reads encoded bytes into nbuf1 and nbuf2.
* first reads nbuf2 high to low, then nbuf1 low to high.
* on entry: x=slot# times $10, read mode (q6l,q7l)
* on exit: carry set if error, else if no error:
* acc=$AA, x=unchanged, y=0, carry clear.
* observe 'no page cross' on some branches !!
read16 txa get slot #
ora #$8C prepare mods to read routine.
sta rd4+1 warning: the read routine is
sta rd5+1 self modified !!
sta rd6+1
sta rd7+1
sta rd8+1
lda buf modify storage addresses also
ldy buf+1
sta ref3+1
sty ref3+2
sec
sbc #$54
bcs L571F branch if no borrow
dey
L571F sta ref2+1
sty ref2+2
sec
sbc #$57
bcs L572B branch if no borrow
dey
L572B sta ref1+1
sty ref1+2
ldy #$20 32 tries to find
L5733 dey
beq L576D branch if can't find data header marks
L5736 lda q6l,x
bpl L5736
L573B eor #$D5 1st data mark
bne L5733
nop delay
L5740 lda q6l,x
bpl L5740
cmp #$AA 2nd data mark.
bne L573B if not, check for 1st again
nop
L574A lda q6l,x
bpl L574A
cmp #$AD 3rd data mark
bne L573B if not, check for data mark 1 again
ldy #$AA
lda #$00
L5757 sta pcl use z-page for keeping checksum
rd4 ldx q6l+$60 warning: self modified
bpl rd4
lda dnibl-$96,x
sta nbuf2-$AA,y save the two-bit groups in nbuf.
eor pcl update checksum.
iny next position in nbuf.
bne L5757 loop for all $56 two-bit groups.
ldy #$AA now read directly into user buffer.
bne rd5 always taken.
L576D sec error
rts
ref1 sta $1000,y warning: self modified
rd5 ldx q6l+$60 warning: self modified
bpl rd5
eor dnibl-$96,x get actual 6-bit data from dnib table.
ldx nbuf2-$AA,y get associated two-bit pattern
eor dnibl2,x and combine to form whole byte.
iny
bne ref1 loop for $56 bytes.
pha save for now, no time to store...
and #$FC strip low bits.
ldy #$AA prepare for next $56 bytes
rd6 ldx q6l+$60 warning: self modified
bpl rd6
eor dnibl-$96,x
ldx nbuf2-$AA,y
eor dnibl3,x
ref2 sta $1000,y warning: self modified
iny
bne rd6 loop unil this group of $56 read
rd7 ldx q6l+$60 warning: self modified
bpl rd7
and #$FC
ldy #$AC last group is $54 long
L57A5 eor dnibl-$96,x
ldx nbuf2-$AC,y
eor dnibl4,x combine to form full byte
ref3 sta $1000,y warning: self modified
rd8 ldx q6l+$60 warning: self modified
bpl rd8
iny
bne L57A5
and #$FC
eor dnibl-$96,x checksum ok ?
bne L57CC error if not.
ldx A2L test end marks.
L57C2 lda q6l,x
bpl L57C2
cmp #$DE
clc
beq L57CD branch if good trailer
L57CC sec
L57CD pla place last byte into user buffer
ldy #$55
sta (buf),y
rts
* set the slot dependent track location
settrk jsr drvindx get index to drive #
sta iobpdn,x
rts
* determine if motor is stopped
*
* if stopped, controller's shift register will not be changing.
* return y = 0 and zero flag set if it is stopped.
chkdrv ldx A2L
chkdrv0 ldy #$00 init loop counter.
.1 lda q6l,x read the shift register.
jsr ckdrts delay
pha
pla more delay.
cmp q6l,x has shift reg changed ?
bne ckdrts yes, motor is moving.
lda #$28 anticipate error.
dey no, dec retry counter
bne .1 and try 256 times.
ckdrts rts
drvindx pha preserve acc across call
lda A4L+1
lsr
lsr
lsr
lsr
cmp #$08
and #$07
rol
tax index to table.
pla restore acc
rts
* write subroutine (16 sector format)
*
* writes data from nbuf1 and buf. first nbuf2, high to low then direct
* from (buf), low to high. assumes 1 usec cycle time. self modified code !!
*
* on entry: x = slotnum times 16
*
* on exit: carry set if error (write protect violation).
* if no error, acc=uncertain, x=unchanged, y=0, carry clear.
write16 sec anticipate write protect error
lda q6h,x
lda q7l,x sense write protect flag
bpl L580C
jmp wexit exit if write protected
* timing is critical. a one micro-second cycle time is assumed.
* number in () is how many micro-seconds per instruction or subroutine
L580C lda nbuf2
sta pcl
lda #$FF sync data.
sta q7h,x (5) goto write mode
ora q6l,x (4)
ldy #$04 (2) for five nibls
nop (2)
pha (3)
pla (4)
wsync pha (3) exact timing.
pla (4) exact timing.
jsr wnibl7 (13,9,6) write sync.
dey (2)
bne wsync (3-) must not cross page !
lda #$D5 (2) 1st data mark
jsr wnibl9 (15,9,6)
lda #$AA (2) 2nd data mark
jsr wnibl9 (15,9,6)
lda #$AD (2) 3rd data mark
jsr wnibl9 (15,9,6)
tya (2) zero checksum
ldy #$56 (2) nbuf2 index
bne L583D (3) branch always
* total time in this write byte loop must = 32us !!!
L583A lda nbuf2,y (4) prior 6-bit nibl
L583D eor nbuf2-1,y (5) xor with current
tax (2) index to 7-bit nibl
lda nibl,x (4) must not cross page boundary
ldx A2L (3) restore slot index
sta q6h,x (5) store encoded byte
lda q6l,x (4) handshake
dey (2)
bne L583A (3-) must not cross page boundary
* end of write byte loop
lda pcl (3) get prior nibl (from nbuf2)
wrefd1 ldy #$00 (2) warning: load value modified by prenib.
wrefa1 eor $1000,y (4) warning: address modified by prenib.
and #$FC (2) strip low 2 bits
tax (2) index to nibl table
lda nibl,x (4)
wrefd2 ldx #$60 (2) warning: value modified by prenib.
sta q6h,x (5) write nibl
lda q6l,x (4) handshake
wrefa2 lda $1000,y (4) prior nibl. warning: address modified by prenib.
iny (2) all done with this page ?
bne wrefa1 (3-) loop until page end.
lda pch (3) get next (precalculated & translated) nibl.
beq L58C0 (2+) branch if code written was page aligned.
lda A2H (3) get byte address of last byte to be written.
beq L58B3 (2+) branch if only 1 byte left to write.
lsr (2) test for odd or even last byte (carry set/clear)
lda pch (3) restore nibl to acc.
sta q6h,x (5)
lda q6l,x (4)
lda A1L (3) = byte 0 of 2nd page xor'd with byte 1 if
nop (2) above test set carry.
iny (2) y=1
bcs L5899 (2+) branch if last byte to be odd.
wrefa3 eor $1100,y (4) warning: address modified by prenib.
and #$FC (2) strip low 2 bits.
tax (2) index to nibl table
lda nibl,x (4) get nibl
wrefd3 ldx #$60 (2) restore slot index. warning: modified by prenib
sta q6h,x (5)
lda q6l,x (4)
wrefa4 lda $1100,y (4) warning: modified by prenib
iny (2) got prior nibl, point to next
wrefa5 eor $1100,y (4) warning: modified by prenib
L5899 cpy A2H (3) set carry if this is the last nibl
and #$FC (2) strip low 2 bits
tax (2)
lda nibl,x (4)
wrefd4 ldx #$60 (2) restore slot. warning: modified by prenib
sta q6h,x (5)
lda q6l,x (4)
wrefa6 lda $1100,y (4) get prior nibl. warning: modified by prenib
iny (2)
bcc wrefa3 (3-) branch if not the last.
bcs L58B1 (3) waste 3 cycles, branch always.
L58B1 bcs L58C0 (3) branch always.
L58B3 lda >pch (4) absolute reference to zero page
sta q6h,x (5)
lda q6l,x (4)
pha (3) waste 14 micro-seconds total
pla (4)
pha (3)
pla (4)
L58C0 ldx A1H (3) use last nibl (anded with $FC) for checksum
lda nibl,x (4)
wrefd5 ldx #$60 (2) restore slot. warning: modified by prenib
sta q6h,x (5)
lda q6l,x (4)
ldy #$00 (2) set y = index end mark table.
pha (3) waste another 11 micro-seconds
pla (4)
nop (2)
nop (2)
L58D3 lda endmrks,y (4) dm4, dm5, dm6 and turn off byte.
jsr wnibl (15,6) write it
iny (2)
cpy #$04 (2) have all end marks been written ?
bne L58D3 (3) if not.
clc (2,9)
wexit lda q7l,x out of write mode
lda q6l,x to read mode.
rts return from write.
* 7-bit nibl write subroutines
wnibl9 clc (2) 9 cycles, then write.
wnibl7 pha (3) 7 cycles, then write.
pla (4)
wnibl sta q6h,x (5) nibl write
ora q6l,x (4) clobbers acc, not carry
rts (6)
* preniblize subroutine (16 sector format)
*
* converts 256 bytes of user data in (buf) into 6 bit nibls in nbuf2.
* high 6 bits are translated directly by the write routines.
*
* on entry: buf is 2-byte pointer to 256 bytes of user data.
*
* on exit: a,x,y undefined. write routine modified to do direct conversion
* of high 6 bits of user's buffer data.
prenib16 lda buf self-modify the addresses because of
ldy buf+1 the fast timing required.
clc all offsets are minus $AA.
adc #$02 the highest set is buf+$AC.
bcc L58FA branch if no carry,
iny otherwise add carry to high address.
L58FA sta prn3+1 self mod 3
sty prn3+2
sec
sbc #$56 middle set is buf+$56.
bcs L5906 branch if no borrow,
dey otherwise deduct from high.
L5906 sta prn2+1 self mod 2
sty prn2+2
sec
sbc #$56 low set is exactly buf
bcs L5912
dey
L5912 sta prn1+1 self mod 1
sty prn1+2
ldy #$AA count up to 0.
prn1 lda $1000,y warning: self modified. get byte from lowest group.
and #$03 strip high 6 bits.
tax index to 2 bit equivalent.
lda twobit1,x
pha save pattern
prn2 lda $1056,y warning: self modified. get byte from middle group.
and #$03
tax
pla restore pattern.
ora twobit2,x combine 2nd group with 1st.
pha save new pattern.
prn3 lda $10AC,y warning: self modified. get byte from highest group.
and #$03
tax
pla restore new pattern
ora twobit3,x and form final nibl.
pha
tya
eor #$FF
tax
pla
sta nbuf2,x save in nibl buffer.
iny inc to next set.
bne prn1 loop until all $56 nibls formed.
ldy buf now prepare data bytes for write16 subr.
dey prepare end address.
sty A2H
lda buf
sta wrefd1+1 warning: the following storage addresses
beq L595F starting with 'wref' are refs into code
eor #$FF space, changed by this routine.
tay index to last byte of page in (buf).
lda (buf),y pre-niblize the last byte of the page
iny with the first byte of the next page.
eor (buf),y
and #$FC
tax
lda nibl,x get disk 7-bit nible equivalent.
L595F sta pch
beq L596F branch if data to be written is page
lda A2H aligned. check if last byte is even
lsr or odd address. shift even/odd -> carry.
lda (buf),y if even, then leave intact.
bcc L596D branch if odd.
iny if even, then pre-xor with byte 1.
eor (buf),y
L596D sta A1L save result for write routine.
L596F ldy #$FF index to last byte of data to write.
lda (buf),y to be used as a checksum.
and #$FC strip extra bits
sta A1H and save it.
ldy buf+1 now modify address references to
sty wrefa1+2 user data.
sty wrefa2+2
iny
sty wrefa3+2
sty wrefa4+2
sty wrefa5+2
sty wrefa6+2
ldx A2L and lastly, index references to
stx wrefd2+1 controller.
stx wrefd3+1
stx wrefd4+1
stx wrefd5+1
rts
chkprev eor iobpdn same slot as last ?
asl
beq L59BD
lda #$01
sta montimeh
L59A6 lda iobpdn
and #$70
tax
beq L59BD branch if no previous ever (boot only).
jsr chkdrv0 check if previous drive running.
beq L59BD branch if stopped.
lda #$01 delay
jsr mswait
lda montimeh
bne L59A6
L59BD rts
rsetphse lda unitnum get unit number.
and #$7F mask off high bit.
tax
* clear all the phases and force read mode
lda phaseoff+0,x make sure all motor phases are off.
lda phaseoff+2,x
lda phaseoff+4,x
lda phaseoff+6,x
rts
docheck lda A4L command #.
cmp #$04 is the command allowed ?
bcs L59E6 if not.
lda bloknml
ldx bloknml+1
stx ibtrk calculate block's track and sector.
beq L59E8 branch if block # is in range,
dex else test further.
bne L59E6 taken if bad range.
cmp #$18 must be < $118
bcc L59E8 then ok.
L59E6 sec error.
rts
L59E8 clc
rts end of obj xrw_0
.LIST ON
XRW.FREE .EQ $D6EC-*
.LIST OFF
.BS XRW.FREE pad bytes to $D6EC (pathbuf-$14)
* variables used by mli for smartport interface
spstatlist .HS 00000000 ref pathbuf-$14 smartport status list buffer
spunit .HS 0000000000000000 ref pathbuf-$10smartport unit numbers
.HS 0000000000000000
* pathname buffer starts at this page boundary (pathbuf = $D700)
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.XRW
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM

228
ProDOS.FX/ProDOS.S.txt Normal file
View File

@ -0,0 +1,228 @@
NEW
AUTO 3,1
.LIST OFF
.OP 65816
.OR $2000
.TF PRODOS,TSYS
*--------------------------------------
.INB INC/ZP.I
.INB INC/IO.I
.INB INC/MONITOR.I
.INB INC/MLI.I
.INB INC/MLI.E.I
*--------------------------------------
MMStartUp .EQ $0202
NewHandle .EQ $0902
PtrToHand .EQ $2802
MessageCenter .EQ $1501
DisposeHandle .EQ $1002
MMShutDown .EQ $0302
ReadTimeHex .EQ $0D03
Int2Hex .EQ $220B
TLTextMountVolume .EQ $1201
*--------------------------------------
.MA SHORTMX
sep #$30
.EM
.MA SHORTM
sep #$20
.EM
.MA SHORTX
sep #$10
.EM
.MA LONGMX
rep #$30
.EM
.MA LONGM
rep #$20
.EM
.MA LONGX
rep #$10
.EM
*--------------------------------------
.MA IIGS
ldx ##]1
jsl $E10000
.EM
*--------------------------------------
P8QUIT .EQ $E0D000
GSOS .EQ $E100A8
GSOS2 .EQ $E100B0
OS_BOOT .EQ $E100BD indicates O/S initially booted*--------------------------------------
lookptr .EQ $0A
idapple .EQ $0C model machine id
idxl .EQ $10 general use 16 bit index pointer
devid .EQ $12
src .EQ $12
dst .EQ $14
cnt .EQ $16
cde .EQ $18
ecde .EQ $1A
wndbtm .EQ $23
pcl .EQ $3A
pch .EQ $3B
A1L .EQ $3C
A1H .EQ $3D
A2L .EQ $3E
A2H .EQ $3F
A3L .EQ $40
A4L .EQ $42
unitnum .EQ $43
buf .EQ $44 2-byte data buffer pointer which
accsav .EQ $45 overlaps accsav (temp acc save byte)
bloknml .EQ $46 used mostly as 16 bit block # pointer
zpt .EQ $48 highly used zero page index pointer
datptr .EQ $4A ptr to data area of buffer.
sos .EQ $4C sos buffer pointer.
usrbuf .EQ $4E data ptr in user buffer.
* zero page variables for Bird's Better Bye
smparms .EQ $60 set mark parms
sm_refn .EQ $61 file reference number
fpos_lo .EQ $62 new file position (3 bytes)
fpos_mid .EQ $63
fpos_hi .EQ $64
lstpntr .EQ $65 device list pointer (16 bit)
valcnt .EQ $67 name counter
filecount .EQ $68 # of displayable files in directory
namelen .EQ $69 length of filename
gp_cnt .EQ $6A general purpose counter
dlevel .EQ $6B directory level
fnstore .EQ $6C filename storage pointer (16 bit)
entlen .EQ $6E directory entry length
entblk .EQ $6F directory entries/block
filecnt .EQ $70 directory file count (16 bit)
blkfl .EQ $72 block flag / file counter
topname .EQ $73 index # of top name in display
filetyps .EQ $74 128 byte table of filetypes
errnum .EQ $DE
*--------------------------------------
tst128 .EQ $0080 temp page 0 routine for memory test
auxsp .EQ $0101
RAMXDRV .EQ $0200 load address for aux bank /RAM driver
inbuf .EQ $0200 keyboard buffer
pbuf .EQ $0280 prefix buffer
p3vect .EQ $03F0 page 3 vectors (16 bytes)
softev .EQ $03F2 RESET vector
pwredup .EQ $03F4 power up byte
nmivect .EQ $03FB nmi handler
txtp2 .EQ $0400 test location for aux card
vmode .EQ $04FB video firmware operating mode
clkmode .EQ $0538 clock mode
ch80col .EQ $057B 80 column ch position
vline5 .EQ $0600 line 5 of display
vline10 .EQ $04A8 line 10 of display
vline11 .EQ $0528 line 11 of display
vline12 .EQ $05A8 line 12 of display
vline13 .EQ $0628 line 13 of display
vline14 .EQ $06A8 line 14 of display
vline16 .EQ $07A8 line 16 of display
vline23 .EQ $0750 line 23 of display
vline24 .EQ $07D0 line 24 of display
DirBlkBuf .EQ $0C00
dbuf .EQ $0C00 8 page directory buffer
vblock1 .EQ $0E00 ramdisk directory block
volbuf .EQ $0F00 volume buffer
dispadr .EQ $1000
iobuf .EQ $1400 i/o buffer
fbuf .EQ $1800 FCB buffer
op_buf .EQ $1C00 open file buffer (selector)
sysentry .EQ $2000 .SYS file load address
phaseoff .EQ $C080 disk port
motoroff .EQ $C088 disk port
motoron .EQ $C089 disk port
drv0en .EQ $C08A disk port
q6l .EQ $C08C disk port
q6h .EQ $C08D disk port
q7l .EQ $C08E disk port
q7h .EQ $C08F disk port
rdtcp .EQ $C108 Thunderclock read entry
wttcp .EQ $C10B Thunderclock write entry
auxmove .EQ $C311 move (3C)-(3E) to (42)
xfer .EQ $C314
rwts .EQ $D000 disk ii driver in bank 1
displc2 .EQ $D100 system death routine stored in bank 2
pathbuf .EQ $D700 pathname buffer
tclk_in .EQ $D742 clock driver in bank 2
fcbbuf .EQ $D800 fcb buffer
vcbbuf .EQ $D900 vcb buffer
bmbuf .EQ $DA00 512 byte bitmap buffer
gbuf .EQ $DC00 general purpose 512 byte block buffer
*--------------------------------------
* $2000 mli_0 mli loader/relocator
* $2C80 ram_1 installer for /RAM
* $2D00 ram_2 /RAM driver in main lc
* $2D9B mli_3 interrupts
* $2E00 mli_1 global page
* $2F00 tclock_0 Thunderclock driver
* $2F80 cclock_0 Cortland clock driver
* $3000 mli_2 xdos mli & block file manager
* $5100 ram_0 /RAM driver in aux mem
* $5300 xrw_0 disk core routines
* $5A00 sel_0 dispatcher
* $5D00 sel_1 enhanced quit code (Bird's Better Bye)
* $6000 sel_2 GQuit dispatcher support
*--------------------------------------
.INB USR/SRC/PRODOS.FX/PRODOS.S.LDR.A
.INB USR/SRC/PRODOS.FX/PRODOS.S.LDR.B
RAM .PH $FF00
.INB USR/SRC/PRODOS.FX/PRODOS.S.RAM
.EP
IRQ .PH $FF9B
.INB USR/SRC/PRODOS.FX/PRODOS.S.IRQ
.EP
GP .PH $BF00
.INB USR/SRC/PRODOS.FX/PRODOS.S.GP
.EP
TCLK .PH $D742
.INB USR/SRC/PRODOS.FX/PRODOS.S.TCLK
.EP
CCLK .PH $D742
.INB USR/SRC/PRODOS.FX/PRODOS.S.CCLK
.EP
XDOS .PH $DE00
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.A
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.B
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.C
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.D
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.E
.INB USR/SRC/PRODOS.FX/PRODOS.S.XDOS.F
.EP
RAMX .PH $200
.INB USR/SRC/PRODOS.FX/PRODOS.S.RAMX
.EP
XRW .PH $D000
.INB USR/SRC/PRODOS.FX/PRODOS.S.XRW
.EP
SEL0 .PH $1000
.INB USR/SRC/PRODOS.FX/PRODOS.S.SEL0
.EP
SEL1 .PH $1000
.INB USR/SRC/PRODOS.FX/PRODOS.S.SEL1
.EP
SEL2 .PH $1000
.INB USR/SRC/PRODOS.FX/PRODOS.S.SEL2
.EP
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S
ASM

25
SHARED/X.UNPAK.S.txt
View File

@ -10,18 +10,7 @@ NEW
* ZPPtr2
* ZPInMask,ZPBLOfsLBits,ZPBLOfsHBits,ZPBLLenBits
*--------------------------------------
X.Unpak lda (ZPInBufPtr) ULEN LO
eor #$ff
sta ZPnCnt
jsr X.Unpak.NextByte
lda (ZPInBufPtr) ULEN HI
eor #$ff
sta ZPnCnt+1
jsr X.Unpak.NextByte
X.Unpak >DEBUG
lda (ZPInBufPtr) CHNK.DATA.T
bne X.Unpak.PAK
*--------------------------------------
@ -63,6 +52,18 @@ X.Unpak.PAK pha A = BLBITS
jsr X.Unpak.NextByte get TOPCNT
lda (ZPInBufPtr) ULEN LO
eor #$ff
sta ZPnCnt
jsr X.Unpak.NextByte
lda (ZPInBufPtr) ULEN HI
eor #$ff
sta ZPnCnt+1
jsr X.Unpak.NextByte
lda (ZPInBufPtr) CHNK.DATA.PAK.TOPLEN
tax
jsr X.Unpak.NextByte get TOPCNT