mirror of
https://github.com/A2osX/A2osX.git
synced 2024-06-03 05:29:38 +00:00
9219 lines
367 KiB
Plaintext
9219 lines
367 KiB
Plaintext
KEEP PRODOS
|
|
MCOPY PRODOS.MAC
|
|
|
|
* disassembly of prodos version 2.0.3
|
|
* can be compiled with the orca/m assembler
|
|
* which produces an output file PRODOS (type = EXE)
|
|
* address refs beginning with 'L' were generated by orca disassembler
|
|
* address refs beginning with 'H' were added manually
|
|
|
|
* last edit: 01/24/13
|
|
|
|
* map of the object modules within prodos exe are as follows:
|
|
|
|
* $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
|
|
|
|
************************ IMPORTANT ************************
|
|
* *
|
|
* 1. In the language card area, the $D000 areas overlay. To *
|
|
* determine which bank is active requires that the main bank *
|
|
* has a CLD ($D8) at $D000 and the alternate bank does not. *
|
|
* $D000 in ROM = $6F, LC bank1 = $D8, LC bank2 = $EE *
|
|
* *
|
|
* 2. Location $E000 is used to determine the state of ROM vs. *
|
|
* language card. Therefore, the value of $E000 in the MLI *
|
|
* and ROM must differ. *
|
|
* *
|
|
* 3. In the section MEMMGR, the routine CALLDISP must access *
|
|
* the other $D000 bank so it MUST reside ABOVE $E000 in the *
|
|
* language card area. *
|
|
* *
|
|
* 4. The Disk II routine xrwtot MUST reside on a page boundary *
|
|
* to distinguish it from a ram-based driver. *
|
|
* *
|
|
* 5. In the /RAM driver ram3, the byte at $FF58 MUST be an rts *
|
|
* ($60) so the routine JSR $FF58 to determine an I/O card's *
|
|
* slot still works when the language card is switched in. *
|
|
* *
|
|
*****************************************************************
|
|
|
|
PRODOS START
|
|
|
|
* Predefined labels:
|
|
|
|
lookptr equ $0A
|
|
idapple equ $0C model machine id
|
|
idxl equ $10 general use 16 bit index pointer
|
|
devid equ $12
|
|
src equ $12
|
|
dst equ $14
|
|
cnt equ $16
|
|
cde equ $18
|
|
ecde equ $1A
|
|
wndlft equ $20
|
|
wndwdth equ $21
|
|
wndtop equ $22
|
|
wndbtm equ $23
|
|
ch equ $24 cursor horizontal
|
|
cv equ $25 cursor vertical
|
|
invflg equ $32 inverse flag
|
|
pcl equ $3A
|
|
pch equ $3B
|
|
A1L equ $3C
|
|
A1H equ $3D
|
|
A2L equ $3E
|
|
A2H equ $3F
|
|
A3L equ $40
|
|
A4L equ $42
|
|
unitnum equ $43
|
|
buf equ $44 2-byte data buffer pointer which
|
|
accsav equ $45 overlaps accsav (temp acc save byte)
|
|
bloknml equ $46 used mostly as 16 bit block # pointer
|
|
zpt equ $48 highly used zero page index pointer
|
|
datptr equ $4A ptr to data area of buffer.
|
|
sos equ $4C sos buffer pointer.
|
|
usrbuf equ $4E data ptr in user buffer.
|
|
|
|
* zero page variables for Bird's Better Bye
|
|
|
|
smparms equ $60 set mark parms
|
|
sm_refn equ $61 file reference number
|
|
fpos_lo equ $62 new file position (3 bytes)
|
|
fpos_mid equ $63
|
|
fpos_hi equ $64
|
|
lstpntr equ $65 device list pointer (16 bit)
|
|
valcnt equ $67 name counter
|
|
filecount equ $68 # of displayable files in directory
|
|
namelen equ $69 length of filename
|
|
gp_cnt equ $6A general purpose counter
|
|
dlevel equ $6B directory level
|
|
fnstore equ $6C filename storage pointer (16 bit)
|
|
entlen equ $6E directory entry length
|
|
entblk equ $6F directory entries/block
|
|
filecnt equ $70 directory file count (16 bit)
|
|
blkfl equ $72 block flag / file counter
|
|
topname equ $73 index # of top name in display
|
|
filetyps equ $74 128 byte table of filetypes
|
|
|
|
errnum equ $DE
|
|
tst128 equ $0080 temp page 0 routine for memory test
|
|
auxsp equ $0101
|
|
ramdest equ $0200 load address for aux bank /RAM driver
|
|
inbuf equ $0200 keyboard buffer
|
|
pbuf equ $0280 prefix buffer
|
|
p3vect equ $03F0 page 3 vectors (16 bytes)
|
|
softev equ $03F2 RESET vector
|
|
pwredup equ $03F4 power up byte
|
|
nmivect equ $03FB nmi handler
|
|
txtp2 equ $0400 test location for aux card
|
|
vline10 equ $04A8 line 10 of display
|
|
vmode equ $04FB video firmware operating mode
|
|
vline11 equ $0528 line 11 of display
|
|
clkmode equ $0538 clock mode
|
|
ch80col equ $057B 80 column ch position
|
|
vline12 equ $05A8 line 12 of display
|
|
vline5 equ $0600 line 5 of display
|
|
vline13 equ $0628 line 13 of display
|
|
vline14 equ $06A8 line 14 of display
|
|
vline23 equ $0750 line 23 of display
|
|
vline16 equ $07A8 line 16 of display
|
|
vline24 equ $07D0 line 24 of display
|
|
mslot equ $07F8 slot being accessed
|
|
lodintrp equ $0800
|
|
dbuf equ $0C00 8 page directory buffer
|
|
vblock1 equ $0E00 ramdisk directory block
|
|
volbuf equ $0F00 volume buffer
|
|
dispadr equ $1000 system death dispatcher run address
|
|
iobuf equ $1400 i/o buffer
|
|
fbuf equ $1800 FCB buffer
|
|
op_buf equ $1C00 open file buffer (selector)
|
|
sysentry equ $2000 .SYS file load address
|
|
prodos8 equ $BF00 prodos MLI and global page
|
|
kbd equ $C000 keyboard latch (read)
|
|
store80off equ $C000 disable 80-col store (write)
|
|
store80on equ $C001 enable 80-col store
|
|
rdmainram equ $C002 read from main 48K
|
|
rdcardram equ $C003 read from alt 48K
|
|
wrmainram equ $C004 write to main 48K
|
|
wrcardram equ $C005 write to alt 48K
|
|
setstdzp equ $C008 use main zero page/stack
|
|
setaltzp equ $C009 use alt zero page/stack
|
|
int3rom equ $C00A enable internal slot 3 ROM
|
|
slot3rom equ $C00B enable external slot 3 ROM
|
|
clr80vid equ $C00C disable 80 col hardware
|
|
clraltchar equ $C00E normal LC, flashing UC
|
|
kbdstrobe equ $C010 turn off keypressed flag
|
|
rd80col equ $C018 if 80-column store
|
|
newvideo equ $C029 video mode select
|
|
spkr equ $C030 click speaker
|
|
txtset equ $C051 switch in text
|
|
txtpage1 equ $C054 switch in text page 1
|
|
txtpage2 equ $C055 switch in text page 2
|
|
statereg equ $C068 memory state register
|
|
phaseoff equ $C080 disk port
|
|
romin1 equ $C081 read ROM/write RAM bank 2
|
|
romin equ $C082 read ROM
|
|
altram equ $C083 read/write RAM bank 2
|
|
motoroff equ $C088 disk port
|
|
motoron equ $C089 disk port
|
|
drv0en equ $C08A disk port
|
|
ramin equ $C08B read/write RAM bank 1
|
|
q6l equ $C08C disk port
|
|
q6h equ $C08D disk port
|
|
q7l equ $C08E disk port
|
|
q7h equ $C08F disk port
|
|
rdtcp equ $C108 Thunderclock read entry
|
|
wttcp equ $C10B Thunderclock write entry
|
|
init80 equ $C300 init 80 col card
|
|
slot3id1 equ $C305 slot 3 card id 1
|
|
slot3id2 equ $C307 slot 3 card id 2
|
|
slot3id3 equ $C30B slot 3 card id 3
|
|
ext80col equ $C30C slot 3 80 col id
|
|
auxmove equ $C311 move (3C)-(3E) to (42)
|
|
xfer equ $C314
|
|
slot3irq equ $C3FA slot 3 irq handler
|
|
clrrom equ $CFFF switch out $C8 ROMs
|
|
rwts equ $D000 disk ii driver in bank 1
|
|
displc2 equ $D100 system death routine stored in bank 2
|
|
pathbuf equ $D700 pathname buffer
|
|
tclk_in equ $D742 clock driver in bank 2
|
|
fcbbuf equ $D800 fcb buffer
|
|
vcbbuf equ $D900 vcb buffer
|
|
bmbuf equ $DA00 512 byte bitmap buffer
|
|
gbuf equ $DC00 general purpose 512 byte block buffer
|
|
xdosorg equ $DE00 xdos MLI in aux memory
|
|
romirq equ $FA41 monitor irq entry
|
|
breakv equ $FA59 monitor break vector
|
|
resetv equ $FA62 monitor reset entry
|
|
HFB1E equ $FB1E version check byte
|
|
init equ $FB2F init text screen
|
|
settxt equ $FB39 set text mode
|
|
tabv equ $FB5B set vertical position
|
|
setpwrc equ $FB6F create power-up byte
|
|
version equ $FBB3 monitor ROM id byte
|
|
zidbyte equ $FBC0 monitor ROM id byte
|
|
bell1 equ $FBDD generate bell tone
|
|
home equ $FC58 home cursor and clear screen
|
|
clreol equ $FC9C clear to end of line
|
|
rdkey equ $FD0C input char with cursor
|
|
crout equ $FD8E issue carriage return
|
|
cout equ $FDED output character
|
|
idroutine equ $FE1F returns system info
|
|
setinv equ $FE80 set inverse text mode
|
|
setnorm equ $FE84 set normal text mode
|
|
setkbd equ $FE89 reset input to keyboard
|
|
setvid equ $FE93 reset output to screen
|
|
lcdest equ $FF00 load address
|
|
bell equ $FF3A output bell (ctl-G)
|
|
oldrst equ $FF59 monitor reset entry
|
|
* romrts equ $FFCB an rts location that must be in ROM
|
|
P8QUIT equ $E0D000
|
|
GSOS equ $E100A8
|
|
GSOS2 equ $E100B0
|
|
OS_BOOT equ $E100BD indicates O/S initially booted
|
|
|
|
* object code = mli_0
|
|
* mli loader/relocater
|
|
* 1st instruction MUST be a jmp ($4C)
|
|
|
|
H2000 jmp prostart
|
|
jmp atalkset appletalk setup for network boot
|
|
jmp p16start GQuit setup for gs/os
|
|
LONGI OFF
|
|
LONGA OFF
|
|
msb on
|
|
H2009 dc c'Apple II'
|
|
H2011 dc c'ProDOS 8 V2.0.3 '
|
|
dc c'06-May-93'
|
|
H202F dc c' '
|
|
H203B dc c'Copyright Apple Computer, Inc., 1983-93'
|
|
H2062 dc c'All Rights Reserved.'
|
|
p16start inc setuprts set = 2 for GQuit rts
|
|
atalkset inc setuprts set = 1 for appletalk rts
|
|
prostart lda unitnum
|
|
sta H231D
|
|
jsr H2622
|
|
|
|
* 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 romin 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 romin 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 romin 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 H231D place boot devnum in globals
|
|
sta H2324
|
|
sta devnum last device used
|
|
jsr devsrch finish setting up globals
|
|
lda H2324
|
|
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 altram read/write RAM bank 2
|
|
lda altram
|
|
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 setstdzp use main zero page/stack
|
|
pha restore interrupt status
|
|
plp
|
|
sta int3rom enable internal slot 3 ROM
|
|
jsr H2C80 install ram disk
|
|
|
|
* check interrupt vector to determine ROM version
|
|
|
|
noramdsk lda romin1 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 setstdzp 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 int3rom 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 slot3rom enable slot 3 rom
|
|
lda slot3id1 check card id bytes
|
|
cmp #$38
|
|
bne hitswtch not terminal card
|
|
lda slot3id2
|
|
cmp #$18
|
|
bne hitswtch
|
|
lda slot3id3
|
|
cmp #$01
|
|
bne hitswtch
|
|
lda ext80col 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 slot3irq
|
|
cmp #$2C does card have an interrupt handler?
|
|
beq docard yes
|
|
hitswtch sta int3rom enable internal $C300 firmware
|
|
|
|
* verify that the card in aux slot is actually present
|
|
|
|
sta store80on enable 80-col store
|
|
sta txtpage2 switch in text page 2
|
|
lda #$EE
|
|
sta txtp2
|
|
asl a
|
|
asl txtp2
|
|
cmp txtp2
|
|
bne H2230
|
|
lsr a
|
|
lsr txtp2
|
|
cmp txtp2
|
|
H2230 sta txtpage1 main memory
|
|
sta store80off 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 romin read ROM
|
|
rts return to caller at setup entry point.
|
|
setuprts dc i1'$00' 0 = normal boot, <>0 = return
|
|
|
|
* set prefix to boot device
|
|
|
|
H2267 jsr prodos8 online
|
|
dc i1'$C5'
|
|
dc i2'H231C'
|
|
bcs relocerr
|
|
lda pbuf+1 get volume name length.
|
|
and #$0F strip devnum
|
|
beq relocerr
|
|
inc a add 1 for leading '/'
|
|
sta pbuf save prefix length.
|
|
lda #$2F place leading '/' in prefix buffer
|
|
sta pbuf+1
|
|
jsr prodos8 set prefix
|
|
dc i1'$C6'
|
|
dc i2'H2320'
|
|
bcs relocerr
|
|
tax =0
|
|
stx dst
|
|
ldy #$02 read directory into buffer
|
|
lda #>dbuf
|
|
H228E sta dst+1
|
|
sta H2325+1
|
|
sty H2327
|
|
stx H2327+1
|
|
jsr prodos8 read block
|
|
dc i1'$80'
|
|
dc i2'H2323'
|
|
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 lodintrp jmp to 'licode' (load interpreter)
|
|
|
|
* relocation/configuration error
|
|
|
|
relocerr sta romin read ROM
|
|
jsr home
|
|
ldy #$1D
|
|
H22C2 lda H22CD,y
|
|
sta vline12+4,y
|
|
dey
|
|
bpl H22C2
|
|
H22CB bmi H22CB
|
|
H22CD dc c'Relocation/Configuration Error'
|
|
H22EB ldy #$23
|
|
H22ED lda H22F8,y
|
|
sta vline14+2,y
|
|
dey
|
|
bpl H22ED
|
|
H22F6 bmi H22F6
|
|
H22F8 dc c'REQUIRES ENHANCED APPLE IIE OR LATER'
|
|
H231C dc i1'$02'
|
|
H231D dc i1'$60'
|
|
dc i2'pbuf+1'
|
|
H2320 dc i1'$01' parm count
|
|
dc i2'pbuf' buffer
|
|
H2323 dc i1'$03' parm count
|
|
H2324 dc i1'$00' unit number
|
|
H2325 dc i2'$0000' 2 byte data buffer
|
|
H2327 dc i2'$0000' 2 byte block number
|
|
cortland dc i1'$00' cortland loader flag (1 = Cortland)
|
|
newquitflag dc i1'$00' 1 = old quit code
|
|
|
|
H232B dc i1'$01' move interpreter loader code
|
|
dc i2'lodintrp' destination address
|
|
dc i2'H257B-licode' length to move
|
|
dc i2'licode' source address
|
|
dc i1'$01' move $3F0 vectors
|
|
dc i2'p3vect' destination
|
|
dc i2'$0010' 16 bytes to move
|
|
dc i2'H257B' source
|
|
dc i1'$01'
|
|
dc i2'lookptr'
|
|
dc i2'$0002'
|
|
dc i2'dst'
|
|
dc i1'$01' move 128k test to zero page
|
|
dc i2'tst128' destination
|
|
dc i2'H2622-H25DC' length
|
|
dc i2'H25DC' source
|
|
dc h'FF' done
|
|
dsp64 dc i1'$01' move p8 dispatcher code
|
|
dc i2'displc2' destination
|
|
dc i2'birdbye-disp1obj' length (must be <= 3 pages)
|
|
dc i2'disp1obj' source
|
|
dc h'FF' done
|
|
newquitbl dc i1'$01' move Bird's Bye code
|
|
dc i2'displc2' dest
|
|
dc i2'GQdisp-birdbye' length (must be <= 3 pages)
|
|
dc i2'birdbye' source
|
|
dc h'FF' done
|
|
altdsptbl dc i1'$01' move GQuit launcher
|
|
dc i2'displc2' destination
|
|
dc i2'$0300' length (must be <= 3 pages)
|
|
dc i2'GQdisp' source
|
|
dc i1'$01' move a copy of GQuit launcher
|
|
dc i2'dispadr' to dispadr for gsos
|
|
dc i2'$0300' length (must be <= 3 pages)
|
|
dc i2'GQdisp' source
|
|
dc h'FF' done
|
|
|
|
* tables for moving 64k version of mli for execution
|
|
|
|
H2367 dc i1'$01' relocation table. 1=move src to dst
|
|
dc i2'lanirq' destination
|
|
dc i2'H2E00-H2D9B' length to move
|
|
dc i2'H2D9B' source
|
|
dc i1'$01'
|
|
dc i2'prodos8' globals
|
|
dc i2'$0100' in one page
|
|
dc i2'H2E00'
|
|
dc h'00' 0=clear buffers $D700-$DDFF
|
|
dc i2'pathbuf'
|
|
dc i2'xdosorg-pathbuf'
|
|
dc i1'$01'
|
|
dc i2'xdosorg'
|
|
dc i2'ramsrc-xdosobj' length of mli
|
|
dc i2'xdosobj'
|
|
dc i1'$01'
|
|
dc i2'rwts'
|
|
dc i2'disp1obj-blockio' length of disk ii driver
|
|
dc i2'blockio'
|
|
dc h'FF' done
|
|
|
|
* move thunderclock
|
|
|
|
rlclk64 dc i1'$01' relocation table. 1=move src to dst
|
|
dc i2'tclk_in' destination
|
|
dc i2'tclk_end-tclock_0' length of thunderclock driver
|
|
dc i2'tclock_0' source
|
|
dc i1'$04' 4=relocate and move program
|
|
dc i2'tclk_in'
|
|
dc i2'H2F69-tclock_0'
|
|
dc i2'tclk_in'
|
|
dc h'00'
|
|
dc h'C1C1'
|
|
clock64 dc i1'$00'
|
|
dc h'FF' done
|
|
|
|
* move cortland clock
|
|
|
|
cortclock dc i1'$01' relocation table. 1=move src to dst
|
|
dc i2'tclk_in' destination
|
|
dc i2'cclk_end-cclock_0' length of cortland clock driver
|
|
dc i2'cclock_0' source
|
|
dc h'FF' done
|
|
|
|
* load and run appletalk configuration file (atinit) if present
|
|
* or continue loading and running .system file
|
|
|
|
* loader origin $800
|
|
|
|
ofsL equ licode-lodintrp offset from loader org
|
|
|
|
licode jsr prodos8 check for file 'atinit'
|
|
dc i1'$C4'
|
|
dc i2'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 prodos8 open 'atinit' file
|
|
dc i1'$C8'
|
|
dc i2'atopen' parms
|
|
bne H23E2 error
|
|
lda #$9F max size = 39.75k ($2000-$BF00)
|
|
sta rdlen+1
|
|
stz rdlen
|
|
jsr prodos8 read 'atinit' file to 'sysentry'
|
|
dc i1'$CA'
|
|
dc i2'rdparm'
|
|
bne H23E2 error - too big
|
|
jsr prodos8 close 'atinit' file
|
|
dc i1'$CC'
|
|
dc i2'clparm'
|
|
bne H23E2 error
|
|
lda romin enable ROM
|
|
jsr sysentry execute ATinit
|
|
H23DF jmp goloadint execute .system file
|
|
|
|
* fatal error
|
|
|
|
H23E2 ldx H23F0
|
|
H23E5 lda H23F0,x
|
|
sta vline16,x
|
|
dex
|
|
bne H23E5
|
|
H23EE beq H23EE hang
|
|
H23F0 dc i1'$1A' length of message
|
|
dc c'Unable to load ATInit file'
|
|
gfi_list equ *-ofsL
|
|
dc h'0A'
|
|
dc i2'atinitname'
|
|
dc h'00'
|
|
gfi_type equ *-ofsL
|
|
dc h'00000000'
|
|
dc h'0000000000000000'
|
|
dc h'0000'
|
|
atopen equ *-ofsL parms to open 'atinit'
|
|
dc h'03'
|
|
dc i2'atinitname'
|
|
dc i2'iobuf' i/o buffer
|
|
dc h'01' ref# hard coded since no other files
|
|
atinitname equ *-ofsL
|
|
dc h'06' length of name
|
|
dc c'atinit' name of appletalk config file
|
|
goloadint equ *-ofsL
|
|
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 a 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 a
|
|
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 prodos8 open interpreter file
|
|
dc i1'$C8'
|
|
dc i2'opparm'
|
|
bne badlod
|
|
jsr prodos8 get eof (length of file)
|
|
dc i1'$D1'
|
|
dc i2'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 prodos8 read interpreter file
|
|
dc i1'$CA'
|
|
dc i2'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 prodos8 close interpreter file
|
|
dc i1'$CC'
|
|
dc i2'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 romin enable ROM
|
|
jmp sysentry go run interpreter
|
|
cflag equ *-ofsL
|
|
dc h'00' set if a //c.
|
|
nointrp equ *-ofsL no interpreter found,
|
|
jsr prodos8 so quit.
|
|
dc i1'$65'
|
|
dc i2'quitparm'
|
|
badlod ldy ierlen center the error message
|
|
lda #$27
|
|
sec
|
|
sbc ierlen
|
|
lsr a
|
|
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 equ *-ofsL
|
|
dc c'** System program too large **'
|
|
iomess equ *-ofsL
|
|
dc c'** Unable to load'
|
|
dc c' X.System *********'
|
|
ierlen equ *-ofsL
|
|
dc h'00'
|
|
opparm equ *-ofsL parms for open call
|
|
dc h'03'
|
|
dc i2'pbuf'
|
|
dc i2'iobuf'
|
|
dc h'01'
|
|
efparm equ *-ofsL parms for get eof call
|
|
dc h'02'
|
|
dc h'01'
|
|
eof equ *-ofsL
|
|
dc h'000000' length of file.
|
|
rdparm equ *-ofsL parms for read call
|
|
dc h'04'
|
|
dc h'01'
|
|
dc i2'sysentry'
|
|
rdlen equ *-ofsL
|
|
dc h'0000'
|
|
dc h'0000'
|
|
clparm equ *-ofsL parms for close call
|
|
dc h'01'
|
|
dc h'00'
|
|
quitparm equ *-ofsL parms for quit call
|
|
dc h'04'
|
|
dc h'00'
|
|
dc h'0000'
|
|
dc h'00'
|
|
dc h'0000'
|
|
iterp equ *-ofsL interpreter suffix that is required
|
|
dc c'.SYSTEM'
|
|
|
|
* 16 bytes moved to $03F0 vectors
|
|
|
|
H257B dc i2'breakv'
|
|
dc i2'oldrst'
|
|
dc h'5A' powerup byte
|
|
jmp oldrst '&' vector
|
|
jmp oldrst ctrl-y vector
|
|
dc h'004000'
|
|
dc i2'irqent' global page interrupt vector
|
|
lc1in lda ramin read/write language card RAM bank 1
|
|
lda ramin
|
|
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 HFB1E 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
|
|
|
|
H25DC sta idapple H25DC-2621 was moved to location tst128
|
|
bpl not128 if already determined < 128k
|
|
lda #$EE
|
|
sta wrcardram write to aux mem while on main zp
|
|
sta rdcardram and read aux mem.
|
|
sta dbuf write these locs just to test aux mem
|
|
sta lodintrp 1k apart from each other.
|
|
lda dbuf
|
|
cmp #$EE
|
|
bne noaux
|
|
asl dbuf may be sparse mem mapping so
|
|
asl a change value and see what happens.
|
|
cmp dbuf
|
|
bne noaux branch if not sparse mapping.
|
|
cmp lodintrp
|
|
bne H2606 if not sparse.
|
|
noaux sec no aux memory available.
|
|
bcs H2607
|
|
H2606 clc
|
|
H2607 sta wrmainram switch back to main memory
|
|
sta rdmainram
|
|
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
|
|
|
|
* prodos greeting splash screen
|
|
|
|
H2622 lda spkr click speaker
|
|
sta clr80vid disable 80 col hardware
|
|
sta store80off 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
|
|
cld
|
|
jsr home
|
|
ldx #$07
|
|
H263D lda H2009,x print title
|
|
sta vline10+16,x
|
|
dex
|
|
bpl H263D
|
|
ldx #$1D
|
|
H2648 lda H2011,x
|
|
sta vline12+5,x
|
|
dex
|
|
bpl H2648
|
|
ldx #$0B
|
|
H2653 lda H202F,x
|
|
sta vline14+14,x
|
|
dex
|
|
bpl H2653
|
|
ldx #$26
|
|
H265E lda H203B,x
|
|
sta vline23,x
|
|
dex
|
|
bpl H265E
|
|
ldx #$13
|
|
H2669 lda H2062,x
|
|
sta vline24+10,x
|
|
dex
|
|
bpl H2669
|
|
sec
|
|
jsr idroutine returns system info
|
|
bcs H267D taken if not a //gs
|
|
lda #$80
|
|
trb newvideo video mode select
|
|
H267D lda spkr click speaker
|
|
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 dc h'0000000000000000' 8 bytes for smartport call
|
|
driveradr dc i2'$0000'
|
|
d2idx dc i1'$00'
|
|
diskins2 dc i1'$00' 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 a 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 H2802
|
|
sta driveradr
|
|
lda H2802+1
|
|
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 a
|
|
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 a 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 a 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
|
|
|
|
H2802 dc i2'rwts' disk ii driver
|
|
|
|
* id bytes: evens for clock, odds for disk
|
|
|
|
dskid dc h'082028005803703C'
|
|
|
|
* slot bits
|
|
|
|
sltbit dc h'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 a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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 a
|
|
tay into y reg.
|
|
asl a
|
|
asl a now form device # = slot #
|
|
asl a in high nibble.
|
|
jsr stadrv OR in low nibble, store in dev list.
|
|
plp restore # of devices in carry.
|
|
ror a 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 a 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 a convert $Cn to $n0
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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
|
|
dc h'00'
|
|
dc i2'spcparms' ignore any errors.
|
|
H28B1 stz statunit set unit# = 0
|
|
jsr spvect call to get the device count.
|
|
dc h'00' this is a status call
|
|
dc i2'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 a move hi nibble to lo nibble for
|
|
lsr a device table entries.
|
|
lsr a
|
|
lsr a
|
|
sta devid
|
|
rts
|
|
|
|
* check unknown card to see if disk id = $Cn00:nn 20 nn 00 nn 03
|
|
|
|
cmpid lda clrrom 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 dc i1'$03' # of parms
|
|
statunit dc i1'$00' unit number (code for smartport stat)
|
|
dc i2'numdev2'
|
|
dc h'00' status code (0 = general status)
|
|
|
|
* indexes into driver table
|
|
|
|
driveridx dc h'06' s3, d1
|
|
dc h'1E' s7, d2
|
|
dc h'0E' s7, d1
|
|
dc h'1C' s6, d2
|
|
dc h'0C' s6, d1
|
|
dc h'1A' s5, d2
|
|
dc h'0A' s5, d1
|
|
dc h'14' s2, d2
|
|
dc h'04' s2, d1
|
|
dc h'12' s1, d2
|
|
dc h'02' s1, d1
|
|
dc h'18' s4, d2
|
|
dc h'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
|
|
dc h'00'
|
|
dc i2'spcparms'
|
|
lda numdev2 # of devices on smartport
|
|
cmp #$03
|
|
bcc H2974 only 2 devices,skip to next one.
|
|
inc a 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
|
|
dc h'00'
|
|
dc i2'spcparms'
|
|
lda numdev2 is this a block device?
|
|
bmi mount yes, so mount it.
|
|
H296E lda statunit go check the next unit#
|
|
inc a
|
|
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 a 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 a
|
|
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 romin write protect lc ram.
|
|
inc numdevs
|
|
ldx numdevs
|
|
tya
|
|
lsr a
|
|
cmp #$08
|
|
bcc nodev2 drive 2 mount
|
|
sbc #$08
|
|
ora #$08
|
|
nodev2 asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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 move 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
|
|
move 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 a upper 6 bits specify byte in table
|
|
lsr a
|
|
tax
|
|
lda opcodln,x
|
|
nxgroup dey is opcode len in lowest 2 bits of acc?
|
|
bmi H2B89 branch if it is
|
|
lsr a shift to next group.
|
|
lsr a (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 dc h'0928193C0A280D3C'
|
|
dc h'0B2A193F0A280D3C'
|
|
dc h'0928193F0A280D3C'
|
|
dc h'0928193F0A280D3C'
|
|
dc h'082A113F0A2A1D0C'
|
|
dc h'2A2A193F0A2A1D3F'
|
|
dc h'0A2A193F0A280D3C'
|
|
dc h'0A2A193F0A280D3C'
|
|
|
|
wsize dc i1'$00'
|
|
sgcnt dc i1'$00'
|
|
limlo dc h'0000000000000000'
|
|
limhi dc h'0000000000000000'
|
|
ofset dc h'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
|
|
LONG I,M
|
|
LONGA ON
|
|
LONGI ON
|
|
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
|
|
_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
|
|
_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 $01,s
|
|
sta $07,s
|
|
lda $02,s
|
|
sta $08,s
|
|
pla
|
|
pla
|
|
pla
|
|
lda #$00FF #NoOS
|
|
sec
|
|
rtl
|
|
LONGA OFF
|
|
LONGI OFF end of patch
|
|
|
|
* end of obj mli_0
|
|
|
|
ld_end equ * end of mli loader
|
|
ds $C80-(ld_end-H2000) pad 0's to $2C80
|
|
|
|
* object code = ram_1
|
|
*
|
|
* /RAM installer - transfer part of the driver to the aux bank
|
|
* and front part of the driver to the main bank (language card).
|
|
|
|
H2C80 ldy #$99 move $9A bytesfrom lcsrc to lcdest.
|
|
H2C82 lda lcsrc,y transfer main bank portion of driver
|
|
sta lcdest,y
|
|
dey
|
|
cpy #$FF
|
|
bne H2C82
|
|
ldx #<ramsrc set up to move aux portion of driver
|
|
stx A1L
|
|
dex
|
|
stx A2L
|
|
ldx #>ramsrc
|
|
stx A1L+1
|
|
inx
|
|
stx A2L+1
|
|
lda #<ramdest
|
|
sta A4L
|
|
lda #>ramdest ramsrc to ramdest
|
|
sta A4L+1
|
|
sec direction = to aux bank.
|
|
jsr auxmove move aux bank portion of driver.
|
|
lda #<lcdest put driver address into
|
|
sta drivertbl2+6 slot 3, drive 2.
|
|
lda #>lcdest
|
|
sta drivertbl2+7
|
|
inc numdevs count (-1) active devices
|
|
ldx numdevs
|
|
lda #$BF unit num of /RAM
|
|
sta devlist,x
|
|
rts end of obj ram_1
|
|
|
|
r1_end equ * end of /RAM installer
|
|
ds $D00-(r1_end-H2000) pad 0's to page boundary
|
|
|
|
* object code = ram_2
|
|
* /RAM driver (main bank portion)
|
|
* origin = $FF00
|
|
|
|
ofsR2 equ lcsrc-lcdest offset from ram driver org
|
|
|
|
lcsrc cld no decimal.
|
|
ldx #$0B save 13 bytes of parms
|
|
H2D03 lda A1L,x
|
|
sta a1l1,x
|
|
dex
|
|
bpl H2D03
|
|
ldx #$01
|
|
H2D0D lda passit,x save xfer vectors
|
|
sta sp1,x
|
|
dex
|
|
bpl H2D0D
|
|
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 #<ramdest card entry point
|
|
sta passit
|
|
lda #>ramdest
|
|
gocard equ *-ofsR2 also used by 'mainwrt'
|
|
sta passit+1
|
|
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 equ *-ofsR2
|
|
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 equ *-ofsR2 transfer data to card.
|
|
sta wrcardram 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 wrmainram write to main 48K.
|
|
lda #<donewrt done writing card
|
|
sta passit
|
|
lda #>donewrt
|
|
jmp gocard
|
|
sp1 equ *-ofsR2
|
|
dc h'0000'
|
|
a1l1 equ *-ofsR2 13 bytes of storage
|
|
|
|
* end of obj ram_2
|
|
|
|
r2_end equ *
|
|
ds $D9B-(r2_end-H2000) fill to lanirq ($FF9B see note below)
|
|
|
|
* object code = mli_3
|
|
*
|
|
* this routine handles interrupts and is coded to reach 'lreset' precisely at
|
|
* address $FFCB (ROM rts opcode) for rom switching to function.
|
|
|
|
lanirq equ *-ofsR2
|
|
|
|
H2D9B pha $2D9B-2DFF moved to $FF9B-FFFF
|
|
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 equ *-ofsR2
|
|
sta romin hits ROM rts at $FFCB
|
|
|
|
* 'lreset' address must = $FFCB for rom switch i/o to work
|
|
|
|
lreset equ *-ofsR2
|
|
lda rreset+1
|
|
pha
|
|
lda rreset
|
|
pha
|
|
jmp gorom
|
|
rreset equ *-ofsR2
|
|
dc I2'resetv-1' rts to resetv
|
|
fix45 equ *-ofsR2
|
|
sta p8areg A register savearea
|
|
lda oldacc
|
|
sta accsav
|
|
lda ramin read/write RAM bank 1
|
|
lda ramin
|
|
lda afbank
|
|
jmp irqxit0
|
|
stypfx equ *-ofsR2 fix appletalk PFI bug
|
|
sty newpfxptr
|
|
sty preflag prefix flag
|
|
rts
|
|
stapfx equ *-ofsR2
|
|
sta newpfxptr
|
|
sta preflag
|
|
rts
|
|
|
|
* these 3 vectors hard-coded into processor
|
|
|
|
dc i2'nmivect' nmi handler
|
|
dc i2'lreset' reset handler
|
|
irqv equ *-ofsR2
|
|
dc i2'lanirq' irq handler
|
|
|
|
* end of obj mli_3
|
|
|
|
* object code = mli_1
|
|
* global page
|
|
|
|
ofsG equ H2E00-prodos8 offset to global org
|
|
|
|
H2E00 jmp mlient1 $2E00-2EFF moved to $BF00
|
|
jspare equ *-ofsG
|
|
jmp jspare will be changed to point to dispatcher.
|
|
clockv equ *-ofsG P8 clock vector
|
|
rts changed to jmp ($4C) if clock present.
|
|
dc i2'tclk_in' clock routine entry address.
|
|
p8errv equ *-ofsG error reporting hook.
|
|
jmp syserr1
|
|
sysdeath equ *-ofsG
|
|
jmp sysdeath1 system failure hook.
|
|
p8error equ *-ofsG P8 error code
|
|
dc h'00'
|
|
drivertbl1 equ *-ofsG device driver table 1
|
|
dc i2'nodevice' slot 0 reserved
|
|
dc i2'nodevice' s1, d1
|
|
dc i2'nodevice' s2, d1
|
|
dc i2'nodevice' s3, d1
|
|
dc i2'nodevice' s4, d1
|
|
dc i2'nodevice' s5, d1
|
|
dc i2'nodevice' s6, d1
|
|
dc i2'nodevice' s7, d1
|
|
drivertbl2 equ *-ofsG device driver table 2
|
|
dc i2'nodevice' slot 0 reserved
|
|
dc i2'nodevice' s1, d2
|
|
dc i2'nodevice' s2, d2
|
|
dc i2'nodevice' s3, d2
|
|
dc i2'nodevice' s4, d2
|
|
dc i2'nodevice' s5, d2
|
|
dc i2'nodevice' s6, d2
|
|
dc i2'nodevice' s7, d2
|
|
devnum equ *-ofsG most recent accessed device
|
|
dc h'00'
|
|
numdevs equ *-ofsG count (-1) active devices
|
|
dc h'FF'
|
|
devlist equ *-ofsG active device list
|
|
dc h'00000000000000' up to 14 units may be active
|
|
dc h'00000000000000'
|
|
dc h'00'
|
|
msb off
|
|
dc c'(C)APPLE '
|
|
mlient1 equ *-ofsG
|
|
php
|
|
sei
|
|
jmp mlicont
|
|
aftirq equ *-ofsG irq returns here.
|
|
sta ramin read/write RAM bank 1
|
|
jmp fix45 restore $45 after interrupt in LC
|
|
oldacc equ *-ofsG
|
|
dc h'00'
|
|
afbank equ *-ofsG
|
|
dc h'00'
|
|
|
|
* memory map of lower 48k. each bit represents 1 page.
|
|
* protected pages = 1, unprotected = 0
|
|
|
|
memmap equ *-ofsG P8 memory bitmap
|
|
dc h'C000000000000000'
|
|
dc h'0000000000000000'
|
|
dc h'0000000000000001'
|
|
|
|
* table of buffer addresses for currently open files.
|
|
* these can only be changed thru the mli call setbuf.
|
|
|
|
buftbl equ *-ofsG
|
|
dc h'0000' file #1
|
|
dc h'0000' file #2
|
|
dc h'0000' file #3
|
|
dc h'0000' file #4
|
|
dc h'0000' file #5
|
|
dc h'0000' file #6
|
|
dc h'0000' file #7
|
|
dc h'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 equ *-ofsG interrupt table
|
|
dc h'0000' int #1
|
|
dc h'0000' int #2
|
|
dc h'0000' int #3
|
|
dc h'0000' int #4
|
|
p8areg equ *-ofsG A register savearea
|
|
dc h'00'
|
|
p8xreg equ *-ofsG X register savearea
|
|
dc h'00'
|
|
p8yreg equ *-ofsG Y register savearea
|
|
dc h'00'
|
|
p8sreg equ *-ofsG S register savearea
|
|
dc h'00'
|
|
p8preg equ *-ofsG P register savearea
|
|
dc h'00'
|
|
bankid equ *-ofsG bank ID byte (ROM/RAM)
|
|
dc h'01'
|
|
intadr equ *-ofsG interrupt return address
|
|
dc h'0000'
|
|
p8date equ *-ofsG bits 15-9=yr, 8-5=mo, 4-0=day
|
|
dc h'0000'
|
|
p8time equ *-ofsG bits 12-8=hr, 5-0=min, low-hi format
|
|
dc h'0000'
|
|
flevel equ *-ofsG current file level
|
|
dc h'00'
|
|
bubit equ *-ofsG backup bit disable, setfileinfo only
|
|
dc h'00'
|
|
spare1 equ *-ofsG used to save acc
|
|
dc h'00'
|
|
newpfxptr equ *-ofsG appletalk alternate prefix ptr
|
|
dc h'00'
|
|
machid equ *-ofsG machine ID byte
|
|
dc h'00'
|
|
rommap equ *-ofsG slot ROM bit map
|
|
dc h'00'
|
|
preflag equ *-ofsG prefix active flag
|
|
dc h'00'
|
|
mliact equ *-ofsG MLI active flag
|
|
dc h'00'
|
|
mliretn equ *-ofsG last MLI call return address
|
|
dc h'0000'
|
|
mlix equ *-ofsG MLI X register savearea
|
|
dc h'00'
|
|
mliy equ *-ofsG MLI Y register savearea
|
|
dc h'00'
|
|
|
|
* language card bank switching routines which must reside at $BFA0 because
|
|
* workstation software patches this area
|
|
|
|
HBFA0 equ *-ofsG
|
|
eor $E000 test for rom enable
|
|
beq L2EAA taken if ram enabled
|
|
sta romin read ROM
|
|
bne L2EB5 always
|
|
L2EAA lda bnkbyt2 for alternate ram
|
|
eor $D000 test
|
|
beq L2EB5 branch if not alternate ram
|
|
lda altram else enable alt $D000
|
|
L2EB5 pla return code
|
|
rti re-enable interrupts and return
|
|
mlicont equ *-ofsG
|
|
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 ramin force ram card on
|
|
lda ramin with write allowed
|
|
jmp xdosmli
|
|
irqexit equ *-ofsG
|
|
lda bankid determine state of ram card (ROM/RAM)
|
|
irqxit0 equ *-ofsG
|
|
beq L2EE2 branch if ram card enabled.
|
|
bmi L2EDF branch if alternate $D000 enabled.
|
|
lsr a determine if no ram card present.
|
|
bcc L2EE7 branch if rom only system.
|
|
lda romin1 enable rom
|
|
bcs L2EE7 always taken
|
|
L2EDF lda altram enable alternate $D000
|
|
L2EE2 lda #$01 preset bankid for rom.
|
|
sta bankid (reset if ram card interrupt)
|
|
L2EE7 lda p8areg restore acc
|
|
rti exit
|
|
irqent equ *-ofsG this entry only used when rom
|
|
bit ramin was enabled at time of interrupt.
|
|
bit ramin
|
|
jmp irqrecev
|
|
bnkbyt1 equ *-ofsG
|
|
dc h'00'
|
|
bnkbyt2 equ *-ofsG
|
|
dc h'00'
|
|
dc h'00000000' pad to before $BFFA
|
|
dc h'04' gsos compatibility byte ($BFFA)
|
|
dc h'00' pad
|
|
dc h'00' reserved
|
|
dc h'00' version # of running interpreter
|
|
dc h'00' preserved for System Utilities
|
|
kversion equ *-ofsG kernal version
|
|
dc h'23' represents release 2.0.3
|
|
|
|
* end of obj mli_1
|
|
|
|
* object code = tclock_0
|
|
* Thunderclock driver
|
|
* hard coded for slot 1
|
|
|
|
* $2F00-2F7C moved to $D742
|
|
|
|
ofsT equ tclock_0-tclk_in offset to Thunderclock org
|
|
|
|
tclock_0 ldx clkslt clock slot = $C1.
|
|
lda clkmode,x save current mode
|
|
pha
|
|
lda #$A3 send numeric mode byte to Thunderclock
|
|
jsr wttcp
|
|
clkslt equ *-ofsT+2 points to $C1.
|
|
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.
|
|
H2F14 lda inbuf,y convert values to binary.
|
|
and #$07 no value > 5 decimal.
|
|
sta pcl 'tens' place value
|
|
asl a multiply by 10
|
|
asl a
|
|
adc pcl
|
|
asl a
|
|
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 H2F14 if yes.
|
|
tay contains month
|
|
lsr a
|
|
ror a
|
|
ror a
|
|
ror a 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 H2F42 branch if not Sept 13 thru 30th
|
|
adc #$03 adj for mod 7 when day > 256
|
|
H2F42 sec
|
|
H2F43 sbc #$07
|
|
bcs H2F43 loop until < 0.
|
|
adc #$07 make it in the range of 0-6.
|
|
sbc pch the delta provides years offset.
|
|
bcs H2F4F branch if positive
|
|
adc #$07 else make it positive again.
|
|
H2F4F tay
|
|
lda yradj,y look up year
|
|
plp and combine it with hi bit of month
|
|
rol a
|
|
sta p8date+1 P8 date
|
|
lda A1L+1 hour
|
|
sta p8time+1 P8 time
|
|
lda A2L minute
|
|
sta p8time
|
|
pla restore previous mode.
|
|
ldx clkslt clock slot = $C1
|
|
sta clkmode,x
|
|
H2F69 rts
|
|
|
|
* this table contains entries for the cumulative # of days in a year,
|
|
* one entry for each month. the values are modulo 256.
|
|
|
|
tdays equ *-ofsT
|
|
dc h'00' January
|
|
dc h'1F' February
|
|
dc h'3B' March
|
|
dc h'5A' April
|
|
dc h'78' May
|
|
dc h'97' June
|
|
dc h'B5' July
|
|
dc h'D3' August
|
|
dc h'F2' September
|
|
dc h'14' October (MOD 256)
|
|
dc h'33' November
|
|
dc h'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 equ *-ofsT
|
|
dc h'60' Monday
|
|
dc h'5F' Sunday
|
|
dc h'5E' Saturday
|
|
dc h'5D' Friday
|
|
dc h'62' Thursday
|
|
dc h'61' Wednesday
|
|
dc h'60' Tuesday
|
|
tclk_end equ * end of obj tclock_0.
|
|
dc h'000000' pad
|
|
|
|
* object code = cclock_0
|
|
* Cortland clock driver
|
|
* $2F80-$2FFC moved to $D742
|
|
|
|
ofsC equ cclock_0-tclk_in offset to Cortland clock org
|
|
|
|
cclock_0 SHORT I,M 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
|
|
LONG I,M 16 bit mode.
|
|
lda #$0000 zero out result space.
|
|
pha push 4 words for hex time result
|
|
pha
|
|
pha
|
|
pha
|
|
_ReadTimeHex
|
|
SHORT M 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
|
|
H2FB1 cmp #100 out of range?
|
|
bcc H2FB9 no, go ahead and store
|
|
sbc #$64 else put back in range.
|
|
bra H2FB1 try again
|
|
H2FB9 sta p8date+1 year
|
|
pla
|
|
inc a increment day for Prodos 8 format.
|
|
sta p8date day
|
|
pla month
|
|
inc a increment month for Prodos 8 format.
|
|
asl a shift month as it sits in between
|
|
asl a the year and day values.
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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 equ *-ofsC
|
|
dc h'00' state of the state register
|
|
dc c'JIMJAYKERRY'
|
|
dc h'26' ampersand (Orca assembler doesn't like)
|
|
dc c'MIKE'
|
|
dc h'0000000000000000' pad 0's until length
|
|
dc h'0000000000000000' of driver = 125 bytes.
|
|
dc h'000000000000'
|
|
cclk_end equ * end of obj cclock_0.
|
|
dc h'000000' pad to page boundary
|
|
LONGI OFF
|
|
|
|
* object code = mli_2
|
|
* xdos mli system call processor
|
|
|
|
ofsX equ xdosobj-xdosorg offset to xdos org
|
|
|
|
xdosmli equ *-ofsX xdos MLI in aux ram
|
|
xdosobj 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
|
|
ldy #$00
|
|
sty p8error clear any previous errors.
|
|
iny find out if command is valid.
|
|
lda (A3L),y get command #
|
|
lsr a and hash it to a range of 0-$1F
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
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 make sure parameter list has the
|
|
lda pcntbl,x 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 #$65 is it quit?
|
|
beq special if so, then call quit dispatcher
|
|
asl a carry set if bfm or dev mgr
|
|
bpl godevmgr
|
|
bcs gobfmgr
|
|
lsr a shift back down for interrupt manager
|
|
and #$03 valid calls are 0 and 1
|
|
jsr intmgr
|
|
bra exitmli
|
|
special jmp jspare P8 system death vector
|
|
goclock jsr clockv go read clock.
|
|
bra exitmli no errors possible
|
|
godevmgr lsr a shift back down for device manager.
|
|
adc #$01 valid commands are 1 and 2.
|
|
sta A4L save command #.
|
|
jsr devmgr execute read or write request.
|
|
bra exitmli
|
|
gobfmgr lsr a shift back down for block file manager.
|
|
and #$1F valid commands are 0-$13
|
|
tax
|
|
jsr 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 equ *-ofsX
|
|
lda #$28 no device connected.
|
|
jsr p8errv P8 error vector.
|
|
scnerr lda #$01 no such command.
|
|
bne H30B0
|
|
scperr lda #$04 parameter count is invalid
|
|
H30B0 jsr gosyserr
|
|
bcs exitmli always taken
|
|
|
|
* ProDOS Device Manager
|
|
|
|
devmgr equ *-ofsX
|
|
ldy #$05
|
|
php do not allow interrupts.
|
|
sei the call spec for devices must
|
|
H30B9 lda (A3L),y be passed to drivers in page zero:
|
|
sta |A4L,y sta $0042,y
|
|
dey
|
|
bne H30B9
|
|
ldx buf+1 buffer page
|
|
stx usrbuf+1 to user buffer
|
|
inx
|
|
inx
|
|
lda buf is buffer page aligned (nn00) ?
|
|
beq H30CC branch if it is
|
|
inx else account for 3-page straddle
|
|
H30CC 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 equ *-ofsX
|
|
jsr p8errv P8 error vector
|
|
dmgr equ *-ofsX interrupts must always be off.
|
|
lda unitnum get device # and
|
|
and #$F0 strip misc lower nibble
|
|
sta unitnum then save it.
|
|
lsr a use as index to device table
|
|
lsr a
|
|
lsr a
|
|
tax
|
|
lda drivertbl1,x fetch driver address
|
|
sta goadr
|
|
lda drivertbl1+1,x
|
|
sta goadr+1
|
|
gocmd equ *-ofsX
|
|
jmp (goadr) goto driver (or error if no driver)
|
|
|
|
* ProDOS interrupt manager
|
|
|
|
intmgr equ *-ofsX
|
|
sta A4L interrupt command
|
|
lsr a allocate interrupt or deallocate?
|
|
bcs dealcint branch if deallocate.
|
|
ldx #$03 test for a free interrupt space in tbl.
|
|
alcint lda inttbl-2,x test high address for 0.
|
|
bne H3118 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 a
|
|
dey
|
|
sta (A3L),y pass back to user.
|
|
clc no errors.
|
|
rts
|
|
H3118 inx
|
|
inx next lower priority spot
|
|
cpx #$0B are all 4 already allocated?
|
|
bne alcint branch if not.
|
|
lda #$25 interrupt table full
|
|
bne H3124
|
|
badint lda #$53 invalid parameter.
|
|
H3124 jsr p8errv P8 error vector.
|
|
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 a
|
|
tax
|
|
lda #$00 now clear it
|
|
sta inttbl-2,x
|
|
sta inttbl-1,x
|
|
clc
|
|
rts
|
|
irqrecev equ *-ofsX
|
|
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 H315D and 1 if new roms.
|
|
pla restore return address and p-reg.
|
|
sta p8preg
|
|
pla
|
|
sta intadr interrupt return address
|
|
pla
|
|
sta intadr+1
|
|
H315D txs
|
|
lda mslot set up to re-enable $Cn00 rom
|
|
sta irqdev+2
|
|
tsx make sure stack has room for 16 bytes.
|
|
bmi H3170 branch if stack ok
|
|
ldy #$0F otherwise, make room and save it.
|
|
H3169 pla
|
|
sta svstack,y
|
|
dey
|
|
bpl H3169
|
|
H3170 ldx #$FA save 6 bytes of page 0
|
|
H3172 lda $00,x
|
|
sta svzerop-$FA,x
|
|
inx
|
|
bne H3172
|
|
|
|
* poll interrupt routines for a claimer
|
|
|
|
lda inttbl+1 test for a valid routine.
|
|
beq intr2 branch if no routine.
|
|
jsr goint1 execute
|
|
bcc irqdone
|
|
intr2 lda inttbl+3 repeat 3 more times
|
|
beq intr3
|
|
jsr goint2
|
|
bcc irqdone
|
|
intr3 lda inttbl+5
|
|
beq intr4
|
|
jsr goint3
|
|
bcc irqdone
|
|
intr4 lda inttbl+7
|
|
beq H31A2
|
|
jsr goint4
|
|
bcc irqdone
|
|
H31A2 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
|
|
ldx p8sreg test if stack needs restoring.
|
|
bmi H31C6 branch if not.
|
|
ldy #$00
|
|
H31BD lda svstack,y restore stack
|
|
pha
|
|
iny
|
|
cpy #$10
|
|
bne H31BD
|
|
H31C6 lda irqflag check for old roms.
|
|
bne H31DD branch if new roms.
|
|
ldy p8yreg restore registers.
|
|
ldx p8xreg
|
|
lda clrrom re-enable i/o card.
|
|
irqdev equ *-ofsX
|
|
lda $C100 Cn is self modifying.
|
|
lda irqdev+2 restore device id.
|
|
sta mslot slot being accessed.
|
|
H31DD jmp irqexit do necessary bank switches and return.
|
|
irqflag equ *-ofsX
|
|
dc h'00' 0 = old roms. 1 = new roms.
|
|
irqcount equ *-ofsX
|
|
dc h'00' # of unclaimed interrupts.
|
|
svstack equ *-ofsX temporary save area from stack
|
|
dc h'0000000000000000'
|
|
dc h'0000000000000000'
|
|
svzerop equ *-ofsX temporary save area for zero page
|
|
dc h'000000000000'
|
|
goint1 equ *-ofsX
|
|
jmp (inttbl) interrupt routine 1
|
|
goint2 equ *-ofsX
|
|
jmp (inttbl+2) interrupt routine 2
|
|
goint3 equ *-ofsX
|
|
jmp (inttbl+4) interrupt routine 3
|
|
goint4 equ *-ofsX
|
|
jmp (inttbl+6) interrupt routine 4
|
|
syserr1 equ *-ofsX
|
|
sta p8error P8 error code
|
|
plx
|
|
plx pop 1 level of return
|
|
sec
|
|
rts
|
|
sysdeath1 equ *-ofsX
|
|
tax death error code.
|
|
sta clr80vid disable 80 col hardware.
|
|
lda txtset 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 txtpage1 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
|
|
H323E bra H323E end of xdos mli
|
|
|
|
* ProDOS Block File Manager
|
|
|
|
bfmgr equ *-ofsX
|
|
lda disptch,x translate into command address.
|
|
asl a 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 goadr
|
|
lda cmdtable+1,x high byte
|
|
sta goadr+1
|
|
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 gocmd execute command
|
|
bcc goodop
|
|
errorsys jsr p8errv P8 error vector
|
|
goodop rts
|
|
setpath equ *-ofsX
|
|
ldy #$01 index to pathname pointer
|
|
lda (A3L),y low pointer address
|
|
sta zpt
|
|
iny
|
|
lda (A3L),y hi pointer address
|
|
sta zpt+1
|
|
synpath equ *-ofsX entry used by rename for 2nd pathname.
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX calc how big a buffer is needed.
|
|
clc get index to users pathname buffer
|
|
ldy #$01
|
|
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 equ *-ofsX
|
|
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 a
|
|
lsr a
|
|
ror a
|
|
ror a
|
|
ror a multiply by 32.
|
|
sta fcbptr used as an index to fcb
|
|
tay
|
|
pla restore ref# in acc
|
|
cmp fcbbuf,y
|
|
bne errnoref
|
|
fndfcbuf equ *-ofsX get page address of file buffer.
|
|
lda fcbbuf+11,y
|
|
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 #$43 requested refnum is
|
|
sec illegal (out of range)
|
|
rts
|
|
|
|
* online command
|
|
|
|
online equ *-ofsX move user spec'd buffer ptr to usrbuf.
|
|
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 H3474 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 equ *-ofsX
|
|
H3474 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 equ *-ofsX
|
|
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
|
|
|
|
* create file
|
|
|
|
create equ *-ofsX
|
|
jsr lookfile check for duplicate, get free entry
|
|
bcs tstfnf error code may be 'file not found'
|
|
lda #$47 name already exists
|
|
crerr1 sec
|
|
rts
|
|
tstfnf cmp #$46 '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 #$4B 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 #$49 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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
lda p8date
|
|
beq H36A9 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 equ *-ofsX
|
|
H36A9 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 equ *-ofsX test if xdos disk.
|
|
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 equ *-ofsX
|
|
jsr lookfile see if file exists
|
|
bcs nofind
|
|
moventry equ *-ofsX
|
|
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 equ *-ofsX
|
|
jsr preproot go find volume
|
|
bcs fnderr
|
|
bne L37C5 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 #$40 bad path (carry set)
|
|
rts
|
|
lookfil0 equ *-ofsX
|
|
L37C5 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 #$51 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 #$44 path not found
|
|
rts
|
|
fnf1 lda #$46 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 a
|
|
L3869 bcc L386C
|
|
inx
|
|
L386C asl a
|
|
bne L3869
|
|
cpx #$05 is password disabled?
|
|
beq movhead
|
|
lda #$4A directory is not compatible
|
|
fnderr1 sec
|
|
rts
|
|
movhead jsr movhed0 move directory info.
|
|
jmp lookfil0 do next local pathname.
|
|
movhed0 equ *-ofsX
|
|
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
|
|
entadr equ *-ofsX
|
|
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 equ *-ofsX reset count of files per block
|
|
lda h_maxent
|
|
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 entadr 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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
jsr nxtpnam1 get new namptr in y and namlen in acc.
|
|
sty namptr save new pathname pointer.
|
|
rts (status reg according to accumulator)
|
|
nxtpnam1 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 #$45 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 equ *-ofsX
|
|
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 equ *-ofsX look for vcb with this device#
|
|
lda #$00
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
ldx vcbptr previously logged in volume?
|
|
lda vcbbuf,x (acc = 0?)
|
|
beq L3AB0 no, go prepare vcb.
|
|
jsr cmpvcb does vcb match vol read?
|
|
bcc L3B05 yes, do not disturb.
|
|
logvcb1 equ *-ofsX
|
|
L3AB0 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 equ *-ofsX compare volume name in vcb
|
|
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 equ *-ofsX check for other logged in volumes
|
|
lda #$00 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 equ *-ofsX test if enough free blocks available
|
|
ldx vcbptr 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 equ *-ofsX
|
|
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 #$48 disk full
|
|
sec
|
|
L3BC1 rts
|
|
count equ *-ofsX
|
|
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 equ *-ofsX
|
|
L3BEF asl a count the # of bits in this byte
|
|
bcc L3BFA
|
|
inc scrtch
|
|
bne L3BFA
|
|
inc scrtch+1
|
|
L3BFA ora #$00
|
|
bne L3BEF loop until all bits counted
|
|
rts
|
|
cntbms equ *-ofsX
|
|
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 a divide by 16. the result is
|
|
lsr a the # of bitmaps.
|
|
lsr a
|
|
lsr a
|
|
rts
|
|
|
|
* deallocate a block's entry in bitmap
|
|
* on entry, x,a = address of block
|
|
|
|
dealloc equ *-ofsX
|
|
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 a get pointer to byte in block that
|
|
lsr bmcnt represents the block address.
|
|
ror a
|
|
lsr bmcnt
|
|
ror a
|
|
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 L3C77 branch if on page 1 of bitmap
|
|
ora bmbuf+$100,y
|
|
sta bmbuf+$100,y
|
|
bcs L3C7D always.
|
|
bmbufhi equ *-ofsX this address + 2 is used as an
|
|
L3C77 ora bmbuf,y 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 equ *-ofsX
|
|
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 a multiply this and basval by 8
|
|
rol scrtch+1
|
|
asl a
|
|
rol scrtch+1
|
|
asl a
|
|
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 a find left most 'on' bit
|
|
bcs L3CE4 if found.
|
|
inx adjust low address.
|
|
bne L3CDE always.
|
|
L3CE4 lsr a 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 a
|
|
sta vcbbuf+21,y
|
|
L3D10 clc no errors.
|
|
lda scrtch return address in y,a of newly
|
|
ldy scrtch+1 allocated block.
|
|
rts
|
|
nxtbmap equ *-ofsX inc to next bitmap
|
|
ldy vcbptr but 1st make sure there is another one.
|
|
lda vcbbuf+19,y
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
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 a
|
|
sta vcbbuf+28,y
|
|
jsr upbmap
|
|
fndbmap equ *-ofsX
|
|
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 a 2 pages per block
|
|
sta basval
|
|
clc no errors.
|
|
L3D5F rts
|
|
L3D60 lda #$48 request can't be filled
|
|
sec error
|
|
rts
|
|
upbmap equ *-ofsX
|
|
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 equ *-ofsX read bitmap specified by dev and vcb.
|
|
sta bmadev
|
|
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 equ *-ofsX
|
|
sta bloknml
|
|
stx bloknml+1
|
|
jsr rdgbuf
|
|
rts
|
|
wrtbmap equ *-ofsX write bitmap.
|
|
lda #$02 write command.
|
|
bne L3D92 always.
|
|
wrtgbuf equ *-ofsX
|
|
lda #$02 write command
|
|
bne L3DC9 always.
|
|
rdgbuf equ *-ofsX
|
|
lda #$01 read command.
|
|
L3DC9 sta A4L pass to device handler.
|
|
lda #>gbuf general buffer.
|
|
dobitmap equ *-ofsX
|
|
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 equ *-ofsX
|
|
ldx fcbptr index to open fcb.
|
|
ldy #$02 index to user's mark parmeter.
|
|
L3DF0 lda fcbbuf+18,x transfer current position
|
|
sta (A3L),y to user's parameter list
|
|
inx
|
|
iny
|
|
cpy #$05 transfer 3 bytes
|
|
bne L3DF0
|
|
clc
|
|
rts
|
|
L3DFD lda #$4D invalid position
|
|
sec
|
|
rts
|
|
|
|
* set mark command
|
|
|
|
setmark equ *-ofsX
|
|
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.
|
|
L3E09 lda (A3L),y move it to 'tpos'
|
|
sta tposll-2,y
|
|
bcc L3E18 branch if mark < eof
|
|
cmp fcbbuf+21,x
|
|
bcc L3E18 branch if mark qualifies.
|
|
bne L3DFD branch if mark > eof (invalid position)
|
|
dex
|
|
L3E18 dey move/compare next lower byte of mark.
|
|
tya test for all bytes moved/tested.
|
|
eor #$01 preserves carry status.
|
|
bne L3E09 branch if more.
|
|
rdposn equ *-ofsX
|
|
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 a
|
|
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 a 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 a
|
|
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 a
|
|
lda tposlh ( if there is one )
|
|
ror a
|
|
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 a discard bit that says data block
|
|
lsr a unallocated because carry indicates if
|
|
jsr zipdata index block is invalid and needs to be
|
|
bcc L3F61 zeroed. branch if it doesn't need zeroed
|
|
jsr zeroindex zero index block in user's i/o buffer
|
|
bra L3F61
|
|
zeroindex equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
sta bloknml+1
|
|
jsr rfcbdat
|
|
bcs L3F86 if error.
|
|
jsr clrstats show whole chain is allocated.
|
|
svmark equ *-ofsX
|
|
L3F61 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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
cmp #$0D is it a directory ?
|
|
beq L3F9C yes...
|
|
lda #$4A no, so compatability problem.
|
|
jsr p8errv should not have been opened !!!
|
|
L3F9C lda scrtch recover results of previous subtraction.
|
|
lsr a 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 L3F61 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 L3F61 branch always.
|
|
dirpos1 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX prepare to read index block.
|
|
lda #$01 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
|
|
dc h'2C' skip next instruction
|
|
rfcbfst equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
jsr upbmap update the bitmap
|
|
bra L400D and write file's 1st block.
|
|
wfcbdat equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 a strip off file name length
|
|
lsr a by dividing by 16.
|
|
lsr a
|
|
lsr a
|
|
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 equ *-ofsX
|
|
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).
|
|
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
|
|
|
|
* read command
|
|
|
|
readf equ *-ofsX
|
|
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 a 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 inc all 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 a
|
|
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 L42C3 yes, done.
|
|
bne L421F no, read last partial block
|
|
L427B bcs L4249
|
|
lda tposhi get index to next block address
|
|
lsr a
|
|
lda tposlh
|
|
ror a
|
|
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 equ *-ofsX
|
|
pha save error code
|
|
jsr rwdone pass back # of bytes actually read
|
|
pla
|
|
sec error
|
|
rts
|
|
rwdone equ *-ofsX
|
|
L42C3 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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX this byte ($60) is used to set v flag.
|
|
rts
|
|
fxdatptr equ *-ofsX put current user buffer
|
|
lda datptr 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 equ *-ofsX
|
|
L4384 jsr rdposn
|
|
bcs L43B8 pass back any errors.
|
|
jsr preprw prepare for transfer.
|
|
jsr readpart move data to user's buffer.
|
|
bvc L4384 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 equ *-ofsX move request count to a more
|
|
ldy #$04 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 equ *-ofsX move the pointer to user's buffer
|
|
ldy #$02 to the block file manager
|
|
lda (A3L),y
|
|
sta usrbuf z-page area
|
|
iny
|
|
lda (A3L),y
|
|
sta usrbuf+1
|
|
gfcbstyp equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 L4406
|
|
iny
|
|
inx
|
|
bne L43EE always.
|
|
eoftest equ *-ofsX
|
|
L4406 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 L4406 no, test next lowest
|
|
L4414 rts
|
|
werreof equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
lda #$02 on exit both a and y = fcbptr+2.
|
|
tax x = 2
|
|
ora fcbptr
|
|
tay
|
|
rts
|
|
|
|
* write command
|
|
|
|
writef equ *-ofsX first determine if requested
|
|
jsr mvcbytes 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 a
|
|
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 a
|
|
lda tposlh
|
|
ror a
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 a 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 equ *-ofsX
|
|
jsr gfcbstyp find out if dealing with a tree.
|
|
cmp #$01 if seed then adj to file type is needed.
|
|
beq L45B2 branch if seed
|
|
jsr rfcbfst otherwise read in top of tree.
|
|
bcc L457A if no error.
|
|
L45B1 rts return errors.
|
|
swapdown equ *-ofsX make current seed into a sapling.
|
|
L45B2 jsr alcwblk 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 equ *-ofsX
|
|
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 equ *-ofsX check for 'never been modified'
|
|
jsr gfcbstat 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 equ *-ofsX make the device status call
|
|
sta unitnum
|
|
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 L463B branch if write protect error
|
|
lda #$00 otherwise, assume no errors.
|
|
L463B plp restore interrupt status
|
|
clc
|
|
tax save error.
|
|
beq L4641 branch if no error
|
|
sec else, set carry to show error.
|
|
L4641 pla
|
|
sta bloknml restore the block #
|
|
pla
|
|
sta bloknml+1
|
|
txa
|
|
rts carry is indeterminate.
|
|
|
|
* close command
|
|
|
|
closef equ *-ofsX close all ?
|
|
ldy #$01
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
ldy #$01 flush all ?
|
|
lda (A3L),y
|
|
bne L46E9 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 equ *-ofsX
|
|
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 equ *-ofsX for normal refnum flush,
|
|
L46E9 stz cferr 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 a type (y=fcbptr+2). shift into high
|
|
asl a nibble.
|
|
asl a
|
|
asl a
|
|
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 L47B4 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 L47B4 flush error
|
|
L47B2 clc
|
|
rts
|
|
|
|
* report error only if not a close all or flush all
|
|
|
|
glberr equ *-ofsX
|
|
L47B4 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 equ *-ofsX
|
|
ldy fcbptr index to fcb.
|
|
lda fcbbuf+8,y return status byte.
|
|
rts
|
|
L47CA lda #$4E access error
|
|
sec
|
|
L47CD rts
|
|
|
|
seteof equ *-ofsX can only move end of tree, sapling
|
|
jsr gfcbstyp or seed.
|
|
cmp #$04 tree type ?
|
|
bcs L47CA if not then access error
|
|
asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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 L4815 (branch if not)
|
|
bne purge branch if blocks to be released
|
|
dex
|
|
bpl L4808 all 3 bytes
|
|
eofset equ *-ofsX
|
|
L4815 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 a
|
|
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 a
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 a call spec via 'inftabl' translation
|
|
lsr a table but first change storage type to
|
|
lsr a external (low nibble) format.
|
|
lsr a
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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
|
|
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 equ *-ofsX
|
|
ldx #$00
|
|
L4AF5 sta gbuf+4,x
|
|
inx
|
|
iny
|
|
lda pathbuf,y
|
|
bne L4AF5
|
|
jmp wrtgbuf write changed header block.
|
|
renpath equ *-ofsX
|
|
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 equ *-ofsX
|
|
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
|
|
|
|
destroy equ *-ofsX
|
|
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 #$4E access error
|
|
jsr p8errv (returns to caller)
|
|
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 equ *-ofsX update block free count in vcb.
|
|
ldy vcbptr 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 p8errv P8 error vector
|
|
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 #$4A file incompatible
|
|
jsr p8errv (returns to caller)
|
|
fcbused equ *-ofsX mark fcb as dirty so the directory
|
|
pha 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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX read specified 1st block into gbuf
|
|
lda firstbl
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
ldy #$00 start at beginning.
|
|
dalblk1 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
ldy #$04 index to user specified buffer.
|
|
alcbufr1 equ *-ofsX
|
|
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 a 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 equ *-ofsX
|
|
tax index into global buffer table.
|
|
lda buftbl-2,x
|
|
sta bufaddrl
|
|
lda buftbl-1,x
|
|
sta bufaddrh
|
|
rts
|
|
relbuffr equ *-ofsX preserve buffer address in 'bufaddr'
|
|
jsr getbufadr
|
|
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 equ *-ofsX
|
|
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 equ *-ofsX
|
|
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 a
|
|
lsr a determine 2k set
|
|
lsr a
|
|
tay return it in y.
|
|
pla restore bit mask. return bit position
|
|
rts in a & y, pointer to memtabl in x.
|
|
valdbuf equ *-ofsX
|
|
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 equ *-ofsX
|
|
L4E82 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 L4E82 if not.
|
|
clc all pages ok.
|
|
rts
|
|
|
|
getbuf equ *-ofsX give user address of file buffer
|
|
ldy #$02 referenced by refnum.
|
|
lda bufaddrl
|
|
sta (A3L),y
|
|
iny
|
|
lda bufaddrh
|
|
sta (A3L),y
|
|
clc no errors possible
|
|
rts
|
|
|
|
setbuf equ *-ofsX
|
|
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 equ *-ofsX
|
|
lda altram read/write RAM bank 2
|
|
lda altram
|
|
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 ramin read/write RAM bank 1
|
|
lda ramin 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 equ *-ofsX
|
|
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 a turn unit number into an index
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
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 equ *-ofsX smartport call
|
|
jsr $0000 (entry address gets modified)
|
|
cmdnum equ *-ofsX
|
|
dc h'00' command #
|
|
dc i2'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 equ *-ofsX storage for low byte of smartport
|
|
dc h'0000000000000000' entry.
|
|
dc h'00000000000000'
|
|
spvecthi equ *-ofsX storage for high byte of smartport
|
|
dc h'0000000000000000' entry.
|
|
dc h'00000000000000'
|
|
statparms equ *-ofsX # of parms (always 3 except format)
|
|
dc h'03'
|
|
sp_unitnum equ *-ofsX
|
|
dc h'00' unit number
|
|
sp_bufptr equ *-ofsX
|
|
dc h'0000' data buffer
|
|
dc h'000000' block number (3 bytes)
|
|
|
|
* data tables
|
|
|
|
scnums equ *-ofsX table of valid mli command numbers.
|
|
dc h'D3000000'
|
|
dc h'40410000808182'
|
|
dc h'65C0C1C2C3C4C5C6'
|
|
dc h'C7C8C9CACBCCCDCE'
|
|
dc h'CF00D0D1D2'
|
|
pcntbl equ *-ofsX parameter counts for the calls
|
|
dc h'02FFFF'
|
|
dc h'FF0201FFFF030300'
|
|
dc h'04070102070A0201'
|
|
dc h'0103030404010102'
|
|
dc h'02FF020202'
|
|
|
|
* command table
|
|
|
|
cmdtable equ *-ofsX
|
|
dc i2'create' create
|
|
dc i2'destroy' destroy
|
|
dc i2'rename' rename
|
|
dc i2'setinfo' setinfo
|
|
dc i2'getinfo' getinfo
|
|
dc i2'online' online
|
|
dc i2'setprefx' set prefix
|
|
dc i2'getprefx' get prefix
|
|
dc i2'openf' open
|
|
dc i2'newline' newline
|
|
dc i2'readf' read
|
|
dc i2'writef' write
|
|
dc i2'closef' close
|
|
dc i2'flushf' flush
|
|
dc i2'setmark' set mark
|
|
dc i2'getmark' get mark
|
|
dc i2'seteof' seteof
|
|
dc i2'geteof' geteof
|
|
dc i2'setbuf' setbuf
|
|
dc i2'getbuf' getbuf
|
|
|
|
* corresponding command function bytes
|
|
|
|
disptch equ *-ofsX
|
|
dc h'A0A1A2A3'
|
|
dc h'84050607'
|
|
dc h'88494A4B'
|
|
dc h'2C2D4E4F'
|
|
dc h'50515253'
|
|
|
|
dinctbl equ *-ofsX table to increment
|
|
dc h'0100000200' directory usage/eof counts
|
|
pass equ *-ofsX
|
|
dc h'75'
|
|
xdosver equ *-ofsX
|
|
dc h'00'
|
|
compat equ *-ofsX
|
|
dc h'00'
|
|
dc h'C3270D000000'
|
|
rootstuf equ *-ofsX
|
|
dc h'0F02000400000800'
|
|
whichbit equ *-ofsX
|
|
dc h'8040201008040201'
|
|
ofcbtbl equ *-ofsX
|
|
dc h'0C0D1819151617'
|
|
inftabl equ *-ofsX
|
|
dc h'1E101F2080939421'
|
|
dc h'22232418191A1B'
|
|
deathmsg equ *-ofsX
|
|
dc h'20'
|
|
msb on
|
|
dc c'RESTART SYSTEM-$01'
|
|
dc h'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 equ *-ofsX
|
|
dc h'0000'
|
|
own_ent equ *-ofsX
|
|
dc h'00'
|
|
own_len equ *-ofsX
|
|
dc h'00'
|
|
h_credt equ *-ofsX
|
|
dc h'0000' directory creation date
|
|
dc h'0000' directory creation time
|
|
dc h'00' version under which this dir created
|
|
dc h'00' earliest version that it's compatible
|
|
h_attr equ *-ofsX attributes (protect bit, etc.)
|
|
dc h'00'
|
|
h_entln equ *-ofsX length of each entry in this directory
|
|
dc h'00'
|
|
h_maxent equ *-ofsX maximum number of entries per block
|
|
dc h'00'
|
|
h_fcnt equ *-ofsX current # of files in this directory
|
|
dc h'0000'
|
|
h_bmap equ *-ofsX address of first allocation bitmap
|
|
dc h'0000'
|
|
h_tblk equ *-ofsX total number of blocks on this unit
|
|
dc h'0000'
|
|
d_dev equ *-ofsX device number of this directory entry
|
|
dc h'00'
|
|
d_head equ *-ofsX address of <sub> directory header
|
|
dc h'0000'
|
|
d_entblk equ *-ofsX address of block which contains entry
|
|
dc h'0000'
|
|
d_entnum equ *-ofsX entry number within block
|
|
dc h'00'
|
|
d_stor equ *-ofsX
|
|
dc h'0000000000000000' file name
|
|
dc h'0000000000000000'
|
|
d_filid equ *-ofsX user's identification byte
|
|
dc h'00'
|
|
d_frst equ *-ofsX first block of file
|
|
dc h'0000'
|
|
d_usage equ *-ofsX # of blocks allocated to this file
|
|
dc h'0000'
|
|
d_eof equ *-ofsX current end of file marker
|
|
dc h'000000'
|
|
d_credt equ *-ofsX
|
|
dc h'0000' file creation date
|
|
dc h'0000' file creation time
|
|
d_sosver equ *-ofsX sos version that created this file
|
|
dc h'00'
|
|
d_comp equ *-ofsX backward version compatibility
|
|
dc h'00'
|
|
d_attr equ *-ofsX attributes (protect, r/w, enable, etc.)
|
|
dc h'00'
|
|
d_auxid equ *-ofsX user auxilliary identification
|
|
dc h'0000'
|
|
d_moddt equ *-ofsX
|
|
dc h'0000' file's last modification date
|
|
dc h'0000' file's last modification time
|
|
d_dhdr equ *-ofsX file directory header block address
|
|
dc h'0000'
|
|
scrtch equ *-ofsX scratch area for
|
|
dc h'00000000' allocation address conversion.
|
|
oldeof equ *-ofsX temp used in r/w
|
|
dc h'000000'
|
|
oldmark equ *-ofsX
|
|
dc h'000000'
|
|
xvcbptr equ *-ofsX used in 'cmpvcb' as a temp
|
|
dc h'00'
|
|
vcbptr equ *-ofsX
|
|
dc h'00'
|
|
fcbptr equ *-ofsX
|
|
dc h'00'
|
|
fcbflg equ *-ofsX
|
|
dc h'00'
|
|
reql equ *-ofsX
|
|
dc h'00'
|
|
reqh equ *-ofsX
|
|
dc h'00'
|
|
levels equ *-ofsX
|
|
dc h'00'
|
|
totent equ *-ofsX
|
|
dc h'00'
|
|
entcntl equ *-ofsX
|
|
dc h'00'
|
|
entcnth equ *-ofsX
|
|
dc h'00'
|
|
cntent equ *-ofsX
|
|
dc h'00'
|
|
nofree equ *-ofsX
|
|
dc h'00'
|
|
bmcnt equ *-ofsX
|
|
dc h'00'
|
|
saptr equ *-ofsX
|
|
dc h'00'
|
|
pathcnt equ *-ofsX
|
|
dc h'00'
|
|
p_dev equ *-ofsX
|
|
dc h'00'
|
|
p_blok equ *-ofsX
|
|
dc h'0000'
|
|
bmptr equ *-ofsX
|
|
dc h'00'
|
|
basval equ *-ofsX
|
|
dc h'00'
|
|
half equ *-ofsX
|
|
dc h'00'
|
|
|
|
* bitmap info tables
|
|
|
|
bmastat equ *-ofsX
|
|
dc h'00'
|
|
bmadev equ *-ofsX
|
|
dc h'00'
|
|
bmadadr equ *-ofsX
|
|
dc h'0000'
|
|
bmacmap equ *-ofsX
|
|
dc h'00'
|
|
tposll equ *-ofsX
|
|
dc h'00'
|
|
tposlh equ *-ofsX
|
|
dc h'00'
|
|
tposhi equ *-ofsX
|
|
dc h'00'
|
|
rwreql equ *-ofsX
|
|
dc h'00'
|
|
rwreqh equ *-ofsX
|
|
dc h'00'
|
|
nlchar equ *-ofsX
|
|
dc h'00'
|
|
nlmask equ *-ofsX
|
|
dc h'00'
|
|
ioaccess equ *-ofsX has a call been made to
|
|
dc h'00' disk device handler ?
|
|
cmdtemp equ *-ofsX
|
|
dc h'00'
|
|
bkbitflg equ *-ofsX used to set or clear backup bit
|
|
dc h'00'
|
|
duplflag equ *-ofsX
|
|
dc h'00'
|
|
vcbentry equ *-ofsX
|
|
dc h'00'
|
|
|
|
* xdos temporary variables
|
|
|
|
namcnt equ *-ofsX
|
|
dc h'00'
|
|
rnptr equ *-ofsX
|
|
dc h'00'
|
|
namptr equ *-ofsX
|
|
dc h'00'
|
|
vnptr equ *-ofsX
|
|
dc h'00'
|
|
prfxflg equ *-ofsX
|
|
dc h'00'
|
|
cferr equ *-ofsX
|
|
dc h'00'
|
|
|
|
* deallocation temporary variables
|
|
|
|
firstbl equ *-ofsX
|
|
dc h'00'
|
|
firstbh equ *-ofsX
|
|
dc h'00'
|
|
stortyp equ *-ofsX
|
|
dc h'00'
|
|
deblock equ *-ofsX
|
|
dc h'0000'
|
|
dtree equ *-ofsX
|
|
dc h'00'
|
|
dsap equ *-ofsX
|
|
dc h'00'
|
|
dseed equ *-ofsX
|
|
dc h'0000'
|
|
topdest equ *-ofsX
|
|
dc h'00'
|
|
dtmpx equ *-ofsX
|
|
dc h'00'
|
|
loklst equ *-ofsX look list of recognized device numbers
|
|
dealbufl equ *-ofsX
|
|
dc h'0000000000000000'
|
|
dealbufh equ *-ofsX
|
|
dc h'0000000000000000'
|
|
cbytes equ *-ofsX
|
|
dc h'0000'
|
|
dc h'00' cbytes+2 must = 0
|
|
bufaddrl equ *-ofsX
|
|
dc h'00'
|
|
bufaddrh equ *-ofsX
|
|
dc h'00'
|
|
goadr equ *-ofsX
|
|
dc h'0000'
|
|
delflag equ *-ofsX used by 'detree' to know if called
|
|
dc h'00' from delete (destroy).
|
|
|
|
* zero fill to page boundary - 3 ($FEFD). so that cortland flag stays
|
|
* within page boundary.
|
|
|
|
dc h'00000000000000'
|
|
dc h'0000000000'
|
|
|
|
dc i2'calldisp'
|
|
cortflag equ *-ofsX cortland flag. 1 = Cortland system
|
|
dc h'00' (must stay within page boundary)
|
|
|
|
* end of obj mli_2
|
|
|
|
* 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
|
|
|
|
ofsR0 equ ramsrc-ramdest offset to /RAM driver org
|
|
|
|
ramsrc lda rd80col read 80 store
|
|
pha save for later
|
|
sta store80off 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 equ *-ofsR0
|
|
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 altram turn on main $D000
|
|
sta altram
|
|
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 setstdzp use main zero page/stack
|
|
L51A2 stx R2L
|
|
pla restore R2
|
|
sta R2H
|
|
plp get direction.
|
|
L51AA bcs L51B5 write, done with move.
|
|
sta ramin switch in MLI part of LC
|
|
sta ramin
|
|
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 equ *-ofsR0 set up R1 = dbuf
|
|
lda #>dbuf
|
|
blockdo1 equ *-ofsR0
|
|
sta R01
|
|
blockdo equ *-ofsR0
|
|
jsr setptr set pointers.
|
|
bcs L51DB it's a write.
|
|
sta wrmainram 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 wrcardram back the way it was.
|
|
donewrt equ *-ofsR0 mainwrt returns here
|
|
rts
|
|
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 equ *-ofsR0
|
|
lda tcmd is it read or write ?
|
|
lsr a
|
|
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 equ *-ofsR0
|
|
lda #>dbuf dbuf is temp buffer.
|
|
clrbuf1 equ *-ofsR0
|
|
sta R01 assign to block.
|
|
clrbuf2 equ *-ofsR0
|
|
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 equ *-ofsR0
|
|
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
|
|
dc h'00' 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 L5285 multiply by 2.
|
|
L5273 inx iteration + 1.
|
|
txa page = 2 * (16 + 8x)
|
|
asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
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 equ *-ofsR0
|
|
L5285 asl a 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 equ *-ofsR0
|
|
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 equ *-ofsR0
|
|
dc h'00' not formatted yet
|
|
tcmd equ *-ofsR0
|
|
dc h'00' command
|
|
dc h'00' unit (not used)
|
|
R2L equ *-ofsR0
|
|
dc h'00' R2 = user buffer
|
|
R2H equ *-ofsR0
|
|
dc h'00'
|
|
R01 equ *-ofsR0
|
|
dc h'00' page requested
|
|
BITMAP equ *-ofsR0
|
|
dc h'00FFFFFF' blocks 0-7 used
|
|
dc h'FFFFFFFF'
|
|
dc h'FFFFFFFF'
|
|
dc h'FFFFFFFE'
|
|
VDIR equ *-ofsR0 start of vdir.
|
|
dc h'F3' storage type = F, name length = 3
|
|
msb off
|
|
dc c'RAM'
|
|
access equ *-ofsR0
|
|
dc h'C3' destroy, rename, read enabled
|
|
dc h'27' entry length
|
|
dc h'0D'
|
|
dc h'0000'
|
|
dc h'0300' block 3
|
|
dc h'7F' 128 blocks
|
|
|
|
exitcard equ *-ofsR0
|
|
lda ramin restore language card
|
|
lda ramin
|
|
pla get 80store
|
|
bpl L52EA 80store wasn't on
|
|
sta store80on enable 80store
|
|
L52EA jmp bypass jump around passit
|
|
passit equ *-ofsR0
|
|
dc h'0000'
|
|
bypass equ *-ofsR0
|
|
lda #<noerr set up return to noerr
|
|
sta passit
|
|
lda #>noerr
|
|
ex1 equ *-ofsR0
|
|
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 !!
|
|
|
|
dc h'0000' $3FE-$3FF
|
|
|
|
* end of obj ram_0
|
|
|
|
* disk ii driver. object code = xrw_0
|
|
|
|
* critical timing requires page bound considerations for code and data.
|
|
* virtually the entire 'write' routine must not cross page boundaries.
|
|
* critical branches in the 'write', 'read', and 'read adr' subroutines
|
|
* which must not cross page boundaries are noted in comments.
|
|
* the cld at blockio must be present to determine bank of $D000
|
|
* $5300-5A00 moved to language card bank 1 at $D000
|
|
|
|
ofsD equ blockio-rwts offset to disk ii driver org
|
|
|
|
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 a
|
|
rol ibtrk
|
|
dey
|
|
bne L5310
|
|
asl a
|
|
bcc L531C
|
|
ora #$10 adjust for upper 4 bits of track
|
|
L531C lsr a
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
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 #$27 i/o error
|
|
sec
|
|
rts
|
|
|
|
* read/write a track/sector
|
|
|
|
regrwts equ *-ofsD
|
|
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 a 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 a 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 a
|
|
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 a
|
|
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 a the carry will tell.
|
|
bcc L53F4 branch if write
|
|
jsr read16
|
|
bcs L53A4 if bad read
|
|
L53E7 lda #$00
|
|
dc h'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 equ *-ofsD
|
|
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 a write protect-->carry-->bit 0=1
|
|
lda q6l,x keep in read mode
|
|
jmp statdne
|
|
myseek equ *-ofsD
|
|
asl a 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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
sta trkn save target track.
|
|
cmp curtrk on desired track ?
|
|
beq L5487 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 equ *-ofsD
|
|
L5487 lda curtrk get current track
|
|
clrphase equ *-ofsD
|
|
and #$03 mask for 1 of 4 phases
|
|
rol a 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 equ *-ofsD aligned to page boundary minus $96
|
|
dc h'0004FFFF080CFF10'
|
|
dc h'1418'
|
|
twobit3 equ *-ofsD used in fast prenib as lookup for
|
|
dc h'008040C0FFFF' 2-bit quantities.
|
|
dc h'1C20FFFFFF24282C'
|
|
dc h'3034FFFF383C4044'
|
|
dc h'484CFF5054585C60'
|
|
dc h'6468'
|
|
twobit2 equ *-ofsD used in fast prenib.
|
|
dc h'00201030'
|
|
endmrks equ *-ofsD table using 'unused' nibbles:
|
|
dc h'DEAAEBFF' ($C4,$C5,$C6,$C7)
|
|
dc h'FFFFFF6CFF70'
|
|
dc h'7478FFFFFF7CFFFF'
|
|
dc h'8084FF888C909498'
|
|
dc h'9CA0'
|
|
twobit1 equ *-ofsD used in fast prenib.
|
|
dc h'0008040CFFA4'
|
|
dc h'A8ACFFB0B4B8BCC0'
|
|
dc h'C4C8FFFFCCD0D4D8'
|
|
dc h'DCE0FFE4E8ECF0F4'
|
|
dc h'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 equ *-ofsD
|
|
dc h'00'
|
|
dnibl3 equ *-ofsD
|
|
dc h'00'
|
|
dnibl4 equ *-ofsD
|
|
dc h'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 equ *-ofsD
|
|
dc h'960200'
|
|
dc h'00970100009A0300'
|
|
dc h'009B0002009D0202'
|
|
dc h'009E0102009F0302'
|
|
dc h'00A6000100A70201'
|
|
dc h'00AB010100AC0301'
|
|
dc h'00AD000300AE0203'
|
|
dc h'00AF010300B20303'
|
|
dc h'00B3000002B40200'
|
|
dc h'02B5010002B60300'
|
|
dc h'02B7000202B90202'
|
|
dc h'02BA010202BB0302'
|
|
dc h'02BC000102BD0201'
|
|
dc h'02BE010102BF0301'
|
|
dc h'02CB000302CD0203'
|
|
dc h'02CE010302CF0303'
|
|
dc h'02D3000001D60200'
|
|
dc h'01D7010001D90300'
|
|
dc h'01DA000201DB0202'
|
|
dc h'01DC010201DD0302'
|
|
dc h'01DE000101DF0201'
|
|
dc h'01E5010101E60301'
|
|
dc h'01E7000301E90203'
|
|
dc h'01EA010301EB0303'
|
|
dc h'01EC000003ED0200'
|
|
dc h'03EE010003EF0300'
|
|
dc h'03F2000203F30202'
|
|
dc h'03F4010203F50302'
|
|
dc h'03F6000103F70201'
|
|
dc h'03F9010103FA0301'
|
|
dc h'03FB000303FC0203'
|
|
dc h'03FD010303FE0303'
|
|
dc h'03FF'
|
|
|
|
* nibl buffer 'nbuf2' must be on a page boundary !!!
|
|
|
|
nbuf2 equ *-ofsD nibl buffer for read/write of low
|
|
ds 86 2-bits of each byte.
|
|
ibtrk equ *-ofsD
|
|
dc h'00'
|
|
ibsect equ *-ofsD
|
|
dc h'00'
|
|
ibstat equ *-ofsD
|
|
dc h'00'
|
|
iobpdn equ *-ofsD
|
|
dc h'00'
|
|
curtrk equ *-ofsD
|
|
dc h'00'
|
|
dc h'00000000000000' for slots 1 thru 7
|
|
dc h'00000000000000' drives 1 & 2
|
|
retrycnt equ *-ofsD
|
|
dc h'00'
|
|
seekcnt equ *-ofsD
|
|
dc h'00'
|
|
trkcnt equ *-ofsD halftracks moved count.
|
|
countn equ *-ofsD 'must find' count.
|
|
last equ *-ofsD 'odd bit' nibls.
|
|
dc h'00'
|
|
csum equ *-ofsD used for address header cksum
|
|
dc h'00'
|
|
csstv equ *-ofsD
|
|
dc h'00'
|
|
sect equ *-ofsD
|
|
dc h'00'
|
|
track equ *-ofsD
|
|
montimel equ *-ofsD
|
|
dc h'00'
|
|
montimeh equ *-ofsD also 'volume'
|
|
dc h'00'
|
|
prior equ *-ofsD
|
|
dc h'00'
|
|
trkn equ *-ofsD
|
|
dc h'00'
|
|
|
|
* phase on, off time tables
|
|
* in 100 usec intervals (seek)
|
|
|
|
ontable equ *-ofsD
|
|
dc h'013028'
|
|
dc h'24201E1D1C1C'
|
|
offtable equ *-ofsD
|
|
dc h'702C'
|
|
dc h'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 equ *-ofsD
|
|
L5685 ldx #$11 delay 86 usec
|
|
L5687 dex
|
|
bne L5687
|
|
inc montimel
|
|
bne L5692
|
|
inc montimeh
|
|
L5692 sec
|
|
sbc #$01
|
|
bne L5685
|
|
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 equ *-ofsD
|
|
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 a 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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
L5759 ldx q6l+$60 warning: self modified
|
|
bpl L5759
|
|
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 L5772 always taken.
|
|
L576D sec error
|
|
rts
|
|
ref1 equ *-ofsD
|
|
L576F sta $1000,y warning: self modified
|
|
rd5 equ *-ofsD
|
|
L5772 ldx q6l+$60 warning: self modified
|
|
bpl L5772
|
|
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 L576F 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 equ *-ofsD
|
|
L5788 ldx q6l+$60 warning: self modified
|
|
bpl L5788
|
|
eor dnibl-$96,x
|
|
ldx nbuf2-$AA,y
|
|
eor dnibl3,x
|
|
ref2 equ *-ofsD
|
|
sta $1000,y warning: self modified
|
|
iny
|
|
bne L5788 loop unil this group of $56 read
|
|
rd7 equ *-ofsD
|
|
L579C ldx q6l+$60 warning: self modified
|
|
bpl L579C
|
|
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 equ *-ofsD
|
|
sta $1000,y warning: self modified
|
|
rd8 equ *-ofsD
|
|
L57B1 ldx q6l+$60 warning: self modified
|
|
bpl L57B1
|
|
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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
ldx A2L
|
|
chkdrv0 equ *-ofsD
|
|
ldy #$00 init loop counter.
|
|
L57DE lda q6l,x read the shift register.
|
|
jsr ckdrts delay
|
|
pha
|
|
pla more delay.
|
|
cmp q6l,x has shift reg changed ?
|
|
bne L57F0 yes, motor is moving.
|
|
lda #$28 anticipate error.
|
|
dey no, dec retry counter
|
|
bne L57DE and try 256 times.
|
|
ckdrts equ *-ofsD
|
|
L57F0 rts
|
|
drvindx equ *-ofsD
|
|
pha preserve acc across call
|
|
lda A4L+1
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
cmp #$08
|
|
and #$07
|
|
rol a
|
|
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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
ldy #$00 (2) warning: load value modified by prenib.
|
|
wrefa1 equ *-ofsD
|
|
L5853 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 equ *-ofsD
|
|
ldx #$60 (2) warning: value modified by prenib.
|
|
sta q6h,x (5) write nibl
|
|
lda q6l,x (4) handshake
|
|
wrefa2 equ *-ofsD
|
|
lda $1000,y (4) prior nibl. warning: address modified by prenib.
|
|
iny (2) all done with this page ?
|
|
bne L5853 (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 a (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 equ *-ofsD
|
|
L5881 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 equ *-ofsD
|
|
ldx #$60 (2) restore slot index. warning: modified by prenib
|
|
sta q6h,x (5)
|
|
lda q6l,x (4)
|
|
wrefa4 equ *-ofsD
|
|
lda $1100,y (4) warning: modified by prenib
|
|
iny (2) got prior nibl, point to next
|
|
wrefa5 equ *-ofsD
|
|
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 equ *-ofsD
|
|
ldx #$60 (2) restore slot. warning: modified by prenib
|
|
sta q6h,x (5)
|
|
lda q6l,x (4)
|
|
wrefa6 equ *-ofsD
|
|
lda $1100,y (4) get prior nibl. warning: modified by prenib
|
|
iny (2)
|
|
bcc L5881 (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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
lda q7l,x out of write mode
|
|
lda q6l,x to read mode.
|
|
rts return from write.
|
|
|
|
* 7-bit nibl write subroutines
|
|
|
|
wnibl9 equ *-ofsD
|
|
clc (2) 9 cycles, then write.
|
|
wnibl7 equ *-ofsD
|
|
pha (3) 7 cycles, then write.
|
|
pla (4)
|
|
wnibl equ *-ofsD
|
|
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 equ *-ofsD
|
|
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 equ *-ofsD get byte from lowest group.
|
|
L591A lda $1000,y warning: self modified.
|
|
and #$03 strip high 6 bits.
|
|
tax index to 2 bit equivalent.
|
|
lda twobit1,x
|
|
pha save pattern
|
|
prn2 equ *-ofsD get byte from middle group.
|
|
lda $1056,y warning: self modified.
|
|
and #$03
|
|
tax
|
|
pla restore pattern.
|
|
ora twobit2,x combine 2nd group with 1st.
|
|
pha save new pattern.
|
|
prn3 equ *-ofsD get byte from highest group.
|
|
lda $10AC,y warning: self modified.
|
|
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 L591A 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 a 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 equ *-ofsD
|
|
eor iobpdn same slot as last ?
|
|
asl a
|
|
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 equ *-ofsD
|
|
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 equ *-ofsD
|
|
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
|
|
|
|
dc h'0000' pad bytes to $D6EC (pathbuf-$14)
|
|
|
|
* variables used by mli for smartport interface
|
|
|
|
spstatlist equ *-ofsD ref pathbuf-$14
|
|
dc h'00000000' smartport status list buffer
|
|
spunit equ *-ofsD ref pathbuf-$10
|
|
dc h'0000000000000000' smartport unit numbers
|
|
dc h'0000000000000000'
|
|
|
|
* pathname buffer starts at this page boundary (pathbuf = $D700)
|
|
|
|
* 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.
|
|
|
|
ofsS equ disp1obj-dispadr offset to dispatcher org
|
|
|
|
disp1obj lda romin read ROM
|
|
sta clr80vid disable 80 col hardware
|
|
sta clraltchar normal LC, flashing UC
|
|
sta store80off 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 prodos8 get prefix
|
|
dc i1'$C7'
|
|
dc i2'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 equ *-ofsS
|
|
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 prodos8 call mli to set prefix.
|
|
dc i1'$C6'
|
|
dc i2'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 equ *-ofsS
|
|
lda #$03 line 3
|
|
sta cv
|
|
jsr crout
|
|
ldx #$00
|
|
loop1 equ *-ofsS
|
|
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 prodos8 get file info for pathname in pbuf
|
|
dc i1'$C4'
|
|
dc i2'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 prodos8 close all open files
|
|
dc i1'$CC'
|
|
dc i2'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 prodos8 open the file
|
|
dc i1'$C8'
|
|
dc i2'dsp1open'
|
|
bcc L5B82
|
|
jmp dsp1error
|
|
L5B82 lda dsp1refn copy the reference number
|
|
sta dsp1rdn
|
|
sta dsp1eofn
|
|
jsr prodos8 get eof
|
|
dc i1'$D1'
|
|
dc i2'dsp1eof'
|
|
bcs L5BE2
|
|
lda dsp1eofb+2 3rd of 3 bytes.
|
|
beq L5B9C if 0 then ok
|
|
lda #$27 else i/o error because
|
|
bne L5BE2 file is too large.
|
|
L5B9C lda dsp1eofb move eof to # of bytes to read.
|
|
sta dsp1cnt
|
|
lda dsp1eofb+1
|
|
sta dsp1cnt+1
|
|
jsr prodos8 read the file
|
|
dc i1'$CA'
|
|
dc i2'dsp1read'
|
|
php save the status.
|
|
jsr prodos8 close the file.
|
|
dc i1'$CC'
|
|
dc i2'dsp1cls'
|
|
bcc L5BBB
|
|
L5BB7 plp get status (it is irrelevant now)
|
|
bne L5BE2 if close generated an error
|
|
plp here if close was ok.
|
|
L5BBB bcs L5BB7 error.
|
|
jmp sysentry execute system file
|
|
delchar equ *-ofsS
|
|
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 equ *-ofsS
|
|
L5BD6 lda dsp1msgs,x
|
|
beq L5BE1
|
|
jsr cout
|
|
inx
|
|
bne L5BD6
|
|
L5BE1 rts
|
|
|
|
* dispatcher 1 error handler
|
|
|
|
dsp1error equ *-ofsS
|
|
L5BE2 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
|
|
msb on
|
|
dsp1msgs equ *-ofsS
|
|
dsp1msg0 equ *-ofsS
|
|
dc c'ENTER PREFIX (PRESS "RETURN" TO ACCEPT)'
|
|
dc h'00'
|
|
disp1msg equ *-ofsS
|
|
dc c'ENTER PATHNAME OF NEXT APPLICATION'
|
|
dc h'00'
|
|
dsp1err1 equ *-ofsS
|
|
dc h'87'
|
|
dc c'NOT A TYPE "SYS" FILE'
|
|
dc h'00'
|
|
dsp1err2 equ *-ofsS
|
|
dc h'87'
|
|
dc c'I/O ERROR '
|
|
dc h'00'
|
|
dsp1err3 equ *-ofsS
|
|
dc h'87'
|
|
dc c'FILE/PATH NOT FOUND '
|
|
dc h'00'
|
|
dsp1info equ *-ofsS get file info parms
|
|
dc h'0A' 10 parameters
|
|
dc i2'pbuf' pathname buffer
|
|
dsp1acess equ *-ofsS
|
|
dc h'00' access
|
|
dsp1type equ *-ofsS
|
|
dc h'00' file type
|
|
ds 13 the rest are unimportant
|
|
dsp1open equ *-ofsS open file parms
|
|
dc h'03' 3 parameters for open
|
|
dc i2'pbuf' pathname buffer
|
|
dc i2'fbuf' fcb buffer
|
|
dsp1refn equ *-ofsS
|
|
dc h'00' reference #
|
|
dsp1cls equ *-ofsS close file parms
|
|
dc h'01' 1 parameter for close
|
|
dsp1cln equ *-ofsS
|
|
dc h'00' reference #
|
|
dsp1read equ *-ofsS
|
|
dc h'04' 4 parameters for read
|
|
dsp1rdn equ *-ofsS
|
|
dc h'00' reference #
|
|
dc i2'sysentry' .SYS load address
|
|
dsp1cnt equ *-ofsS
|
|
dc h'0000' byte count
|
|
dc h'0000'
|
|
dsp1eof equ *-ofsS get eof parms
|
|
dc h'02' 2 parameters
|
|
dsp1eofn equ *-ofsS
|
|
dc h'00' reference #
|
|
dsp1eofb equ *-ofsS
|
|
dc h'000000' 3 byte eof
|
|
dsp1pfx equ *-ofsS get/set prefix parms
|
|
dc h'01' 1 parameter
|
|
dc i2'pbuf' prefix buffer
|
|
|
|
disp1end equ *
|
|
ds $300-(disp1end-disp1obj) fill to page boundary
|
|
|
|
* end of obj sel_0
|
|
|
|
* object code = sel_1
|
|
* Bird's Better Bye at org = dispadr
|
|
|
|
ofsB equ birdbye-dispadr offset to Bird's Bye org
|
|
|
|
birdbye cld
|
|
lda romin read ROM
|
|
stz softev
|
|
lda #>dispadr set reset vector to 'dispadr'
|
|
sta softev+1
|
|
jsr setpwrc create power-up byte
|
|
lda #$A0
|
|
jsr init80 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 equ *-ofsB
|
|
L5D32 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 prodos8
|
|
dc i1'$C5' online call
|
|
dc i2'ol_parms'
|
|
bcs L5D32 error check.
|
|
stz dlevel haven't read root directory yet.
|
|
lda pbuf+1 load description byte.
|
|
and #$0F mask for name length.
|
|
beq L5D32 if 0, then try next unit.
|
|
adc #$02 add 2 to length.
|
|
tax name length in x.
|
|
vnam1 equ *-ofsB
|
|
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 prodos8
|
|
dc i1'$C8' open
|
|
dc i2'op_parms'
|
|
bcc L5D7F good open.
|
|
lda dlevel trying to open root directory ?
|
|
beq L5D32 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 prodos8 call mli
|
|
dc i1'$CE' set mark
|
|
dc i1'smparms' parameters address = $0060
|
|
dc h'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 prodos8 close directory file
|
|
dc i1'$CC'
|
|
dc i2'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 L5EB0 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 equ *-ofsB
|
|
L5EB0 lda kbd get keyboard input.
|
|
bpl L5EB0 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 L5EB0 no, try again else pop up a directory.
|
|
|
|
* pop a directory level
|
|
|
|
jsr popdir
|
|
dec dlevel
|
|
bra L5EF1
|
|
popdir equ *-ofsB
|
|
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 prodos8 set prefix
|
|
dc i1'$C6'
|
|
dc i2'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 prodos8 open file
|
|
dc i1'$C8'
|
|
dc i2'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 prodos8 close file. ignore any error from close
|
|
dc i1'$CC'
|
|
dc i2'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 equ *-ofsB
|
|
sta ch
|
|
msgout equ *-ofsB
|
|
L5F4C lda dsp2msg,y
|
|
beq L5F57
|
|
jsr cout
|
|
iny
|
|
bne L5F4C
|
|
L5F57 rts
|
|
|
|
* name pointer calculator for name storage area
|
|
|
|
namecalc equ *-ofsB
|
|
stz fnstore+1 init high byte of 16-bit shift
|
|
txa
|
|
asl a shift to high nibble
|
|
rol fnstore+1
|
|
asl a
|
|
rol fnstore+1
|
|
asl a
|
|
rol fnstore+1
|
|
asl a
|
|
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 equ *-ofsB
|
|
lda #$02
|
|
sta ch80col horizontal position = 2.
|
|
ldx valcnt filename number
|
|
txa
|
|
sec
|
|
sbc topname calculate line # to display name
|
|
inc a
|
|
inc a
|
|
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 save 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 equ *-ofsB output a space.
|
|
lda #$A0
|
|
bne L5FB1 branch always.
|
|
homecurs equ *-ofsB screen control - home cursor
|
|
lda #$99
|
|
output equ *-ofsB
|
|
ora #$80 set high bit.
|
|
L5FB1 jmp cout output to screen.
|
|
doread equ *-ofsB
|
|
jsr prodos8 mli read call
|
|
dc i1'$CA'
|
|
dc i2'rd_parms'
|
|
rts
|
|
|
|
* data area
|
|
|
|
dsp2msg equ *-ofsB
|
|
dc c'RETURN: Select | TAB: Chg Vol | '
|
|
dc c'ESC: Back'
|
|
dc i1'$00'
|
|
fldrmsg equ *-ofsB
|
|
dc h'0F' inverse control code
|
|
dc h'1B' enable mousetext
|
|
dc c'XY' folder characters
|
|
dc h'18' disable mousetext
|
|
dc h'0E' normal control code
|
|
dc h'00'
|
|
op_parms equ *-ofsB open parameters
|
|
dc h'03' 3 parms
|
|
dc i2'pbuf' pathname
|
|
dc i2'op_buf' file buffer
|
|
op_refn equ *-ofsB
|
|
dc h'00' reference number
|
|
cl_parms equ *-ofsB close parameters
|
|
dc h'01' 1 parm
|
|
dc h'00' reference number.
|
|
ol_parms equ *-ofsB online parameters
|
|
dc h'02' 2 parms
|
|
ol_unit equ *-ofsB
|
|
dc h'60' unit number, default = s6, d1
|
|
dc i2'pbuf+1' data buffer
|
|
pf_parms equ *-ofsB set prefix parameters
|
|
dc h'01' one parm
|
|
dc i2'pbuf' pathname
|
|
rd_parms equ *-ofsB read parameters
|
|
dc h'04' 4 parms
|
|
rd_refn equ *-ofsB
|
|
dc h'01' reference number
|
|
dc i2'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)
|
|
* dc h'0000' requested length
|
|
* dc h'0000' actual length
|
|
|
|
dhdr_len equ *-ofsB directory header length
|
|
dc h'00' (actually uses 2 bytes)
|
|
|
|
* end of obj sel_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.
|
|
|
|
ofsQ equ GQdisp-dispadr offset to GQuit dispatcher org
|
|
|
|
msb off
|
|
GQdisp lda ramin read/write LC bank 1
|
|
clc
|
|
xce 16 bit native mode.
|
|
jmp >P8QUIT go to GQuit.
|
|
dc h'0000000000' offset to paragraph boundary.
|
|
dc c'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.
|
|
|
|
SHORT M 8 bit accumulator
|
|
LONGI ON
|
|
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 prodos8 set prefix
|
|
dc i1'$C6'
|
|
dc i2'pfxparms'
|
|
bcc L602D if prefix ok.
|
|
jsr gqerror error handler.
|
|
bra L6020 try again
|
|
|
|
* load application at $2000
|
|
|
|
L602D xce native mode (carry clear)
|
|
LONG I 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 prodos8 open the application file
|
|
dc i1'$C8'
|
|
dc i2'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 prodos8 get eof
|
|
dc i1'$D1'
|
|
dc i2'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 prodos8 read
|
|
dc i1'$CA'
|
|
dc i2'readparm'
|
|
bcc L607E read ok
|
|
jsr gqerror
|
|
bra L6071
|
|
L607E jsr prodos8 close
|
|
dc i1'$CC'
|
|
dc i2'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 romin enable ROM
|
|
jmp sysentry execute the system application
|
|
gqerror equ *-ofsQ
|
|
clc
|
|
xce 16 bit native mode
|
|
LONG I,M
|
|
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
|
|
LONG I,M
|
|
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.
|
|
_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)
|
|
_TLTextMountVolume make the dialog box
|
|
pla retrieve button press (not used)
|
|
sec emulation mode
|
|
xce
|
|
jsr prodos8 quit back to GQuit
|
|
dc i1'$65'
|
|
dc i2'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 equ *-ofsQ
|
|
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 a 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'
|
|
_TLTextMountVolume
|
|
lda [$01] restore first 2 bytes of vilume name
|
|
xba back to their original positions
|
|
inc a 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 equ *-ofsQ
|
|
lda |1,x get the first slash
|
|
sta volbuf+1
|
|
ldy #$0002 initialize the length count.
|
|
LONGI OFF
|
|
LONGA OFF
|
|
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 equ *-ofsQ
|
|
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
|
|
LONG I,M
|
|
pha make room on stack for user id.
|
|
_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
|
|
_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)
|
|
_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 a 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)
|
|
SHORT M 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 LONG M 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
|
|
_MessageCenter go delete the message.
|
|
L6203 _DisposeHandle throw away message (handle is on stack)
|
|
L620A _MMShutDown shutdown the memory manager (userid is
|
|
sec on stack).
|
|
xce back to emulation mode.
|
|
LONGA OFF
|
|
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 prodos8 set the P8 prefix.
|
|
dc i1'$C6'
|
|
dc i2'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 equ *-ofsQ
|
|
clc native mode
|
|
xce
|
|
LONG I 16-bit regs, 8-bit acc.
|
|
ldx #sysentry+6 point to pathname buffer.
|
|
jsr copyvol copy volume name to pathname buffer.
|
|
L623C sec emulation mode.
|
|
xce
|
|
jsr prodos8 get info on the volume.
|
|
dc i1'$C4'
|
|
dc i2'gfiparms'
|
|
bcc L6252 branch if volume found,
|
|
clc (native mode)
|
|
xce
|
|
LONG I,M
|
|
jsr mountvol else ask user to mount the volume.
|
|
bcc L623C if <return> pressed, then try again.
|
|
sec emulation mode.
|
|
xce
|
|
sec disk not found.
|
|
L6252 rts
|
|
|
|
* Prodos 8 parameter lists
|
|
|
|
pfxparms equ *-ofsQ set prefix parms.
|
|
dc h'01' one parm.
|
|
dc i2'inbuf' address of prefix.
|
|
opnparms equ *-ofsQ open parms.
|
|
dc h'03' 3 parms.
|
|
dc i2'pbuf' pathname
|
|
dc i2'op_buf' i/o buffer
|
|
oprefnum equ *-ofsQ
|
|
dc h'00' reference #
|
|
eofparms equ *-ofsQ
|
|
dc h'02' 2 parms
|
|
eofrefn equ *-ofsQ
|
|
dc h'00' reference #
|
|
eofval equ *-ofsQ
|
|
dc h'000000' 3 byte eof value
|
|
readparm equ *-ofsQ
|
|
dc h'04' 4 parms
|
|
rdrefnum equ *-ofsQ
|
|
dc h'00' reference #
|
|
dc i2'sysentry' read into $2000 (bank 0).
|
|
rdcount equ *-ofsQ
|
|
dc h'0000' # of bytes to read.
|
|
dc h'0000' transfer count
|
|
closeprm equ *-ofsQ
|
|
dc h'01' 1 parm
|
|
closeref equ *-ofsQ
|
|
dc h'00' reference #
|
|
quitparms equ *-ofsQ
|
|
dc h'04' 4 parms.
|
|
dc h'00' quit back to launcher (GQuit)
|
|
dc h'0000'
|
|
dc h'00'
|
|
dc h'0000'
|
|
gfiparms equ *-ofsQ get file info parms.
|
|
dc h'0A' 10 parms
|
|
dc i2'volbuf' volume buffer
|
|
dc h'00' access
|
|
dc h'00' file type
|
|
dc h'0000' aux type
|
|
dc h'00' storage type
|
|
dc h'0000' blocks used
|
|
dc h'0000' modification date
|
|
dc h'0000' modification time
|
|
dc h'0000' creation date
|
|
dc h'0000' 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 equ *-ofsQ
|
|
dc h'1B'
|
|
dc c'Can''t run next application.'
|
|
quitstr2 equ *-ofsQ
|
|
dc h'14'
|
|
dc c'ProDOS Error = $'
|
|
errval equ *-ofsQ hex error code gets stored here
|
|
dc c' '
|
|
quitbtn2 equ *-ofsQ null string (no 2nd button)
|
|
dc h'00'
|
|
|
|
* messages for P8 mount volume. maximum length of message is 35 characters.
|
|
* the button labels must not be more than 16 characters.
|
|
|
|
mountmsg equ *-ofsQ
|
|
dc h'17'
|
|
dc c'Please insert the disk:'
|
|
button1 equ *-ofsQ
|
|
dc h'0D'
|
|
dc c'Accept: '
|
|
dc h'1B' mousetext on
|
|
dc h'0F' inverse on
|
|
dc h'4D' mousetext return
|
|
dc h'0E' normal on
|
|
dc h'18' mousetext off
|
|
button2 equ *-ofsQ
|
|
dc h'0B'
|
|
dc c'Cancel: Esc'
|
|
|
|
* end of obj sel_2 (must be < GQdisp+$300)
|
|
|
|
end
|