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

Disassembly of ProDOS8 v2.03

This commit is contained in:
markpmlim 2017-07-05 19:33:05 +08:00
parent 69161b54e1
commit ebd810d5c2
33 changed files with 10873 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

289
MLI.SRC/ALLOC.S Normal file
View File

@ -0,0 +1,289 @@
**************************************************
* Free a blk on disk
Dealloc STX bmCnt ;Save high order address of block to be freed
PHA ;Save it
LDX vcbPtr ; while the bitmap
LDA vcb+vcbTotBlks+1,X; disk address is checked
CMP bmCnt ; to see if it makes sense
PLA ;Restore
BCC DeAllocErr1 ;Branch if impossible
TAX
AND #$07 ;Get the bit to be OR-ed in
TAY
LDA WhichBit,Y ;(shifting takes 7 bytes, but is slower)
STA noFree ;Save bit pattern
TXA ;Get low block address again
LSR bmCnt
ROR ;Get pointer to byte in bitmap that
LSR bmCnt ; represents the block address
ROR
LSR bmCnt
ROR
STA bmPtr ;Save pointer
LSR bmCnt ;Now transfer bit which specifies which page of bitmap
ROL half
JSR FindBitMap ;Make absolutely sure we've got the right device
BCS DeAllocErr ;Return any errors
LDA bmaCurrMap ;What is the current map?
CMP bmCnt ;Is in-core bit map the one we want?
BEQ :1 ;Branch if in-core is correct
JSR UpdateBitMap ;Put current map away
BCS DeAllocErr ;Pass back any error
LDA bmCnt ;Get desired map number
LDX vcbPtr
STA vcb+vcbCurrBitMap,X
LDA bmaDev
JSR GetBitMap ;Read it into the buffer
BCS DeAllocErr
:1 LDY bmPtr ;Index to byte
LSR half
LDA noFree ;(get individual bit)
BCC bmBufHi ;Branch if on page one of bitmap
ORA bmBuf+$100,Y
STA bmBuf+$100,Y
BCS DeAloc3 ;Branch always taken
bmBufHi ORA bmBuf,Y
STA bmBuf,Y
DeAloc3 LDA #$80 ;mark bitmap as modified
TSB bmaStat
INC deBlock ;Bump count of blocks deallocated
BNE :11
INC deBlock+1
:11 CLC
DeAllocErr RTS
DeAllocErr1 LDA #damagedBitMap ;bit map block # impossible
SEC ;Say bit map disk address wrong
RTS ;(probably data masquerading as index block)
**************************************************
* Find a free disk block & allocate it
* Exit
* (Y,A)=disk addr
* (scrtch)=disk addr
Alloc1Blk JSR FindBitMap ;Get address of bit map in 'bmAdr'
BCS ErrAloc1 ;Branch if error encountered
SrchFree LDY #$00 ;Start search at beginning of bit map block
STY half ;Indicate which half (page) we're searching
GetBits1 LDA bmBuf,Y ;Free blocks are indicated by 'on' bits
BNE BitFound
INY
BNE GetBits1 ;Check all of 'em in first page
INC half ;Indicate search has progressed to page 2
INC basVal ;base value=base address/2048
:loop LDA bmBuf+$100,Y ;Search second half for free block
BNE BitFound
INY
BNE :loop
INC basVal ;Add 2048 offset for next page
JSR NxtBitMap ;Get next bitmap (if it exists) and update VCB
BCC SrchFree ;Branch if no error encountered
ErrAloc1 RTS ;Return error
* Calculate blk # represented by first set VBM bit
BitFound STY bmPtr ;Save index pointer to valid bit group
LDA basVal ;Set up for block address calculation
STA scrtch+1
TYA ;Get address of bit pattern
ASL ;Multiply this and basVal by 8
ROL scrtch+1
ASL
ROL scrtch+1
ASL
ROL scrtch+1
TAX ;Now X=low address within 7 of actual address
SEC
LDA half
BEQ Page1Alloc ;Branch if allocating from 1st half
LDA bmBuf+$100,Y ;Get pattern from second page
BCS adcAloc ;Branch always
Page1Alloc LDA bmBuf,Y ;Get bit pattern from first page
adcAloc ROL ;Find left most 'on' bit
BCS Bounce ;Branch if found
INX ;Adjust low address
BNE adcAloc ;Branch always
Bounce LSR ;Restore all but left most bit to original position
BCC Bounce ;Loop until mark (set above) moves into Carry
STX scrtch ;Save low address
LDX half ;Which half of bit map?
BNE Page2Alloc
STA bmBuf,Y
BEQ DirtyBitMap ;Branch always
Page2Alloc STA bmBuf+$100,Y ;Update bitmap to show allocated block in use
DirtyBitMap LDA #$80 ;Indicate map has been
TSB bmaStat ; modified by setting dirty bit
LDY vcbPtr ;Subtract 1 from total free
LDA vcb+vcbFreeBlks,Y; blocks in VCB to account for newly
SBC #$01 ; allocated block (carry is set from 'bounce')
STA vcb+vcbFreeBlks,Y
BCS Ret1Blk ;Branch if hi free count doesn't need adjustment
LDA vcb+vcbFreeBlks+1,Y;Adjust high count
DEC
STA vcb+vcbFreeBlks+1,Y
Ret1Blk CLC ;Indicate no error encountered
LDA scrtch ;Get address low in A-Reg
LDY scrtch+1 ; & high address in Y-Reg
RTS ;Return address of newly allocated block
*-------------------------------------------------
* Get next volume bit map block
NxtBitMap LDY vcbPtr ;Before bumping to next map,
LDA vcb+vcbTotBlks+1,Y; check to be sure there is
LSR ; indeed a next map!
LSR
LSR
LSR
CMP vcb+vcbCurrBitMap,Y;Are there more maps?
BEQ NoMorBM ;Branch if no more to look at
LDA vcb+vcbCurrBitMap,Y
INC ;Add 1 to current map
STA vcb+vcbCurrBitMap,Y
JSR UpdateBitMap
*-------------------------------------------------
* Read volume bit map block
FindBitMap LDY vcbPtr ;Get device number
LDA vcb+vcbDevice,Y
CMP bmaDev
BEQ FreshMap
JSR UpdateBitMap ;Save out other volumes' bitmap, and
BCS NoGo
LDY vcbPtr
LDA vcb+vcbDevice,Y
STA bmaDev ; read in fresh bitmap for this device
FreshMap LDY bmaStat ;Is this one already modified?
BMI BMFound ;Yes, return pointer in 'bmAdr'
JSR GetBitMap ;Otherwise read in fresh bit map
BCS NoGo ;Branch if unsuccessful
BMFound LDY vcbPtr
LDA vcb+vcbCurrBitMap,Y;Get offset into VBM
ASL
STA basVal ;Save page offset into VBM
CLC ;Indicate all is valid and good!
NoGo RTS
NoMorBM LDA #volumeFull ;Indicate request can't be filled
SEC ;Indicate error
RTS
*-------------------------------------------------
* Check point vol bitMap for disk writing
UpdateBitMap CLC ;Anticipate nothing to do
LDA bmaStat ;Is current map dirty?
BPL NoGo ;No need to do anything
JSR WrtBitMap ;It is dirty, update device!
BCS NoGo ;Error encountered on writing
LDA #$00
STA bmaStat ;Mark bm buffer as free
RTS ;All done!
*-------------------------------------------------
* Prepare to read Vol BitMap block
GetBitMap STA bmaDev ;Read bitmap specified by dev & vcb
LDY vcbPtr ;Get lowest map number with free blocks in it
LDA vcb+vcbCurrBitMap,Y
STA bmaCurrMap ;Associate the offset with the bitmap control block
CLC ;Add this number to the base
ADC vcb+vcbBitMap,Y ; address of first bit map
STA bmaDskAdr ;Save low address of bit map to be used
LDA vcb+vcbBitMap+1,Y;Now get high disk address of map
ADC #$00 ;Add to this the state of the carry
STA bmaDskAdr+1 ;Save high disk address too
LDA #rdCmd
* Read/write Volume BitMap block
DoBMap STA dhpCmd ;Save device command
LDA DevNum ;Preserve current devnum.
PHA
LDA bmaDev ;Get bitmap's device number
STA DevNum
LDA bmaDskAdr ; & map's disk address
STA blockNum
LDA bmaDskAdr+1
STA blockNum+1
LDA bmBufHi+2
JSR DoBitMap ;(note: low address is fixed to zero as this is a buffer)
TAX ;Preserve error code, if any
PLA ;Restore the
STA DevNum ; dev # we came in with!
BCC :Ret ;Return devnum if no error
TXA ;Return any errors
:Ret RTS
*-------------------------------------------------
* Read blk # in A,X regs
RdBlkAX STA blockNum
STX blockNum+1
JSR RdGBuf
RTS
*-------------------------------------------------
* Write Vol BitMap block
WrtBitMap LDA #wrtCmd ;write bit map
BNE DoBMap ;Branch always
* Write primary buffer blk
WrtGBuf LDA #wrtCmd ;Set call for write
BNE SavGCmd ;Branch always
* Read primary buffer blk
RdGBuf LDA #rdCmd ;Set call for read
* Read/Write primary buffer blk
SavGCmd STA dhpCmd ;Passed to device handler
LDA #>genBuf ;Get high address of general buffer
*-------------------------------------------------
* Read/Write block
DoBitMap PHP ;No interupts allowed
SEI
STA bufPtr+1 ;General purpose buffers always
STZ bufPtr ; start on a page boundary
STZ SErr ;Clear global error value
LDA #$FF ;Also, set to indicate
STA ioAccess ; reg call made to dev handler
LDA DevNum ;transfer the device number for
STA unitNum ; dispatcher to convert to unit number.
JSR DMgr ;Call the driver
BCS :1 ;Branch if error
PLP ;Restore interupts
CLC
RTS
:1 PLP ;Restore interupts
SEC
RTS

402
MLI.SRC/BFMGR.S Normal file
View File

@ -0,0 +1,402 @@
TTL 'ProDOS Block File Manager'
**************************************************
* ProDOS block file manager
* Perform filing or housekeeping functions
* (X)=call # ($00-$13)
BFMgr LDA Dispatch,X ;Translate into command address
ASL ;(bit 7 indicates a pathname to preprocess)
STA cmdTmp
AND #$3F ;(bit6 is refnum preprocess, 5 is for time, so strip em.)
TAX
LDA cmdTable,X ;Move address for indirect jump
STA goAdr
LDA cmdTable+1,X ;(high byte)
STA goAdr+1
LDA #backupNeeded ;Init "backup bit flag"
STA bkBitFlg ; to say "file modified"
BCC NoPath
* For MLI calls $C0-$C4, $C8
JSR SetPath ;Go process pathname before calling command
BCS ErrorSys ;Branch if bad name
NoPath ASL cmdTmp ;Test for refnum preprocessing
BCC NoPreRef
* For MLI calls $C9-$CB, $CE-$D3
JSR FindFCB ;Go set up pointers to fcb and vcb of this file
BCS ErrorSys ;branch if any errors are encountered
NoPreRef ASL cmdTmp ;Lastly check for necessity of time stamp
BCC Execute
* For MLI calls $C0-$C4, $CC, $CD
JSR DateTime ;(No error posible)
Execute JSR GoCmd ;Execute command
BCC GoodOp ;Branch if successful
ErrorSys JSR SysErr ;Don't come back
GoodOp RTS ;Good return
*-------------------------------------------------
* Check caller's pathname & copy to pathname buffer
SetPath LDY #c_path
LDA (parm),Y ;Get low pointer addr
STA tPath
INY
LDA (parm),Y
STA tPath+1 ; & hi pointer addr
SynPath EQU * ;Entry used by rename for second pathname
LDX #$00 ;X-reg is used as index to pathBuf
LDY #$00 ;Y-reg is index to input pathname
STX prfxFlg ;Assume prefix is in use
STX pathBuf ;Mark pathbuf to indicate nothing processed
LDA (tPath),Y ;Validate pathname length>0, and <65
BEQ ErrSyn
CMP #65
BCS ErrSyn
STA pathCnt ;This is used to compare for
INC pathCnt ; end of pathname processing
INY ;Now check for full pathname...
LDA (tPath),Y ;(Full name if starts with "/")
ORA #$80
CMP #"/"
BNE NotFullPN ;Branch if prefix appended
STA prfxFlg ;Set prefix flag to indicate prefix not used
INY ;Index to first character of pathname
NotFullPN LDA #$FF ;Set current position of pathBuf
STA pathBuf,X ; to indicate end of pathname
STA namCnt ;Also indicate no characters processed in local name
STX namPtr ;Preserve pointer to local name length byte
SynPath3 CPY pathCnt ;done with pathname processing?
BCS EndPath ;Yes
LDA (tPath),Y ;Get character
AND #$7F ;We're not interested in high order bit
INX ;Prepare for next character
INY
CMP #'/' ;Is it a slash delimiter?
BEQ EndName ;Branch if it is
CMP #'a' ;Is it lower case character?
BCC NotLower ;Branch if not
AND #$5F ;Upshift to upper case
NotLower STA pathBuf,X ;Store charcter
INC namCnt ;Is it the first of a local name?
BNE NotFirst ;Branch if not
INC namCnt ;Kick count to 1
BNE TestAlfa ;First char. Must be alpha (branch always taken)
NotFirst CMP #'.' ;Is it "."?
BEQ SynPath3 ;It's ok if it is, do next char
CMP #'0' ;Is it at least "0"?
BCC ErrSyn ;Report syntax error if not
CMP #'9'+1 ;Is it numeric?
BCC SynPath3 ;ok if it is, do next character
TestAlfa CMP #'A' ;Is it at least an "a"?
BCC ErrSyn ;Report err if not
CMP #'Z'+1 ;Is it g.t. "z"?
BCC SynPath3 ;Get next char if valid alpha
ErrSyn SEC ;Make sure carry set
LDA #badPathSyntax
RTS ;Report error
EndPath LDA #$00 ;End pathname with 0
BIT namCnt ;Also make sure name count is positive
BPL :1
STA namCnt ;=0
DEX
:1 INX
STA pathBuf,X
BEQ ErrSyn ;Report error if "/" only
STX pathCnt ;Save true length of pathname
TAX ;X=0 causes end of process, after endname
EndName LDA namCnt ;Validate local name <16
CMP #15+1
BCS ErrSyn
PHX ;Save current pointer
LDX namPtr ;Get index to beginning of local name
STA pathBuf,X ;Save local name's length
PLX ;Restore x
BNE NotFullPN ;Branch if more names to process
CLC ;Indicate success!
LDA prfxFlg ; but make sure all pathnames are
BNE EndRTS ; prefixed or begin with a "/"
LDA NewPfxPtr ; must be non-zero
BEQ ErrSyn
EndRTS RTS
**************************************************
* SETPREFIX Call
SetPrefix JSR SetPath ;Call is made here so a 'null' path may be detected
BCC :1 ;Branch if pathname ok
LDY pathBuf ;Was it a nul pathname?
BNE PfxErr ;Branch if true syntax error
JSR ZeroPfxPtrs ;Indicate null prefix. NB. (Y)=0
CLC
RTS
:1 JSR FindFile ;Go find specified prefix directory
BCC :2 ;Branch if no error
CMP #badPathSyntax
BNE PfxErr ;Branch if error is real (not root dir)
:2 LDA d_file+d_stor ;Make sure last local name is DIR type
AND #directoryFile*16;(either root or sub)
EOR #directoryFile*16;Is it a directory?
BNE PfxTypErr ;Report wrong type
LDY prfxFlg ;New or appended prefix?
BNE :3 ;(A)=0 if branch taken
LDA NewPfxPtr ;Append new prefix to old
:3 TAY
SEC ;Find new beginning of prefix
SBC pathCnt
CMP #$C0 ;Too long? ($100-$40)
BCC ErrSyn ;Report it if so
TAX
JSR SetPfxPtrs
LDA d_dev ;Save device number
STA pathDev
LDA d_file+d_first ; & addr of first block
STA pathBlok
LDA d_file+d_first+1
STA pathBlok+1
MovPrefix LDA pathBuf,Y
STA pathBuf,X
INY
INX
BNE MovPrefix
CLC ;Indicate good prefix
RTS
PfxTypErr LDA #badStoreType ;Report not a directory
PfxErr SEC ;indicate error
RTS
**************************************************
* GETPREFIX Call
GetPrefix CLC ;Calculate how big a buffer is needed to
LDY #c_path ;Get index to user's pathname buffer
LDA (parm),Y
STA userBuf
INY
LDA (parm),Y
STA userBuf+1
STZ cBytes+1 ;Set buf length at max
LDA #64 ;(64 characters max)
STA cBytes
JSR ValDBuf ;Go validate prefix buffer addr
BCS PfxErr
LDY #$00 ;Y is indirect index to user buffer
LDA NewPfxPtr ;Get address of beginning of prefix
TAX
BEQ NullPrefix ;Branch if null prefix
EOR #$FF ;Get total length of prefix
ADC #$02 ;Add 2 for leading and trailing slashes
NullPrefix STA (userBuf),Y ;Store length in user's buffer
BEQ GotPrefix ;Branch if null prefix
SendPrefix INY ;Bump to next user buf loc
LDA pathBuf,X ;Get next char of prefix
SndLimit STA (userBuf),Y ;Give character to user
AND #$F0 ;Check for length descriptor
BNE :1 ;Branch if regular character
LDA #'/' ;Otherwise, substitute a slash
BNE SndLimit ;Branch always
:1 INX
BNE SendPrefix ;Branch if more to send
INY
LDA #'/' ;End with slash
STA (userBuf),Y
GotPrefix CLC ;Indicate no error
RTS
*-------------------------------------------------
* Validity check the ref # passed by caller
FindFCB LDY #c_refNum ;Index to reference number
LDA (parm),Y ;Is it a valid file number?
BEQ ErrRefNum ;Must not be 0!
CMP #8+1 ;Must be 1 to 8 only
BCS ErrRefNum ;User must be stoned...
PHA
DEC ;(subtracts 1)
LSR ;Shift low 3 bits to high bits
ROR
ROR
ROR ;Effective multiply by 32
STA fcbPtr ;Later used as an index
TAY ; to FCB like now
PLA ;Restore refnum in A-reg
CMP fcb+fcbRefNum,Y ;Is it an open reference?
BNE ErrNoRef ;Branch if not
FndFCBuf LDA fcb+fcbFileBuf,Y;Get page addr of file buffer
JSR GetBufAdr ;Get file's address into bufAddrL & H
LDX bufAddrH ;(Y)=fcbptr - preserved
BEQ FCBDead ;Report FCB screwed up!!!
STX dataPtr+1 ;Save pointer to data area of buffer
INX
INX ;Index block always 2 pages after data
STX tIndex+1
LDA fcb+fcbDevNum,Y ;Also set up device number
STA DevNum
LDA bufAddrL
STA dataPtr ;Index and data buffers
STA tIndex ; always on page boundaries
SrchVCBs TAX ;Search for associated VCB
LDA vcb+vcbDevice,X
CMP fcb+fcbDevNum,Y ;Is this VCB the same device?
BEQ TestVOpen ;If it is, make sure volume is active
NxtBufr TXA ;Adjust index to next VCB
CLC
ADC #vcbSize
BCC SrchVCBs ;Loop until volume found
LDA #vcbUnusable ;Report open file has no volume...
JSR SysDeath ; & kill the system
FCBDead LDA #fcbUnusable ;Report FCB trashed
JSR SysDeath ; & kill the system
TestVOpen LDA vcb,X ;Make sure this VCB is open
BEQ NxtBufr ;Branch if it is not active
STX vcbPtr ;Save pointer to good VCB
CLC ;Indicate all's well
RTS
ErrNoRef LDA #$00 ;Drop a zero into this FCB
STA fcb+fcbRefNum,Y ; to show free FCB
ErrRefNum LDA #invalidRefNum ;Tell user that requested refnum
SEC ; is illegal (out of range) for this call
RTS
**************************************************
* ONLINE call
Online JSR MovDBuf ;Move user specified buffer pointer to usrbuf
STZ cBytes ;Figure out how big buffer has to be
STZ cBytes+1
LDY #c_devNum
LDA (parm),Y ;If zero then cbytes=$100, else =$010 for one device
AND #$F0
STA DevNum
BEQ :1 ;Branch if all devices
LDA #$10
STA cBytes
BNE :2 ;Always
:1 INC cBytes+1 ;Allow for up to 16 devices
:2 JSR ValDBuf ;Go validate buffer range against allocated memory
BCS OnlinErr
LDA #$00 ;Zero out user buffer space
LDY cBytes
:loop1 DEY
STA (userBuf),Y ;Zero either 16 or 256 bytes
BNE :loop1 ;Branch if more to zero
STA namPtr ;Use namPtr as pointer to user buffer
LDA DevNum
BNE OnlineZ ;Branch if only 1 device to process
JSR MovDevNums ;Get list of currently recognized devices
:loop2 PHX ;Save index to last item on list
LDA lookList,X ;Get next device #
STA DevNum
JSR OnlineZ ;Log this volume and return it's name to user
LDA namPtr
CLC
ADC #$10
STA namPtr
PLX ;Restore index to device list
DEX ;Index to next device
BPL :loop2 ;Branch if there is another device
LDA #$00 ;No errors for muliple on-line
CLC ;Indicate good on all volumes
OnlinErr RTS
* Generate return data for a specific device
OnlineZ JSR ScanVCB ;See if it has already been logged in
BCS OnlinErr1 ;Branch if VCB is full
LDX #$00 ;Read in root (volume) directory
LDA #$02 ;(X,A)=block #
JSR RdBlkAX ;Read it into general purpose buffer
LDX vcbPtr ;Use x as an index to the vcb entry
* This fix is to remove VCB entries that correspond to devices that
* are no longer in the device list (i.e. removed by the user).
BCC VolFound ;Branch if the read was ok
TAY ;Save error value in Y-reg
LDA vcb+vcbStatus,X ;Don't take the VCB off line if
BNE RtrnErr ; there are active files present!
STA vcb,X ;Now take the volume off line
STA vcb+vcbDevice,X
RtrnErr TYA ;Now return error to A
BCS OnlinErr1
* 1st vol dir blk has been read successfully
VolFound LDA vcb,X ;Has it been logged in before?
BEQ :1 ;Branch if not
LDA vcb+vcbStatus,X ;It has, are there active files?
BMI :2 ;Branch if the volume is currently busy
:1 JSR LogVCBZ ;Go log it in
BCS OnlinErr1 ;Branch if there is some problem (like notsos)
LDA #dupVolume ;Anticipate a duplicate active volume exists
BIT duplFlag
BMI OnlinErr1 ;Branch if we guessed right
:2 LDX vcbPtr ;Restore vcbptr just in case we lost it
JSR CmpVCB ;Does read in volume compare with logged volume?
LDA #drvrDiskSwitch ;Anticipate wrong volume mounted in active device
BCC Online2 ;Branch if no problem!
* On fall thru, (A)=disk switch error
* Store error code in user's data buffer
OnlinErr1 PHA ;Save error code
JSR SavDevNbr ;Tell user what device we looked at
PLA ;Get error code again
INY ;Tell user what error was encountered on this device
STA (userBuf),Y
CMP #dupVolume ;Was it a duplicate volume error?
BNE :1 ;Branch if not,
INY ;Otherwise tell user which other device has same name
LDX vcbEntry
LDA vcb+vcbDevice,X
STA (userBuf),Y
STZ duplFlag ;Clear duplicate flag
LDA #dupVolume ;Restore error code
:1 SEC ;Indicate error
RTS
* Make online volume entry
Online2 LDA vcb,X ;Get volume name count
STA namCnt
LDY namPtr ;Index to user's buffer
:loop LDA vcb,X ;Move name to user's buffer
STA (userBuf),Y
INX
INY
DEC namCnt ;Loop until all characters moved
BPL :loop
SavDevNbr LDY namPtr ;Index to first byte of this entry
LDA DevNum ;Put device number in upper nibble of this byte
ORA (userBuf),Y ;Lower nibble is name length
STA (userBuf),Y
CLC ;Indicate no errors
RTS

137
MLI.SRC/CCLOCK.S Normal file
View File

@ -0,0 +1,137 @@
***********************************************************
*
* ProDOS 8 CORTLAND CLOCK DRIVER
*
* COPYRIGHT APPLE COMPUTER, INC., 1986
*
* ALL RIGHTS RESERVED
*
* Written by Kerry Laidlaw, 2/12/86
* Modified by Mike Askins, 9/6/86
* Modified by Fern Bachman, 9/7/86
*
***********************************************************
*
* This is the ProDOS8 Cortland built-in clock driver.
* Its sole function in life is to fetch the time from the Cortland
* clock via the Read Hex Time misc. tool call, and transfer this
* time into the ProDOS global page time format.
*
* This routine will IGNORE any errors passed back to it from the
* Read Hex Time call. This was done since existing ProDOS8 programs
* cannot deal with some new time error code.
* Thus the only way that a user can tell if his Cortland clock is
* broken, is by noticing that the date and time fields are zeroed.
*
* Note: There are some interesting facts to know regarding the
* slot clock driver for ProDOS8 and the built-in
* Cortland clock. The year value returned from the Cortland clock
* is an offset from the year 1900. Thus Cortland is capable of
* reporting the year correctly until 1900+255=2155. Only 7 bits
* are used for the year in the ProDOS8 global page, so theoretically
* 1900+127=2027 is the last year that ProDOS could represent on a
* Cortland. But this is only if the ProDOS8 year value is interpreted
* as being an offset from 1900.
*
* Historically, the year value has been interpreted as the binary
* representation of the last two digits of the year 19xx.
* So this means that programs that display the year as a concatenation
* of 19 and the ascii equivalent of the year value will work until 1999.
* And programs that just display the last two digits of the year will
* still work correctly until (20)27 if they convert the year value
* correctly, but ignore any hundredths place digit.
*
* Apple //e's that use slot clocks that utilize the slot clock
* driver have further restrictions of the year value. The slot
* clock driver calculates the year given the position of the day
* of the week in the month. This algorithm then uses a year look
* up table that has seven possible values. Leap years are repeated
* in the table. Since 1988 is a leap year, then the updated slot
* clock driver (file TCLOCK) will yield the six year offset values
* rather then seven.
* So before 1992, if ProDOS8 still exists, the slot clock driver
* routine must be updated again!
*
* So, we now have the following definition:
* The value placed in the year field is defined as the
* number of years past the year 1900.
* Numerically speaking: Current Year = 1900 + year value.
MX %11
ORG ClockBegin
* This mod will force read/write main memory for the tool
* call by resetting the read/write auxillary memory bits
* in the state register (statereg).
MX %11
IIgsClock EQU *
SEP #$30 ;Make sure we're in 8 bit mode
LDA STATEREG ;Get the state reg
STA SaveState ;Keep for restore after tool call
AND #%11001111 ;Clear the Read/Write aux memory bits
STA STATEREG ;Make it real
* First off, lets get into native mode with 16 bit m & x.
MX %00
CLC ;Set e = 0, to set native mode
XCE
REP #$30 ;Zero m & x for 16-bit mode
LDA #$0000 ;Zero out result space
PHA ; Push 4 words for hex time result...
PHA
PHA
PHA
_ReadTimeHex
* Note that no error condition is checked for, so the date will
* be zeroed by default if an error indeed happened.
*
* Back to 8 bit m to access results on stack...
MX %10
SEP #$20
LDA SaveState ;Restore the state register
STA STATEREG
* Now let's pull the time off the stack and stick it in the global page.
PLA ;Pull off Seconds, and ignore
PLA ;Pull off Minutes
STA TimeLo ;Store in global page
PLA ;Pull off Hours
STA TimeLo+1 ;Store in global page
PLA ;Pull off Year value
:loop1 CMP #100 ;Adjust for
BCC :1
SBC #100 ; year 2000
BRA :loop1
:1 STA DateLo+1 ; (year)
PLA ;Pull off Day
INC ;Increment day value for ProDOS8 format
STA DateLo ;Store in global page
PLA ;Pull off Month
INC ;Incr month value for ProDOS8 format
ASL ;Shift month as it sits in between
ASL ; the year and day values
ASL
ASL
ASL
ORA DateLo ;Put all but the top bit of month value
STA DateLo ; in the day byte
ROL DateLo+1 ;Put hi bit of mo. in lo bit of yr byte
PLA ;Pull off unused byte
PLA ;Pull off Day of Week. Stack now clean
SEC ;Now go back to emulation mode
XCE ; to continue with ProDOS8
RTS ;That's all
SaveState DB $00 ;Keep the state of state register
ASC 'JIMJAYKERRY&MIKE'
ClockEnd EQU *
DS 125-ClockEnd+ClockBegin,0; Zero rest of 125 bytes
Size EQU *-ClockBegin ;MUST be $7D (125) bytes in length!
DS $80-Size,0

399
MLI.SRC/CLOSEEOF.S Normal file
View File

@ -0,0 +1,399 @@
***********************************************************
* Close Call
Close LDY #c_refNum ;Close all?
LDA (parm),Y
BNE Close1 ;No, just one of 'em
STA clsFlshErr ;Clear global close error
LDA #$00 ;Begin at the beginning
ClsAll STA fcbPtr ;Save current low byte of pointer
TAY ;Fetch the level at which
LDA fcb+fcbLevel,Y ; file was opened
CMP Level ;Test against current global level
BCC NxtClose ;Don't close if files level is < global level
LDA fcb+fcbRefNum,Y ;Is this reference file open?
BEQ NxtClose ;No, try next
JSR FlushZ ;Clean it out...
BCS ClosErr ;Return flush errors
JSR CloseZ ;Update FCB & VCB
LDY #c_refNum
LDA (parm),Y
BEQ NxtClose ;No err if close all
BCS ClosErr
NxtClose LDA fcbPtr
CLC
ADC #fcbSize
BCC ClsAll ;Branch if within same page
LDA clsFlshErr ;On final close of close all report logged errors
BEQ ClosEnd ;Branch if errors
RTS ;Carry already set (see BCC)
Close1 JSR Flush1 ;Flush file first (including updating bit map)
BCS ClosErr ;Report errors immediately!!
CloseZ LDY fcbPtr
LDA fcb+fcbFileBuf,Y;Release file buffer
JSR ReleaseBuf
BCS ClosErr
LDA #$00
LDY fcbPtr
STA fcb+fcbRefNum,Y ;Free file control block too
LDA fcb+fcbDevNum,Y
STA DevNum
JSR ScanVCB ;Go look for associated VCB
LDX vcbPtr ;Get vcbptr
DEC vcb+vcbOpenCnt,X;Indicate one less file open
BNE ClosEnd ;Branch if that wasn't the last...
LDA vcb+vcbStatus,X
AND #$7F ;Strip 'files open' bit
STA vcb+vcbStatus,X
ClosEnd CLC
RTS
ClosErr BCS FlushErr ;Don't report close all err now
Flush LDY #c_refNum ;Flush all?
LDA (parm),Y
BNE Flush1 ;No, just one of 'em
STA clsFlshErr ;Clear global flush error
LDA #$00 ;Begin at the beginning
:loop STA fcbPtr ;Save current low byte of pointer
TAY ;Index to reference number
LDA fcb+fcbRefNum,Y ;Is this reference file open?
BEQ :1 ;No, try next
JSR FlushZ ;Clean it out..
BCS FlushErr ;Return any errors
:1 LDA fcbPtr ;Bump pointer to next file control block
CLC
ADC #fcbSize
BCC :loop ;Branch if within same page
FlushEnd CLC
LDA clsFlshErr ;On last flush of a flush(0)
BEQ :Ret ;Branch if no logged errors
SEC ;Report error now
:Ret RTS
FlushZ JSR FndFCBuf ;Must set up assoc vcb & buffer locations first
BCC Flush2a ;Branch if no error encountered
FlushErr JMP GlbErr ;Check for close or flush all
Flush1 STZ clsFlshErr ;Clear gbl flush error for normal refnum flush
JSR FindFCB ;set up pointer to fcb user references
BCS FlushErr ;return any errors
Flush2a EQU * ;Test to see if file is modified
LDA fcb+fcbAttr,Y ;First test write enabled
AND #writeEnable
BEQ FlushEnd ;Branch if 'read only'
LDA fcb+fcbDirty,Y ;See if eof has been modified
BMI :11 ;Branch if it has
JSR GetFCBStat ;now test for data modified
AND #useMod+eofMod+dataMod; was written to while it's been open?
BEQ FlushEnd ;Branch if file not modified
:11 JSR GetFCBStat ;Now test for data modified
AND #dataMod ;Does current data buffer need
BEQ :12 ; to be written? Branch if not
JSR WrFCBData ;If so, go write it stupid!
BCS FlushErr
:12 JSR GetFCBStat ;Check to see if the index block
AND #idxMod ; (tree files only) needs to be written
BEQ :13 ;Branch if not...
JSR WrFCBIdx
BCS FlushErr ;Return any errors
:13 LDA #fcbEntNum ;Now prepare to update directory
TAX
ORA fcbPtr ;(This should preserved Carry-bit)
TAY
OwnerMov LDA fcb,Y ;Note: this code depends on the
STA d_dev-1,X ; defined order of the file control
DEY ; block and the temporary directory
DEX ; area in 'workspc'! *************
BNE OwnerMov
STA DevNum
LDA d_head ;Read the directory header for this file
LDX d_head+1
JSR RdBlkAX ;Read it into the general purpose buffer
BCS FlushErr ;Branch if error
JSR MoveHeadZ ;Move header info
LDA d_entBlk ;Get address of directory block
LDY d_entBlk+1 ; that contains the file entry
CMP d_head ;Test to see if it's the same block that
BNE FlsHdrBlk ; the header is in. Branch if not
CPY d_head+1
BEQ Flush5 ;Branch if header block = entry block
FlsHdrBlk STA blockNum
STY blockNum+1
JSR RdGBuf ;Get block with file entry in general buffer
Flush5 JSR EntCalc ;Set up pointer to entry
JSR MovEntry ;Move entry to temp entry buffer in 'workspc'
LDY fcbPtr ;Update 'blocks used' count
LDA fcb+fcbBlksUsed,Y
STA d_file+d_usage
LDA fcb+fcbBlksUsed+1,Y
STA d_file+d_usage+1;hi byte too...
LDX #$00 ;and move in end of file mark
EOFupdate LDA fcb+fcbEOF,Y ; whether we need to or not
STA d_file+d_eof,X
INX ;Move all three bytes
CPX #$03
BEQ :21
LDA fcb+fcbFirst,Y ;Also move in the address of
STA d_file+d_first-1,X; the file's first block since
INY ; it might have changed since the file
BNE EOFupdate ; first opened. Branch always taken
:21 LDA fcb+fcbStorTyp-2,Y;the last thing to update
ASL ; is storage type (y=fcbPtr+2)
ASL ;(shift it into the hi nibble)
ASL
ASL
STA scrtch
LDA d_file+d_stor ;Get old type byte (it might be the same)
AND #$0F ;Strip off old type
ORA scrtch ;Add in the new type,
STA d_file+d_stor ; & put it away
JSR ReviseDir ;Go update directory!
BCS GlbErr
LDY fcbPtr ;Mark
LDA fcb+fcbDirty,Y ; FCB/directory
AND #$FF-fcbMod ; as not
STA fcb+fcbDirty,Y ; dirty
LDA d_dev ;See if bitmap should be written
CMP bmaDev ;Is it in same as current file?
BNE :22 ;Yes, put it on the disk if necessary
JSR UpdateBitMap ;Go put it away
BCS GlbErr
:22 CLC
RTS
GlbErr LDY #c_refNum ;Report error immediately
PHA ; only if not a close all or flush all
LDA (parm),Y
BNE :31 ;Not an 'all' so report now
CLC
PLA
STA clsFlshErr ;Save for later
RTS
:31 PLA
RTS
* Get status of FCB
GetFCBStat LDY fcbPtr ;Index to fcb
LDA fcb+fcbStatus,Y ;Return status byte
RTS ;That is all...
SetErr LDA #invalidAccess
SEC
EOFret RTS
***********************************************************
* SETEOF Call
SetEOF JSR GfcbStorTyp ;Only know how to move eof of tree, sapling, or seed
CMP #tree+1
BCS SetErr
ASL
ASL
ASL
ASL ;=$10,$20,$30
STA storType ;May be used later for trimming the tree...
LDA fcb+fcbAttr,Y ;Now check to insure write is enabled
AND #writeEnable ;Can we set new eof?
BEQ SetErr ;Nope, access error
JSR TestWrProt ;Find out if mod is posible (H/W write protect)
BCS SetErr
LDY fcbPtr ;Save old EOF
INY
INY
LDX #$02 ; so it can be seen
SetSave LDA fcb+fcbEOF,Y ; whether blocks need
STA oldEOF,X ; to be released
DEY ; upon
DEX ; contraction
BPL SetSave ;All three bytes of the eof
LDY #c_eof+2
LDX #$02
NewEOFPos LDA (parm),Y ;Position mark to new EOF
STA tPosll,X
DEY
DEX
BPL NewEOFPos
LDX #$02 ;Point to third byte
PurgeTest LDA oldEOF,X ;See if EOF moved backwards
CMP tPosll,X ; so blocks can
BCC EOFset ; be released (branch if not)
BNE Purge ;Branch if blocks to be released
DEX
BPL PurgeTest ;All three bytes
EOFset LDY #c_eof+2
LDX fcbPtr ;Place new end of file into FCB
INX
INX
:loop LDA (parm),Y
STA fcb+fcbEOF,X
DEX
DEY
CPY #c_eof ;All three bytes moved?
BCS :loop ;Branch if not...
JMP FCBUsed ;Mark fcb as dirty... all done
Purge JSR Flush1 ;Make sure file is current
BCS EOFret
LDX dataPtr+1 ;Restore pointer to index block
INX
INX ;(zero page conflict with dirPtr)
STX tIndex+1
LDX dataPtr
STX tIndex
LDY fcbPtr ;Find out if eof < mark
INY
INY
LDX #$02
NewEOFtest LDA fcb+fcbMark,Y
CMP tPosll,X ;Compare until not equal or carry clear
BCC SetEOF1 ;branch if eof>mark (mark is b4 new EOF)
BNE SetEOF0 ;branch if eof<mark
DEY
DEX
BPL NewEOFtest ;Loop on all three bytes
SetEOF0 LDY fcbPtr
LDX #$00
FakeEOF LDA tPosll,X ;Fake position, correct position
STA fcb+fcbMark,Y
INY ; will be made below...
INX ;Move all three bytes
CPX #$03
BNE FakeEOF
SetEOF1 JSR TakeFreeCnt ;Force proper free blk cnt before releasing blocks
LDA tPosll ;Now prepare for purge of excess blocks...
STA dSeed ;All blocks and bytes beyond new
LDA tPoslh ; EOF must be zeroed!
STA dSap
AND #$01
STA dSeed+1 ;(=0/1)
LDA tPosHi
LSR
STA dTree
ROR dSap ;Pass position in terms of block & bytes
LDA dSeed ;Now adjust for boundaries of $200
ORA dSeed+1 ;(block boundaries)
BNE SetEOF3 ;Branch if no adjustment necessary
LDA dSap ;Get correct block positions
SEC ; for sap & tree levels
SBC #$01
STA dSap ;Deallocate for last (phantom) block
LDA #$02 ; & don't modify last data block
BCS SetEOF2 ;branch if tree level unaffected
DEC dTree ;But if it is affected, make sure new eof # 0
BPL SetEOF2 ;Branch if new eof not zero
LDA #$00 ;Otherwise, just make a null seed out of it
STA dTree
STA dSap
SetEOF2 STA dSeed+1 ;(On fall thru, =0 else = 2)
SetEOF3 LDY fcbPtr ;Also must pass file's first block addr
LDA fcb+fcbFirst,Y ; which is its keyblk
STA firstBlkL
LDA fcb+fcbFirst+1,Y
STA firstBlkH
STZ deBlock ;Lastly, number of blocks to be
STZ deBlock+1 ; freed should be initialized
JSR DeTree ;Go defoliate...
PHP ;Save any error status until
PHA ; FCB is cleaned up!
SEC
LDY fcbPtr
LDX #$00
AdjFCB LDA firstBlkL,X
STA fcb+fcbFirst,Y ;Move in posible new first file block addr
LDA fcb+fcbBlksUsed,Y;Adjust usage count also
SBC deBlock,X
STA fcb+fcbBlksUsed,Y
INY
INX
TXA
AND #$01 ;Test for both bytes adjusted
BNE AdjFCB ; without disturbing carry
LDA storType ;get possibly modified storage type
LSR
LSR
LSR
LSR
LDY fcbPtr ;save it in fcb
STA fcb+fcbStorTyp,Y
JSR ClrStats ;Make it look as though position has
JSR DvcbRev ; nothing allocated, update total blocks in VCB
LDY fcbPtr ;Now correct position stuff
INY
INY
LDX #$02
CorrectPos LDA fcb+fcbMark,Y ;Tell RdPosn to go to correct
STA tPosll,X
EOR #$80 ; position from incorrect place
STA fcb+fcbMark,Y
DEY
DEX
BPL CorrectPos
JSR RdPosn ;Go do it!!!
BCC Purge1 ;Branch if no error
TAX ;Otherwise report latest error
PLA
PLP
TXA ;Restore latest error code to stack
SEC
PHP
PHA ;Save new error
Purge1 EQU * ;Mark file as in need of a flush and
JSR EOFset ; update FCB with new end of file
JSR Flush1 ;Now go do flush
BCC :1 ;Branch if no error
TAX ;Save latest error
PLA ;Clean previous error off stack
PLP
TXA ;Restore latest error code to stack
SEC ;Set the carry to show error condition
PHP ;Restore error status to stack
PHA ; & the error code
:1 PLA ;Report any errors that may have cropped up
PLP
RTS
GetEOF LDX fcbPtr ;Index to end of file mark
LDY #c_eof ; & index to user's call parameters
OutEOF LDA fcb+fcbEOF,X
STA (parm),Y
INX
INY
CPY #c_eof+3
BNE OutEOF ;Loop until all three bytes are moved
CLC ;No errors
RTS

357
MLI.SRC/CREATE.S Normal file
View File

@ -0,0 +1,357 @@
**************************************************
* CREATE call
Create JSR LookFile ;Check for duplicate / get free entry
BCS TestFnF ;Error code in A-reg may be 'file not found'
LDA #dupPathname ;Tell 'em a file of that name already exists
CrErr1 SEC ;Indicate error encountered
RTS ;Return error in A-reg
TestFnF CMP #fileNotFound ;'file not found' is what we want
BNE CrErr1 ;Pass back other error
LDY #c_fileKind ;Test for "tree" or directory file
LDA (parm),Y ;No other kinds are legal
CMP #tree+1 ;Is it seed, sapling, or tree?
BCC :1 ;Branch if it is
CMP #directoryFile
BNE CrTypErr ;Report type error if not directory.
:1 LDA DevNum ;Before proceeding, make sure destination
JSR TestWrProtZ ; device is not write protected...
BCS CrRtn
LDA noFree ;Is there space in directory to add this file?
BEQ XtnDir ;Branch if not
JMP CreateZ ;Otherwise, go create file
CrTypErr LDA #badStoreType
SEC ;Indicate error
CrRtn RTS
XtnDir LDA ownersBlock ;Before extending directory,
ORA ownersBlock+1 ; make sure it is a sub-directory!!!
BNE :11
LDA #volDirFull ;Otherwise report directory full error.
SEC
RTS
:11 LDA blockNum ;Preserve disk addr of current (last)
PHA
LDA blockNum+1 ; directory link, before allocating
PHA ; an extend block
JSR Alloc1Blk ;Allocate a block for extending directory
PLX
STX blockNum+1 ;Restore block addr of directory stuff in gbuf
PLX
STX blockNum
BCS CrRtn ;Branch if unable to allocate
STA genBuf+2 ;Save low block address in current directory
STY genBuf+3 ; & hi addr too
JSR WrtGBuf ;Go update dir. block with new link
BCS CrRtn ;(report any errors.)
LDX #$01
SwapBloks LDA blockNum,X ;Now prepare new directory block
STA genBuf,X ;Use current block as back link
LDA genBuf+2,X
STA blockNum,X ; & save new block as next to be written
DEX
BPL SwapBloks
INX ;Now X=0
TXA ; and A=0 too
ClrDir STA genBuf+2,X
STA genBuf+$100,X
INX
BNE ClrDir
JSR WrtGBuf ;Write prepared directory extension
BCS CrRtn ;Report errors
LDA ownersBlock
LDX ownersBlock+1
JSR RdBlkAX ;Read in 'parent' directory block
LDX ownersEnt ;Prepare to calculate entry address
LDA #genBuf/256
STA dirBufPtr+1
LDA #$04 ;Skip 4-byte blk link ptrs
OCalc CLC
DEX ;Has entry addr been computed?
BEQ :21 ;Branch if yes
ADC ownersLen ;Bump to next entry adr
BCC OCalc
INC dirBufPtr+1 ;Entry must be in second 256 of block
BCS OCalc ;Branch always
:21 STA dirBufPtr
LDY #d_usage ;Index to block count
:loop LDA (dirBufPtr),Y
ADC dIncTbl-d_usage,Y;Add 1 to block count and
STA (dirBufPtr),Y
INY
TYA ; $200 to the directory's end of file
EOR #d_eof+3 ;Done with usage/eof update?
BNE :loop ;Branch if not
JSR WrtGBuf ;Go update parent
BCS :2
JMP Create
:2 RTS
CreateZ EQU * ;Build new file
*-------------------------------------------------
* Zero general purpose buffer ($DC00-$DDFF)
ZeroGBuf LDX #$00
ClrGBuf STZ genBuf,X ;Zero out genBuf
STZ genBuf+$100,X
INX
BNE ClrGBuf ;loop until zipped!
LDY #c_time+1 ;Move user specified date/time
:loop1 LDA (parm),Y ; to directory entry
STA d_file+d_creDate-c_date,y
TXA ;If all four bytes of date/time are zero
ORA (parm),Y ; then use built in date/time
TAX
DEY ;Have all four bytes been moved and tested?
CPY #c_fileKind
BNE :loop1 ;Branch if not
TXA ;Does user want default time?
BNE :1 ;Branch if not
LDX #$03
:loop2 LDA DateLo,X ;Move current default date/time
STA d_file+d_creDate,X
DEX
BPL :loop2
:1 LDA (parm),Y ;(y is indexing fileKind)
CMP #tree+1
LDA #seedling*16 ;Assume tree type
BCC :2
LDA #directoryFile*16;Its dir since file kind has already been verified
:2 LDX namPtr ;Get index to 'local' name of pathname
ORA pathBuf,X ;Combine file kind with name length
STA d_file+d_stor ;(sos calls this 'storage type')
AND #$0F ;Strip back to name length
TAY ; & use as count-down for move
CLC
ADC namPtr ;Calculate end of name
TAX
CrName LDA pathBuf,X ;Now move local name as filename
STA d_file+d_stor,Y
DEX
DEY ;All characters transfered?
BNE CrName ;Branch if not
LDY #c_attr ;Index to 'access' parameter
LDA (parm),Y
STA d_file+d_attr
INY ;Also move 'file identification'
LDA (parm),Y
STA d_file+d_fileID
:loop1 INY ; & finally, the auxillary
LDA (parm),Y ; identifcation bytes
STA d_file+d_auxID-c_auxID,Y
CPY #c_auxID+1
BNE :loop1
LDA XDOSver ;Save current xdos version number
STA d_file+d_sosVer
LDA compat ; & backward compatiblity number
STA d_file+d_comp
LDA #$01 ;Usage is always 1 block
STA d_file+d_usage
LDA d_head ;Place back pointer to header block
STA d_file+d_dHdr
LDA d_head+1
STA d_file+d_dHdr+1
LDA d_file+d_stor ;Get storage type again
AND #$E0 ;Is it a directory?
BEQ CrAlocBlk ;Branch if seed file
LDX #30 ;Move header to data block
:loop2 LDA d_file+d_stor,X
STA genBuf+4,X
DEX
BPL :loop2
EOR #$30 ;($Dn->$En) last byte is fileKind/namlen
STA genBuf+4 ;Make it a directory header mark
LDX #$07 ;Now overwrite password area
:loop3 LDA Pass,X ; and other header info
STA genBuf+4+hPassEnable,X
LDA XDOSver,X
STA genBuf+4+hVer,X
DEX
BPL :loop3
LDX #$02 ; & include info about 'parent directory
STX d_file+d_eof+1
:loop4 LDA d_entBlk,X
STA genBuf+4+hOwnerBlk,X
DEX
BPL :loop4
LDA h_entLen ;Lastly the length of parent's dir entries
STA genBuf+4+hOwnerLen
CrAlocBlk JSR Alloc1Blk ;Get address of file's data block
BCS CrErr3 ;Branch if error encountered
STA d_file+d_first
STY d_file+d_first+1
STA blockNum
STY blockNum+1
JSR WrtGBuf ;Go write data block of file
BCS CrErr3
INC h_fileCnt ;Add 1 to total # of files in this directory
BNE :1
INC h_fileCnt+1
:1 JSR ReviseDir ;Go revise directories with new file
BCS CrErr3
JMP UpdateBitMap ;Lastly, update volume bitmap
*-------------------------------------------------
* Point dirBufPtr ($48/$49) at directory entry
EntCalc LDA #genBuf/256 ;Set high address of directory
STA dirBufPtr+1 ; entry index pointer
LDA #$04 ;Calculate address of entry based
LDX d_entNum ; on the entry number
:loop1 CLC
:loop2 DEX ;addr=genBuf+((entnum-1)*entlen)
BEQ :exitLoop
ADC h_entLen
BCC :loop2
INC dirBufPtr+1 ;Bump hi address
BCS :loop1 ;Branch always
:exitLoop STA dirBufPtr ;Save newly calculated low address
CrErr3 EQU *
DError2 RTS ;Return errors
*-------------------------------------------------
* Update directory(s)
ReviseDir LDA DateLo ;If no clock,
BEQ ReviseDirZ ; then don't touch mod time/date
LDX #$03
:loop LDA DateLo,X ;Move last modification date/time
STA d_file+d_modDate,X; to entry being updated
DEX
BPL :loop
ReviseDirZ LDA d_file+d_attr ;Mark entry as backupable
ORA bkBitFlg ; bit 5 = backup needed bit
STA d_file+d_attr
LDA d_dev ;Get device number of directory
STA DevNum ; to be revised
LDA d_entBlk ; & address of directory block
LDX d_entBlk+1
JSR RdBlkAX ;Read block into general purpose buffer
BCS DError2
JSR EntCalc ;Fix up pointer to entry location within gbuf
LDY h_entLen ;Now move 'd_' stuff to directory
DEY
:loop1 LDA d_file+d_stor,Y
STA (dirBufPtr),Y
DEY
BPL :loop1
LDA d_head ;Is the entry block the same as the
CMP blockNum ; entry's header block?
BNE SavEntDir ;No, save entry block
LDA d_head+1 ;Maybe, test high addresses
CMP blockNum+1
BEQ UpHead ;Branch if they are the same block
SavEntDir JSR WrtGBuf ;Write updated directory block
BCS DError2 ;Return any error
LDA d_head ;Get address of header block
LDX d_head+1
JSR RdBlkAX ;Read in header block for modification
BCS DError2
UpHead LDY #$01 ;Update current # of files in this directory
:loop2 LDA h_fileCnt,Y
STA genBuf+hFileCnt+4,Y;(current entry count)
DEY
BPL :loop2
LDA h_attr ;Also update header's attributes
STA genBuf+hAttr+4
JSR WrtGBuf ;Go write updated header
BCS DError1
Ripple LDA genBuf+4 ;Test for 'root' directory
AND #$F0 ;If it is root, then dir revision is complete
EOR #$F0 ;(leaves carry clear)
BEQ DirRevDone ;Branch if ripple done
LDA genBuf+hOwnerEnt+4;Get entry number &
STA d_entNum
LDA genBuf+hOwnerEnt+5; the length of entries in that dir
STA h_entLen
LDA genBuf+hOwnerBlk+4;Get addr of parent entry's dir block
LDX genBuf+hOwnerBlk+5
JSR RdBlkAX ;Read that sucker in
BCS DError1
JSR EntCalc ;Get indirect ptr to parent entry in genBuf
LDA DateLo ;Don't touch mod
BEQ RUpdate ; if no clock...
LDX #$03 ;Now update the modification date
LDY #d_modDate+3 ; & time for this entry too
RipTime LDA DateLo,X
STA (dirBufPtr),Y
DEY
DEX
BPL RipTime ;Move all for bytes...
* Write updated entry back to disk. (Assumes blockNum undisturbed)
RUpdate JSR WrtGBuf
BCS DError1 ;Give up on any error
LDY #d_dHdr ;Now compare current block number to
LDA (dirBufPtr),Y ; this entry's header block
INY
CMP blockNum ;Are low addresses the same?
STA blockNum ;(save it in case it's not)
BNE :1 ;Branch if entry does not reside in same block as header
LDA (dirBufPtr),Y ;Check high address just to be sure
CMP blockNum+1
BEQ Ripple ;They are the same, continue ripple to root directory
:1 LDA (dirBufPtr),Y ;They aren't the same,
STA blockNum+1 ; read in this directory's header
JSR RdGBuf
BCC Ripple ;Continue if read was good
DError1 RTS
TestErr LDA #unknownVol ;Not tree or dir - not a recognized type!
SEC
RTS
*-------------------------------------------------
* Is this a ProDOS vol?
TestSOS LDA genBuf ;Test SOS stamp
ORA genBuf+1
BNE TestErr
LDA genBuf+4 ;Test for header
AND #$E0
CMP #$E0
BNE TestErr ;Branch if not SOS header (no error number)
DirRevDone CLC ;Indicate no error
RTS

103
MLI.SRC/DATATBLS.S Normal file
View File

@ -0,0 +1,103 @@
***********************************************************
* ---- Added call $41 & its count - see rev note 20 --------
scNums EQU *
DFB $D3,0,0,0 ;(zeros are reserved for bfm)
DFB $40,$41,$00,0 ;(zero is reserved for interrupt calls)
DFB $80,$81,$82,$65
DFB $C0,$C1,$C2,$C3
DFB $C4,$C5,$C6,$C7
DFB $C8,$C9,$CA,$CB
DFB $CC,$CD,$CE,$CF
DFB $00,$D0,$D1,$D2 ;zero is non-existent.
pCntTbl EQU * ;parameter counts for the calls
HEX 02FFFFFF
HEX 0201FFFF
HEX 03030004
HEX 07010207
HEX 0A020101
HEX 03030404
HEX 01010202
HEX FF020202
*-------------------------------------------------
* JMP table
cmdTable EQU *
DA Create
DA Destroy
DA Rename
DA SetInfo
DA GetInfo
DA Online
DA SetPrefix
DA GetPrefix
DA Open
DA NewLine
DA Read
DA Write
DA Close
DA Flush
DA SetMark
DA GetMark
DA SetEOF
DA GetEOF
DA SetBuf
DA GetBuf
*-------------------------------------------------
* Function bits for MLI codes $C0-$D3
Dispatch EQU *
DB prePath+preTime+0;create
DB prePath+preTime+1;destroy
DB prePath+preTime+2;rename
DB prePath+preTime+3;setinfo
DB prePath+4 ;getinfo
DB $05 ;volume
DB $06 ;setprefix, pathname moved to prefix buffer
DB $07 ;getprefix
DB prePath+8 ;open
DB preRef+$9 ;newline
DB preRef+$a ;read
DB preRef+$b ;write
DB preTime+$c ;close
DB preTime+$d ;flush, refnum may be zero to flush all
DB preRef+$e ;setmark
DB preRef+$f ;getmark
DB preRef+$10 ;set eof
DB preRef+$11 ;get eof
DB preRef+$12 ;set buffer address (move)
DB preRef+$13 ;get buffer address
*-------------------------------------------------
* Constants
dIncTbl DB 1,0,0,2,0 ;Table to increment directory usage/EOF counts
Pass DB $75
XDOSver DB $0,0,$C3,$27,$0D,0,0,0
compat EQU XDOSver+1
rootStuff DB $0F,2,0,4
DB 0,0,8,0
WhichBit HEX 8040201008040201
* The following table is used in the 'Open:loop1' (posn/open).
* Offsets into file control blocks (FCBs)
oFCBTbl DFB fcbFirst,fcbFirst+1,fcbBlksUsed,fcbBlksUsed+1
DFB fcbEOF,fcbEOF+1,fcbEOF+2
* Set/Get file info offsets
* The following with $80+ are ignored by SetInfo
InfoTabl DFB d_attr,d_fileID,d_auxID,d_auxID+1
DFB $80+d_stor,$80+d_usage,$80+d_usage+1,d_modDate
DFB d_modDate+1,d_modTime,d_modTime+1,d_creDate
DFB d_creDate+1,d_creTime,d_creTime+1
Death ASC ' '
ASC "RESTART SYSTEM-$01"
ASC ' '

423
MLI.SRC/DESTROY.S Normal file
View File

@ -0,0 +1,423 @@
***********************************************************
* Newline Call
NewLine LDY #c_isNewln ;Adjust newline status for open file
LDA (parm),Y ;on or off?
LDX fcbPtr ;It will be zero if off
STA fcb+fcbNLMask,X ;Set new line mask
INY
LDA (parm),Y ; & move in new 'new-line' byte
STA fcb+fcbNewLin,X
CLC
RTS ;No error possible
GetInfo JSR FindFile ;Look for file they want to know about
BCC :1 ;Branch if no errors
CMP #badPathSyntax ;Was it a root directory file?
SEC ;(in case of no match)
BNE :Ret
LDA #$F0
STA d_file+d_stor ;For get info, report proper storage type
STZ reqL ;Force a count of free blocks
STZ reqH
LDX vcbPtr
JSR TakeFreeCnt ;Take a fresh count of free blocks on this volume
LDX vcbPtr
LDA vcb+vcbFreeBlks+1,X;Return total blocks and total in use
STA reqH ;First transfer 'free' blocks to zpage for later subtract
LDA vcb+vcbFreeBlks,X; to determine the 'used' count
STA reqL
LDA vcb+vcbTotBlks+1,X;Transfer to 'd_' table as auxID
STA d_file+d_auxID+1;(total block count is considered auxID for the volume)
PHA
LDA vcb+vcbTotBlks,X
STA d_file+d_auxID
SEC ;Now subtract and report the number of blocks 'in use'
SBC reqL
STA d_file+d_usage
PLA
SBC reqH
STA d_file+d_usage+1
:1 LDA d_file+d_stor ;Transfer bytes from there internal order
LSR ; to call spec via 'infoTabl' translation table
LSR
LSR ; but first change storage type to
LSR ; external (low nibble) format
STA d_file+d_stor
LDY #c_creTime+1 ;Index to last of user's spec table
:CpyLoop LDA InfoTabl-3,Y
AND #$7F ;Strip bit used by setinfo
TAX
LDA d_file,X ;Move directory info to call spec. table
STA (parm),Y
DEY
CPY #c_attr ;have all info bytes been sent?
BCS :CpyLoop
:Ret RTS
SetInfo JSR FindFile ;Find what user wants...
BCS SInfoErr ;Return any failure
LDA BUBit ;Discover if backup bit can be cleared
EOR #backupNeeded
AND d_file+d_attr
AND #backupNeeded
STA bkBitFlg ; or preserve current...
LDY #c_modTime+1 ;Init pointer to user supplied list
:loop1 LDX InfoTabl-3,Y ;Get index into coresponding 'd_' table
BMI :11 ;Branch if we've got a non-setable parameter
LDA (parm),Y
STA d_file,X
:11 DEY ;Has user's request been satisfied?
CPY #c_attr
BCS :loop1 ;No, move next byte
* Make sure no illegal access bits were set!
AND #$FF-destroyEnable-renameEnable-backupNeeded-fileInvisible-writeEnable-readEnable
BEQ SetInfo3 ;Branch if legal access
LDA #invalidAccess ;Otherwise, refuse to do it
SEC ;Indicate error
SInfoErr RTS
SetInfo3 LDY #c_modDate+1
LDA (parm),Y ;Was clock null input?
BEQ :Jump
JMP ReviseDirZ ;End by updating directory
:Jump JMP ReviseDir ;Update with clock also...
*-------------------------------------------------
* RENAME call
* Only the final name in the path specification
* may be renamed. In other words, the new name
* must be in the same DIRectory as the old name.
Rename JSR LookFile ;Look for source (original) file
BCC Rename0 ;Branch if found
CMP #badPathSyntax ;Trying to rename a volume?
BNE :1 ;No, return other error
JSR RenamePath ;Syntax new name
BCS :1
LDY pathBuf ;Find out if only rootname for new name
INY
LDA pathBuf,Y ;Must be $ff if v-name only
BNE RenBadPath ;Branch if not single name
LDX vcbPtr ;Test for open files before changing
LDA vcb+vcbStatus,X
BPL RenameVol ;Branch if volume not busy
LDA #fileBusy
:1 SEC
RTS
RenameVol LDY #$00 ;Get newname's length
LDA pathBuf,Y
ORA #$F0 ;(root file storage type)
JSR MovRootName ;Update root directory
BCS RenErr
LDY #$00
LDX vcbPtr ;Update VCB also
:loop LDA pathBuf,Y ;Move new name to VCB
BEQ :ExitLoop
STA vcb,X
INY ;Bump to next character
INX
BNE :loop ;Branch always taken
:ExitLoop CLC ;No errors
RTS
Rename0 JSR GetNamePtr ;Set Y-reg to first char of path, X=0
:loop1 LDA pathBuf,Y ;Move original name to genBuf
STA genBuf,X ; for later comparison with new name
BMI :11 ;Branch if last character has been moved
INY ;Otherwise, get the next one
INX
BNE :loop1 ;Branch always taken
:11 JSR RenamePath ;Get new name syntaxed
BCS RenErr
JSR GetNamePtr ;Set Y to path, X to 0
LDA pathBuf,Y ;Now compare new name with old name
:loop2 CMP genBuf,X ; to make sure that they are in the same dir
PHP ;Save result of compare for now
AND #$F0 ;Was last char really a count?
BNE :12 ;Branch if not
STY rnPtr ;Save pointer to next name, it might be the last
STX pnPtr
:12 PLP ;What was the result of the compare?
BNE NoMatch ;Branch if different character or count
INX ;Bump pointers
INY
LDA pathBuf,Y ;Was that the last character?
BNE :loop2 ;Branch if not
CLC ;No-operation, names were the same
RTS
NoMatch LDY rnPtr ;Index to last name in the chains
LDA pathBuf,Y ;Get last name length
SEC
ADC rnPtr
TAY
LDA pathBuf,Y ;This byte should be $00!
BNE RenBadPath ;Branch if not
LDX pnPtr ;Index to last of original name
LDA genBuf,X
SEC
ADC pnPtr
TAX
LDA genBuf,X ;This byte should also be $00
BEQ GoodNames ;Continue processing if it is
RenBadPath LDA #badPathSyntax
RenErr SEC
RTS ;Report error
GoodNames JSR LookFile ;Test for duplicate file name
BCS :21 ;Branch if file not found, which is what we want!
LDA #dupPathname ;New name already exists
SEC ;Report duplicate
RTS
:21 CMP #fileNotFound ;Was it a valid "file not found"?
BNE RenErr ;No, return other error code
JSR SetPath ;Now syntax the pathname of the file to be changed
JSR FindFile ;Get all the info on this one
BCS RenErr
JSR TestOpen ;Don't allow rename to occur if file is in use
LDA #fileBusy ;Anticipate error
BCS RenErr
LDA d_file+d_attr ;Test bit that says it's ok to rename
AND #renameEnable
BNE Rename8 ;Branch if it's alright to rename
LDA #invalidAccess ;Otherwise report illegal access
RenErr1 SEC
RTS
Rename8 LDA d_file+d_stor ;Find out which storage type
AND #$F0 ;Strip off name length
CMP #directoryFile*16;Is it a directory?
BEQ :31
CMP #{tree+1}*16 ;Is it a seed, sapling, or tree?
BCC :31
LDA #badFileFormat
BNE RenErr1
:31 JSR RenamePath ;Well... since both names would go into the dir,
BCS RenErr ; re-syntax the new name to get local name address
LDY rnPtr ;(Y contains index to local name length)
LDX pathBuf,Y ;Adjust Y to last char of new name
TYA
ADC pathBuf,Y
TAY
:loop LDA pathBuf,Y ;Move local name to dir entry workspace
STA d_file+d_stor,X
DEY
DEX
BNE :loop
LDA d_file+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_file+d_stor
CPX #directoryFile*16; that file must be changed also
BNE RenameDone ;Branch if not directory type
* Renaming a DIR file
LDA d_file+d_first ;Read in 1st (header) block of sub-dir
LDX d_file+d_first+1
JSR RdBlkAX
BCS RenErr ;Report errors
LDY rnPtr ;Change the header's name to match the owner's new name
LDA pathBuf,Y ;Get local name length again
ORA #$E0 ;Assume it's a vol/subdir header
JSR MovRootName
BCS RenErr
RenameDone JMP ReviseDirZ ;End by updating all path directories
MovRootName LDX #$00
:loop STA genBuf+4,X
INX
INY
LDA pathBuf,Y
BNE :loop
JMP WrtGBuf ;Write changed header block
*-------------------------------------------------
RenamePath LDY #c_newPath ;Get address to new pathname
LDA (parm),Y
INY
STA tPath
LDA (parm),Y ;Set up for syntaxing routine (SynPath)
STA tPath+1
JMP SynPath ;Go syntax it. (Ret last local name length in Y)
GetNamePtr LDY #$00 ;Return pointer to first name of path
BIT prfxFlg ;Is this a prefixed name?
BMI :1 ;Branch if not
LDY NewPfxPtr
:1 LDX #$00
RTS
***********************************************************
* Destroy Call
Destroy JSR FindFile ;Look for file to be wiped out
BCS DstryErr ;Pass back any error
JSR TestOpen ;Is this file open?
LDA totEnt
BNE :3 ;Branch if file open
STZ reqL ;Force proper free count in volume
STZ reqH ;(no disk access occurs if already proper)
JSR TestFreeBlk
BCC :1
CMP #volumeFull ;Was it just a full disk?
BNE DstryErr ;Nope, report error
:1 LDA d_file+d_attr ;Make sure it's ok to destroy this file
AND #destroyEnable
BNE :2 ;Branch if ok
LDA #invalidAccess ;Tell user it's not kosher
JSR SysErr ;(returns to caller of destroy)
:2 LDA DevNum ;Before going thru deallocation,
JSR TestWrProtZ ; test for write protected hardware
BCS DstryErr
LDA d_file+d_first ;"DeTree" needs first block addr
STA firstBlkL ; which is file's keyblk
LDA d_file+d_first+1
STA firstBlkH
LDA d_file+d_stor ;Find out which storage type
AND #$F0 ;Strip off name length
CMP #{tree+1}*16 ;Is it a seed, sapling, or tree?
BCC DstryTree ;Branch if it is
BRA DestroyDir ;Otherwise test for directory destroy
:3 LDA #fileBusy
DstryErr SEC ;Inform user that file can't
RTS ; be destroyed at this time
DstryTree EQU * ;Destroy a tree file
STA storType ;Save storage type
LDX #$05
LDA #$00 ;Set "DeTree" input variables
:loop STA storType,X ;Variables must be
DEX ; in order:deBlock, dTree, dSap, dSeed
BNE :loop ;Loop until all set to zero
LDA #$02
STA dSeed+1 ;This avoids an extra file i/o
********************** see rev note #73 **********************
********************* see rev note #49 **********************
********************** see rev note #41 *********************
INC delFlag ;Don't allow DeTree to zero index blocks
JSR DeTree ;Make trees and saplings into seeds
DEC delFlag ;Reset flag
BCS DstryErr1 ;(de-evolution)
DstryLast LDX firstBlkH
LDA firstBlkL ;Now deallocate seed
JSR Dealloc
BCS DstryErr1
JSR UpdateBitMap
DstryErr1 PHA ;Save error code (if any)
LDA #$00 ;Update directory to free entry space
STA d_file+d_stor
CMP h_fileCnt ;File entry wrap?
BNE :2 ;Branch if no carry adjustment
DEC h_fileCnt+1 ;Take carry from high byte of file entries
:2 DEC h_fileCnt ;Mark header with one less file
JSR DvcbRev ;Go update block count in VCB
JSR ReviseDir ;Update directory last...
TAX
PLA
BCC :3
TXA
:3 CMP #badSystemCall
RTS
*-------------------------------------------------
* Update free block count in VCB
DvcbRev LDY vcbPtr
LDA deBlock ;Add blks freed to
ADC vcb+vcbFreeBlks,Y; total free blks
STA vcb+vcbFreeBlks,Y;Update current free block count
LDA deBlock+1
ADC vcb+vcbFreeBlks+1,Y
STA vcb+vcbFreeBlks+1,Y
LDA #$00 ;Force rescan for free blks
STA vcb+vcbCurrBitMap,Y; from first bitmap
RTS
ToDstLast BCC DstryLast ;Always
DestroyDir CMP #directoryFile*16;Is this a directory file?
BNE DirCompErr ;No, report file incompatible
JSR FindBitMap ;Make sure a buffer is available for the bitmap
BCS DstryDirErr
LDA d_file+d_first ;Read in first block
STA blockNum ; of directory into genBuf
LDA d_file+d_first+1
STA blockNum+1
JSR RdGBuf
BCS DstryDirErr
LDA genBuf+4+hFileCnt;Find out if any files exist on this directory
BNE DstryDirAccs ;Branch if any exist
LDA genBuf+4+hFileCnt+1
BEQ DstryDir1
DstryDirAccs LDA #invalidAccess
JSR SysErr
DstryDir1 STA genBuf+4 ;Make it an invalid subdir
JSR WrtGBuf
BCS DstryDirErr
:loop LDA genBuf+2 ;Get forward link
CMP #$01 ;Test for no link
LDX genBuf+3
BNE :1
BCC ToDstLast ;If no link, then finished
:1 JSR Dealloc ;Free this block
BCS DstryDirErr
LDA genBuf+2
LDX genBuf+3
JSR RdBlkAX
BCC :loop ;Loop until all are freed
DstryDirErr RTS
DirCompErr LDA #badFileFormat ;File is not compatible
JSR SysErr
* Mark as FCB as dirty so the directory will be flushed on 'flush'
FCBUsed PHA ;Save regs
TYA
PHA
LDY fcbPtr
LDA fcb+fcbDirty,Y ;Fetch current fcbDirty byte
ORA #fcbMod ;Mark FCB as dirty
STA fcb+fcbDirty,Y ;Save it back
PLA
TAY ; & restore regs
PLA
RTS

259
MLI.SRC/DETREE.S Normal file
View File

@ -0,0 +1,259 @@
**************************************************
* "DeTree" deallocates blocks from tree files.
*
* It is assumed that the device preselected and the 'genBuf' may be used.
*
* On entry the following values must be set:
* storType = storage type in upper nibble, lower nibble is undisturbed.
* firstBlkL & firstBlkH = first block of file (index or data)
* deBlock = 0 (see below)
* dTree = ptr to 1st block with stuff to be deallocated at tree level.
* dSap = ptr to 1st block at sapling level
* dSeed = byte (0-511) position to be zeroed from (inclusive).
* NB. There is 2 special cases when dSeed = 512
* Case 1) when EOF is set at a block boundary
* Case 2) when file is destroyed
*
* On exit:
* storType = modified result of storage type (if applicable)
* firstBlkL & H = modified if storage type changed.
* deBlock = total number of blocks freed at all levels.
* dTree, dSap, dSeed unchanged.
*
* To trim a tree to a seed file, both dTree and dSap must be zero.
* To go from tree to sapling, dTree alone must be zero.
DeTree LDA storType ;Which flavor of tree?
CMP #sapling*16 ;Is it a 'seed' (<=$1F)
BCC SeedDeAlloc ;Yes
CMP #tree*16 ;Maybe a 'sapling'?
BCC SapDeAlloc
CMP #{tree+1}*16 ;Well, at least be certain it's a 'tree'
BCC TreeDeAlloc ;Branch if it is
LDA #badBlockErr ;Block allocation error
JSR SysDeath ;Should never have been called
SeedDeAlloc LDA dSap
ORA dTree
BNE BummErr
JMP SeedDeAlloc0 ;Trim to a seed
SapDeAlloc LDA dTree
BNE BummErr
JMP SapDeAlloc0 ;Trim to a sapling
TreeDeAlloc LDA #128
STA topDest ;For tree top, start at end, work backwards
:loop1 JSR RdKeyBlk ;Read specified first block into genBuf
BCS BummErr ;Return all errors
LDY topDest ;Get current pointer to top indexes
CPY dTree ;Have enough sapling indexes been deallocated?
BEQ TreeDel17 ;Yes, now deallocate top guys!
LDX #$07 ;Buffer up to 8 sapling index block addrs
:loop2 LDA genBuf,Y ;Fetch low block address
STA deAlocBufL,X ; and save it
ORA genBuf+$100,Y ;Is it a real block that is allocated?
BEQ :1 ;It's a phantom block
LDA genBuf+$100,Y ;Fetch hi block addr
STA deAlocBufH,X ; and save it
DEX ;Decrement and test for dealoc buf filled
BMI :2 ;Branch if we've fetched 8 addresses
:1 DEY ;Look now for end of deallocation limit
CPY dTree ;Is this the last position on tree level?
BNE :loop2 ;No
INY
LDA #$00 ;Fill rest of deAloc buffer with NULL addresses
:loop3 STA deAlocBufL,X
STA deAlocBufH,X
DEX
BPL :loop3 ;Loop until filled
:2 DEY ;Decrement to prepare for next time
STY topDest ;save index
LDX #$07
:loop4 STX dTempX ;Save index to deAloc buf
LDA deAlocBufL,X
STA blockNum
ORA deAlocBufH,X ;Are we finished?
BEQ :loop1 ;Branch if done with this level
LDA deAlocBufH,X ;Complete address with hi byte
STA blockNum+1
JSR RdGBuf ;Read sapling level into genBuf
BCS BummErr ;Return any errors
JSR DeAllocBlk ;Go free all data indexes in this block
BCS BummErr
JSR WrtGBuf
BCS BummErr
LDX dTempX ;Restore index to dealloc buff
DEX ;Are there more to free?
BPL :loop4 ;Branch if there are
BMI :loop1 ;Branch always to do next bunch
deAlocTreeDone EQU *
deAlocSapDone EQU *
BummErr RTS
TreeDel17 LDY dTree ;Now deallocate all tree level
INY ; blocks greater than specified block
JSR DeAlocBlkZ ;(tree top in genBuf)
BCS BummErr ;Report any errors
JSR WrtGBuf ;Write updated top back to disk
BCS BummErr
LDY dTree ;Now figure out if tree can become sapling
BEQ :11 ;Branch if it can!
LDA genBuf,Y ;Otherwise, continue with partial
STA blockNum ; deallocation of last sapling index
ORA genBuf+$100,Y ;Is there such a sapling index block?
BEQ deAlocTreeDone ;All done if not!
LDA genBuf+$100,Y ;Read in sapling level to be modified
STA blockNum+1
JSR RdGBuf ;Read 'highest' sapling index into genBuf
BCC SapDeAllocZ
RTS
:11 JSR Shrink ;Shrink tree to sapling
BCS BummErr
* Deallocate a sapling file
SapDeAlloc0 JSR RdKeyBlk ;Read specified only sapling level index into gbuf
BCS BummErr
SapDeAllocZ LDY dSap ;fetch pointer to last of desirable indexes
INY ;Bump to the first undesirable
BEQ :21 ;branch if all are desirable
JSR DeAlocBlkZ ;Deallocate all indexes above appointed
BCS BummErr
JSR WrtGBuf ;Update disk with remaining indexes
BCS BummErr
:21 LDY dSap ;Now prepare to cleanup last data block
BEQ :22 ;Branch if there is a posiblity of making it a seed
:loop LDA genBuf,Y ;Fetch low order data block addr
STA blockNum
ORA genBuf+$100,Y ;Is it a real block?
BEQ deAlocSapDone ;We're done if not
LDA genBuf+$100,Y
STA blockNum+1
JSR RdGBuf ;Go read data block into gbuf
BCC SeedDeAllocZ ;Branch if good read
RTS ;Otherwise return error
:22 LDA dTree ;Are both tree and sap levels zero?
BNE :loop ;Branch if not.
JSR Shrink ;Reduce this sap to a seed
BCS BumErr1
* If no error, drop into SeedDeAlloc0
SeedDeAlloc0 JSR RdKeyBlk ;Go read only data block
BCS BumErr1 ;Report any errors
SeedDeAllocZ LDY dSeed+1 ;Check hi byte for no deletion
BEQ :31 ;Branch if all of second page is to be deleted
DEY ;If dseed>$200 then were all done!
BNE BumErr1 ;Branch if that's the case
LDY dSeed ;Clear only bytes >= dseed
:31 LDA #$00
:loop1 STA genBuf+$100,Y ;Zero out unwanted data
INY
BNE :loop1
LDY dSeed+1 ;Was that all?
BNE :32 ;Branch if it was
LDY dSeed
:loop2 STA genBuf,Y
INY
BNE :loop2
:32 JMP WrtGBuf ;Update data block to disk
BumErr1 RTS
RdKeyBlk LDA firstBlkL ;Read specified first
LDX firstBlkH ; block into genBbuf
JMP RdBlkAX ;Go do it!
**************************************************
* Beware that dealloc may bring in a new bitmap block
* and may destroy locations 46 and 47 which use to
* point to the current index block.
**************************************************
Shrink LDX firstBlkH ;First deallocate top block
TXA
PHA
LDA firstBlkL
PHA ;Save block address of this index block
JSR Dealloc ;Go do it
PLA
STA blockNum ;Set master of sapling index block address
PLA
STA blockNum+1
BCS :Ret ;report any errors
LDA genBuf ;Get first block at lower level
STA firstBlkL
LDA genBuf+$100
STA firstBlkH
LDY #$00
JSR SwapMe
SEC ;Now change file type, from
LDA storType ; tree to sapling,
SBC #$10 ; or from sapling to seed!
STA storType
JSR WrtGBuf
:Ret RTS
*-------------------------------------------------
* Free master index/index block entries
* If DeAlockBlkZ is used, (Y) must be set correctly
DeAllocBlk LDY #$00 ;Start at the beginning
DeAlocBlkZ LDA blockNum ;Save disk address
PHA ; of genBuf's data
LDA blockNum+1
PHA
:loop STY sapPtr ;Save current index
LDA genBuf,Y ;Get address (low) of block to be deallocated
CMP #$01 ;Test for NULL block
LDX genBuf+$100,Y ;Get the rest of the block address
BNE :1 ;Branch if not NULL
BCC :2 ;Skip it if NULL
:1 JSR Dealloc ;Free it up on volume bitMap
BCS :3 ;Return any error
LDY sapPtr ;Get index to sapling level index block again
JSR SwapMe
:2 INY ;Point at next block address
BNE :loop ;Branch if more to deallocate (or test)
CLC ;Indicate no error
:3 TAX ;Save error code, if any
PLA
STA blockNum+1
PLA
STA blockNum
TXA ;Restore return code
RTS
**************************************************
* delFlag = 0 - Not called by Destroy
* delFlag = 1 - Called Destroy ie swapping
* Swap the Lo & Hi indices making up a disk addr
* so that disk recovery programs may be able
* to undelete a destroyed file
SwapMe LDA delFlag ;Are we swapping or zeroing ?
BNE :1 ;Skip if swapping
TAX ;Make X a 0
BEQ :2 ;0 the index (always taken)
:1 LDX genBuf+$100,Y ;Get index, hi
LDA genBuf,Y ;Get index, lo
:2 STA genBuf+$100,Y ;Save index, hi
TXA
STA genBuf,Y ;Save index, lo
RTS ;We're done

667
MLI.SRC/DEVSRCH.S Normal file
View File

@ -0,0 +1,667 @@
***********************************************************
Greet LDA SPKR ;Give a 'click'
STA CLR80VID ;Disable 80 columns (rev-e)
STA CLR80COL ;Disable '80store'
JSR SetNorm
JSR Init
JSR SetVid
JSR SetKBD
CLD
* Note: interrupts are not turn off
JSR HOME ;Clear screen
LDX #p8VerMsg-apple2Msg-1;Move greeting to screen
:loop1 LDA apple2Msg,X ;"apple ii"
STA SLIN09+20-4,X ;$4A8 starts the line
DEX
BPL :loop1
LDX #blanks-p8VerMsg-1
:loop2 LDA p8VerMsg,X ;"prodos (version) (date)"
STA SLIN11+20-grtLnZ,X
DEX
BPL :loop2
LDX #cpyRhtMsg-blanks-1
:loop3 LDA blanks,X ;(blank line)
STA SLIN13+20-grtLnZZ,X
DEX
BPL :loop3
LDX #rsvdMsg-cpyRhtMsg-1
:loop4 LDA cpyRhtMsg,X ;Copyright Message
STA SLIN22,X
DEX
BPL :loop4
LDX #endGreetMsg-rsvdMsg-1
:loop5 LDA rsvdMsg,X ;Rights message
STA SLIN23+20-grtLnZZZ,X
DEX
BPL :loop5
SEC
JSR IDroutine
BCS NotIIgs ;Not IIgs
LDA #$80
TRB NEWVIDEO ;Enable SuperHires
NotIIgs LDA SPKR
RTS
***************************************************
*
* This routine finds all disk devices plugged into the
* system's slots that follow apple's disk id convention.
* The routine sets up the address and device table in
* ProDOS's system global page. 13-sector disk ]['s are
* not configured since they may not function properly in
* the 16 sector mode...
*
* Profiles, and other intelligent devices, are expected to
* have ROMs containing the disk I/O drivers.
*
* This routine was revved 8/21/86 to make sure that correct number
* of smartport devices are installed, and that disk ][s are always
* searched last by placing them at the end of the list. Disk ][ unit
* numbers are stacked at the end of the device table, while regular
* devices are stacked at the beginning. After all slots have been
* searched the two lists are combined. see note 60.
*
statusList EQU *
spDevStatus EQU *
numDevices DS 8,0 ;Eight bytes for smartport call
maxUnitP1 EQU * ;# of units connected to SP+1
driverAdr DA $0000
dsk2Idx DB $00
diskInSlot2 DB $00 ;msb set if drive in slot 2
*-------------------------------------------------
DevSrch STZ dst
STZ dst+1
STZ indrcn ;Set up for search
LDX #$FF
STX DevCnt ;Device count=none
LDA #14 ;Start disk ][ area at the end of devlist
STA dsk2Idx
*********************** see note #65 ***********************
*
* Make a quick check of slot 2. If there is a disk card there,
* clear the msb of diskInSlot2. This will limit the number of
* devices in any slot 5 smartport card to 2.
*
LDA #$C2
STA indrcn+1 ;Check slot 2
JSR CmpID ;Is there a disk card in slot 2?
ROR diskInSlot2 ;Clear msb if so, set otherwise
LDA #$C7 ;Search slots from high to low
STA indrcn+1
FindDsk EQU *
***************** code here became a subroutine ****************
************************* see note #65 *************************
JSR CmpID
BCS NxtDsk ;Carry set means no card this slot
LDA (indrcn),Y ;Check last byte of $Cn ROM
BEQ DiskII ;If =00 then 16 sector disk ][
CMP #$FF ;If =ff then 13 sector disk ][
BCS NxtDsk ;Ignore if 13 sector boot ROM
STA driverAdr ;else, assume it's an intelligent disk for now.
LDY #$07 ;Check for a SmartPort device
LDA (indrcn),Y
BNE NoSPort
JMP SmartPort
* Ref ProDOS Tech Ref (ROM Code conventions)
NoSPort LDY #$FE ;Get attributes byte & verify it
LDA (indrcn),Y
AND #$03 ; provides read, write, and status calls
CMP #$03 ; (should be #$07)
SEC ;Assume it is a bozo brand disk...
BNE NxtDsk
JSR SetDevID
CLC
PHP ;Remember that it's not a disk ][
LSR ;Move # of units (0=1, 1=2) to carry
LDA indrcn+1 ;(driverAdr)=low entry addr, save hi addr
BNE ADevice ;Always
DiskII STA devID ;Disk ]['s have null attributes
SEC
PHP ;Remember it's a disk ][
LDA D2BlkIO
STA driverAdr
LDA D2BlkIO+1
* The carry is already set telling InstallDev
* to install two devices for disk ][s.
ADevice STA driverAdr+1
JSR InstallDev ;Install one or two devices this slot
PLP ;Get back if it's disk ][
BCC NoDisk2
DEX ;Move the list pointer back
DEX ;(installdev left X set)
STX DevCnt
DEC dsk2Idx ;Increase the disk ][ index
DEC dsk2Idx
LDY dsk2Idx
INX ;Increase X in case =$FF
LDA DevLst+1,X
STA DevLst,Y
LDA DevLst,X
STA DevLst+1,Y
DEX ;Back to DevCnt again
NoDisk2 EQU *
NxtDsk2 CLC
NxtDsk JSR SlotROM ;Test for clock & other devices
DEC indrcn+1 ;Set up for next lower slot
LDA indrcn+1 ;Have all slots been checked?
AND #$07
BNE FindDsk ;No
JSR ScanAll4SP ;Mirror smartport devices
* Now copy the disk ][ list to the end of the regular list
* start by making the device count include disk ][s
LDX DevCnt ;Load up current devcnt-1
LDA #14
SEC
SBC dsk2Idx
BEQ D2Snone ;If there were no disk ][s, forget it
CLC
ADC DevCnt ;Sum of disk ][s and others
STA DevCnt
INX ;Move to open space in regular list
LDY #13 ;First disk ][ entry
MLab LDA DevLst,Y
PHA
LDA DevLst,X
STA DevLst,Y
PLA
STA DevLst,X
INX
DEY
STY dsk2Idx ;Use as a temp
CPX dsk2Idx
BCC MLab ;Continue 'til indices cross...
D2Snone LDY #$00
LDX DevCnt ;Now change the device order
:loop LDA DevLst,X ; so that the boot device
PHA
AND #$7F
EOR DevNum ; will have highest priority
ASL
BNE :1
PLA
INY
:1 DEX
BPL :loop
LDX DevCnt ;Now reverse order of search, hi to lo
TYA ;Was boot device found?
BEQ :2 ;No
LDA DevNum ;Make boot device first in search order
STA DevLst,X
DEX
BMI DevSrchEnd ;Branch if only one device
DEY ;Is this a 2-drive device?
BEQ :2 ;No
EOR #$80 ;Make boot device, drive 2 next
STA DevLst,X
DEX
BMI DevSrchEnd ;Branch if only one device, 2 drives
:2 PLA
STA DevLst,X
DEX
BPL :2
DevSrchEnd JSR Fndtrd ;Save accumuated machine ID
BEQ WhosIt
STA MachID
RTS
WhosIt JMP WhatsIt
staDrv ORA devID ;Combine with attributes (0SSS IIII)
LDX DevCnt
INX ;Put device number into device list
STA DevLst,X
ASL ;Now form drive 2 device number, if any (SSSI III0)
RTS
SlotROM BCC IsROM ;Branch if disk drive
LDY #$06 ;Test this slot for clock card
:1 LDA (indrcn),Y
CMP clkID,Y ;Branch if not clock
BNE NotClk
DEY
DEY
BPL :1
LDA indrcn+1 ;transfer high slot addr minus $c1 (default)
SBC #$C1 ; to relocate references to clock ROM
STA clock64
LDA #$4C ;Also enable jump vector in globals
STA DateTime
LDA apple ;Mark clock as present
BEQ DevSrchEnd
ORA #$01
STA apple
BNE IsROM ;Always
NotClk LDY #$05 ;Test for 80-col card
LDA (indrcn),Y ;One byte at a time
CMP #$38
BNE NotCons
LDY #$07 ;Test values are same as Pascal's
LDA (indrcn),Y
CMP #$18
BNE NotCons
LDY #$0B
LDA (indrcn),Y
DEC
BNE NotCons
INY
LDA (indrcn),Y
AND #$F0 ;Mask off low nibble
CMP #$80 ;Generic for 80-col card
BNE NotCons
LDA apple
BEQ DevSrchEnd
ORA #$02
STA apple ;Mark config for 80 col. present
BNE IsROM
NotCons LDX #$00 ;Test for any ROM
LDA (indrcn)
CMP #$FF ;Test for apple /// non slot
BEQ NoROM ;Branch if invalid ROM
TestROM CMP (indrcn) ;Look for floating bus
BNE NoROM
INX ;Loop 256 times
BNE TestROM
IsROM LDA indrcn+1 ;Mark a bit in slot byte
AND #$07 ; to indicate rom present
TAX
LDA SltBit,X
ORA SltByt
STA SltByt
NoROM RTS
*-------------------------------------------------
D2BlkIO DA RWTS ;Addr of Disk ][ driver rtn
diskID EQU *
clkID HEX 082028005803703C
SltBit HEX 0002040810204080
*-------------------------------------------------
* Compute autostart ROM checksum
Fndtrd CLC
LDY SltBit ;Should be zero
:loop LDA (look),Y ;Point to $FB09 ("APPLE II" in ROM)
AND #%11011111 ;To uppercase
ADC SltBit
STA SltBit
ROL SltBit
INY
CPY SltBit+3 ;Do for 8 bytes
BNE :loop
TYA ;(A)=$08 now
ASL
ASL
ASL
ASL
TAY
EOR SltBit ;Turn msb on
ADC #$0B ;Add a fudge factor
BNE :1 ;That's a clone
LDA apple ;Pass the test
RTS
:1 LDA #$00
RTS
*-------------------------------------------------
* Install the appropriate device-driver
* address in the system global page
* (driverAdr)= addr of driver
InstallDev EQU * ;Made a sub and
PHP ; how many drives (carry)
LDA indrcn+1 ;Get index to global device table
AND #$07 ; for this slot
ASL
TAY ; ... into Y-reg
ASL
ASL ;Now form device number
ASL ;(A)=0SSS 0000
JSR staDrv
PLP
ROR ;If 2 drives, then bit7=1 (DSSS IIII)
BPL :1 ;Branch if a 1-drive device (i.e. profile)
INX ; else presume that second drive is present
STA DevLst,X
:1 STX DevCnt ;Save updated device count
ASL ;Shift # of drives back into carry
LDA driverAdr ;Get low address of device driver
STA DevAdr01,Y
BCC :2 ;Branch if single drive
STA DevAdr02,Y
:2 LDA driverAdr+1 ;Get high address of device driver
STA DevAdr01+1,Y
BCC :Ret
STA DevAdr02+1,Y
:Ret RTS
*-------------------------------------------------
*
* This piece of code (not a subroutine) is branched to if the slot
* search code finds a smartport device. It does a smartport status
* call (code = 0) to determine the number of devices connected to
* the "card". It then installs from 0..4 units in the table.
*
SmartPort JSR SetDevID ;Set up the devID byte from attributes
*
* Only map more than two devices if card is in slot 5
*
LDA indrcn+1 ;indrcn+1
STA driverAdr+1 ;Didn't set this yet
* Do the call to smartport to get the number of devices
LDA driverAdr
STA psCall+1 ;Modify operand
CLC
ADC #$03
STA spCall+1
LDA driverAdr+1 ;No page cross possible
STA spCall+2
*********************************************
* patch 74
*********************************************
STA psCall+2 ;Modify operand
ASL ;Convert $Cn to $n0
ASL
ASL
ASL
STA unitNum
STZ dhpCmd ;Force a ProDOS status call
STZ bufPtr ;Dummy pointer
STZ blockNum ;Number of bytes to transfer
STZ blockNum+1 ;Number of bytes to transfer
LDA #$10 ;Dummy pointer should be <>0
STA bufPtr+1 ;Dummy pointer
*********************************************
* patch 74
*********************************************
psCall EQU * ;ProDOS status call
JSR $0000 ;Filled in by above code
LDY #$FB
LDA (indrcn),Y ;SmartPort ID type byte
AND #$02 ;Is it a SCSI card?
BEQ :1 ;No
STA unitNbr ;=2
JSR spCall
DB $00 ; Do status call on SCSI unit
DA spCallParms
* Determine how many devices are connected
* to the interface @ this slot
* Ref SmartPort TN #20, #21
:1 STZ unitNbr ;Get status of the
JSR spCall ; SmartPort host
DB $00
DA spCallParms
* Don't add devices if there are none connected
LDA numDevices ;Get dev cnt
BEQ DoneSP
* Do the first and second device if they exist
CMP #$02 ;C=1 if if 2,3,4
JSR InstallDev
* Do the third and fourth drives if they exist
* They cannot exist for any card other than one in slot 5
LDA indrcn+1
CMP #$C5 ;If not slot 5, no mirroring
BNE DoneSP
********************* see note #65 *********************
*
* If this is slot 5, and if there is a disk card in slot 2,
* only install 2 devices this slot. Thank you.
BIT diskInSlot2 ;If there a disk card in slot 2?
BPL DoneSP ;Yes
LDA numDevices
CMP #$03 ;More than 2 devices in slot 5?
BCC DoneSP ;No (C=1 if 3,4,...)
CMP #$04 ;C=1 if 4,5,6,...(More than 3 devices are connected)
LDA #$C2 ;Make it think it's slot 2
STA indrcn+1
JSR InstallDev
LDA #$C5 ;Reset back to slot 5
STA indrcn+1
DoneSP JMP NxtDsk2 ;We know it's a disk device
* Ref ProDOS Tech Ref (ROM Code conventions)
* pg 7-14 BAP
SetDevID LDY #$FE
SetDevIDZ LDA (indrcn),Y ;Get attribute byte
LSR
LSR
LSR
LSR
STA devID
RTS
************** see note #65 ****************
*
* input: indrcn - point to $Cn00 of mystery card
* output: carry clear if disk card here, set ow
* y $ff
*
CmpID LDA CLRROM ;Release $C800 space from previous slot
LDY #$05
:loop LDA (indrcn),Y ;Compare ID bytes
CMP diskID,Y ;$Cn07=don't care
SEC
BNE :Ret ;($Cn05)=03
DEY ;($Cn03)=00
DEY ;($Cn01)=20
BPL :loop ;Loop until all 4 ID bytes match
CLC
:Ret RTS
*-------------------------------------------------
* SmartPort parameter area
spCallParms DB $03 ;number of parameters
unitNbr DB $00 ;=$00,$01-$7E
DA statusList
DB $00 ;status code = 0 (code for general status)
* Each offsets below can be considered as 000D SSS0
* Offsets for slot 0 dr1/2 & slot 3 dr 2
* are not represented here
* Slot 3 dr 2 is reserved for /RAM
mapOffset EQU *
DB $06 ;slot 3, dr 1
DB $1E ;slot 7, dr 2
DB $0E ;slot 7, dr 1
DB $1C ;slot 6, dr 2
DB $0C ;slot 6, dr 1
DB $1A ;slot 5, dr 2
DB $0A ;slot 5, dr 1
DB $14 ;slot 2, dr 2
DB $04 ;slot 2, dr 1
DB $12 ;slot 1, dr 2
DB $02 ;slot 1, dr 1
DB $18 ;slot 4, dr 2
DB $08 ;slot 4, dr 1
spCall JMP $0000
*-------------------------------------------------
* This routine will scan all slots for SmartPort
* interfaces. If more than 2 block devices are
* connected to the SmartPort Host, it will mirror
* at most 2 more block devices
ScanAll4SP STZ indrcn
LDA #$C7 ;Start w/slot 7
STA indrcn+1
ScanLoop JSR Chk4SP ;Does slot have a SP host?
BCS ChkNxtSlot ;No
LDY #$FF
LDA (indrcn),Y ;Get LSB of block dev driver
CLC
ADC #$03 ;Add 3 to get the
STA spCall+1 ; SmartPort entry point
LDA indrcn+1
STA spCall+2
DEY ;=$FE
JSR SetDevIDZ ;Get attributes
STZ unitNbr ;Get status of SmartPort Host
JSR spCall
DB $00
DA spCallParms
LDA numDevices
CMP #$03 ;More than 2 devices?
BCC ChkNxtSlot ;No
INC ;1 more for easier comparision
STA maxUnitP1 ;=4,5,6,...
LDA #$03
LDX spCall+2
CPX #$C5 ;Slot 5?
BNE ChkDevLoop ;No
BIT diskInSlot2 ;If there a disk card in slot 2?
BPL ChkDevLoop ;Yes
* Slot 5 and no disk card in slot 2.
* 4 of the devices connected to this
* slot had already been dealt with.
LDA #$05
ChkDevLoop CMP maxUnitP1
BCS ChkNxtSlot
STA unitNbr ;Get device status of this unit
JSR spCall ;Ref pg 122 IIGS Firmware
DB $00
DA spCallParms
LDA spDevStatus ;Is it block dev?
BMI MirrorDev ;Yes
* No, it's a char dev
CkNxtChnDev LDA unitNbr
INC
BRA ChkDevLoop ;Loop to check next dev in chain
ChkNxtSlot DEC indrcn+1 ;Set up for next lower slot
LDA indrcn+1
CMP #$C0 ;Have all slots been checked?
BNE ScanLoop ;No
RTS
*-------------------------------------------------
* We have more than 2 devices connected to
* the SmartPort Host in this slot
MirrorDev LDX #12 ;Search thru 13 entries
MirrorLoop LDY mapOffset,X ;Get offset
LDA DevAdr01,Y ;Check if there is an
CMP #<gNoDev ; unassigned entry in table
BNE NoMapping ;No, already filled
LDA DevAdr01+1,Y
CMP #>gNoDev
BEQ MapDevice ;Got an available entry
NoMapping DEX
BPL MirrorLoop
RTS
*-------------------------------------------------
* Install SmartPort driver for additional
* block devices connected to slot
MapDevice LDA indrcn+1 ;Save slot #
PHA
PHX
PHY
TYA
LSR ;0000 DSSS
AND #$07 ;0000 0SSS
ORA #$C0
STA indrcn+1 ;Chk if there is a SmartPort
JSR Chk4SP ; Host in this slot
PLY
PLX
PLA
STA indrcn+1
BCC NoMapping ;Yes, don't mirror the dev
JSR LC1In ;Switch in LC bank 1
TYA ;000D SSS0
LSR
TAX ;0000 DSSS ($01-$0F; $00,$08,$0B-invalid)
LDA unitNbr
STA spUnits-1,X
LDA spCall+1 ;Save actual SmartPort driver
STA spDrvAdrL-1,X
LDA spCall+2
STA spDrvAdrH-1,X
LDA RDROM2
INC DevCnt
LDX DevCnt
TYA
LSR ;0000 DSSS
CMP #$08
BCC :1 ;Drive 1
SBC #$08
ORA #$08 ;Add back drive 2 bit
:1 ASL
ASL
ASL
ASL
ORA devID ;DSSS IIII
STA DevLst,X
LDA #<MirrorDevEntry;Install driver that
STA DevAdr01,Y ; handles the mirrored devices
LDA #>MirrorDevEntry
STA DevAdr01+1,Y
BRA CkNxtChnDev
*-------------------------------------------------
* Exit
* C=0 if there is a SmartPort card/interface
* in the slot
Chk4SP JSR CmpID
BCS :Rtn ;No disk card in this slot
SEC
LDY #$07 ;Is this the SmartPort
LDA (indrcn),Y ; signature byte?
BNE :Rtn ;No
CLC
:Rtn RTS

321
MLI.SRC/EQUATES.S Normal file
View File

@ -0,0 +1,321 @@
*-------------------------------------------------
* Disassembler: The Flaming Bird Disassembler
* Assembler : Merlin16+
* Merlin16+ is chosen because it can assemble
* 65816 opcodes unlike EdAsm (ProDOS) which is
* an 8-bit assembler. Furthermore, local labels
* may be used; that should ease the need to
* create trivial labels.
* NB. Merlin16+ defaults to case-sensitive labels
* & using blank lines should improve readibility.
* Most of the comments and labels are from the
* source code of ProDOS v1.7
* Whenever possible a more descriptive label is
* used in place of the original.
*-------------------------------------------------
* Global Equates
MSLOT EQU $07F8
KBD EQU $C000
CLR80COL EQU $C000 ;Disable 80-column memory mapping (Write)
SET80COL EQU $C001 ;Enable 80-column memory mapping (WR-only)
RDMAINRAM EQU $C002
RDCARDRAM EQU $C003
WRMAINRAM EQU $C004 ;Write data to main ram
WRCARDRAM EQU $C005 ;Write data to card ram
SETSTDZP EQU $C008 ;Enable regular ZP,STK,LC
SETALTZP EQU $C009 ;Enable alternate ZP,STK,LC
SETINTC3ROM EQU $C00A ;Internal 80-col card ROM
SETSLOTC3ROM EQU $C00B ;External slot 3 ROM
CLR80VID EQU $C00C ;Disable 80 column hardware.
CLRALTCHAR EQU $C00E ;Switch in primary character set.
KBDSTROBE EQU $C010
RD80COL EQU $C018
NEWVIDEO EQU $C029
SPKR EQU $C030
TXTSET EQU $C051
TXTPAGE1 EQU $C054
TXTPAGE2 EQU $C055
STATEREG EQU $C068 ;Cortland memory state register
ROMIN2 EQU $C081 ;swap rom in w/o w-prot ram
RDROM2 EQU $C082 ;swap rom in, write protect ram
LCBANK2 EQU $C083 ;Enable 2nd bank of LC
LCBANK1 EQU $C08B ;Enable 1st bank of LC
CLRROM EQU $CFFF
* 80 col card subroutines
AuxMove EQU $C311 ;monitor move data routine
Xfer EQU $C314 ;monitor XFER control
* Apple // Monitor subroutines
ROMIrq EQU $FA41 ;monitor rom irq entry
Init EQU $FB2F ;Text pg1;text mode;sets 40/80 col
SETTXT EQU $FB39
TABV EQU $FB5B
SETPWRC EQU $FB6F
VERSION EQU $FBB3
BELL1 EQU $FBDD
HOME EQU $FC58
CLREOL EQU $FC9C
RDKEY EQU $FD0C
CROUT EQU $FD8E
COUT EQU $FDED
IDroutine EQU $FE1F ;IIgs ID routine
SetInv EQU $FE80
SetNorm EQU $FE84 ;Normal white text on black backround.
SetKBD EQU $FE89 ;Does an IN#1.
SetVid EQU $FE93 ;Puts COUT1 in CSW.
BELL EQU $FF3A
OLDRST EQU $FF59 ;monitor reset entry
* GS/OS vectors/flags
GSOS EQU $E100A8
GSOS2 EQU $E100B0
OS_BOOT EQU $E100BD
inBuf EQU $0200 ;Input buffer
pnBuf EQU $0280 ;pathname buffer
EnterCard EQU $0200 ;AuxMem
RAMdest EQU $0200 ;AuxMem
RAMsrc EQU $5100 ;Load addr
LCdest EQU $FF00 ;Execution addr of RAM disk handler
* Page 3 vectors
SOFTEV EQU $03F2
PWREDUP EQU $03F4
NMI EQU $03FB
PassIt EQU $03ED
* load addr exec addr Description
*=========================================================================================
MLI_0 EQU $2000 ;$2000-$2c7F $2000-$2c7F MLI loader/relocater
RAM_1 EQU MLI_0+$C80 ;$2c80-$2cff $2c80-$2cbc installer for /RAM
RAM_2 EQU RAM_1+$080 ;$2d00-$2d8f $ff00-$ff8f /RAM driver in main lc
MLI_3 EQU RAM_2+$09B ;$2d9b-$2dff $ff9b-$ffff interrupts
MLI_1 EQU MLI_3+$065 ;$2E00-$2eff $bf00-bfff global page
TCLOCK_0 EQU MLI_1+$100 ;$2f00-$2f7f $d742-$d7be TCLOCK driver
CCLOCK_0 EQU TCLOCK_0+$080 ;$2f80-$2fff $d742-$d7be CCLOCK driver
MLI_2 EQU CCLOCK_0+$080 ;$3000-$4fff $de00-$feff MLI itself
RAM_0 EQU MLI_2+$2100 ;$5100-$52ff $0200-$03ff /RAM driver in aux mem
XRW_0 EQU RAM_0+$200 ;$5300-$59FF $d000-$d6ff disk core routines
SEL_0 EQU XRW_0+$700 ;$5A00-$5cff $1000-$12ff original dispatcher
SEL_1 EQU SEL_0+$300 ;$5d00-$5fff $1000-$12ff better bye dispatcher
SEL_2 EQU SEL_1+$300 ;$6000-$2c7F $1000-$12ff gs/os dispatcher
* ProDOS 8 equates
ABuf EQU $0C00 ;Temporary buffer
VBlock1 EQU $0E00 ;Where the Vol Dir goes
VolNameStr EQU $0F00 ;Use by SEL2 (p-string)
DispAdr EQU $1000 ;Execution address of dispatcher
RWTS EQU $D000 ;Addr of Disk ][ driver
IOBuf EQU $1C00
Srce EQU $2C80
LCSrc EQU Srce+$80
LCDest EQU $FF00
ClockBegin EQU $D742 ;Entry address of clock
LoadIntrp EQU $0800 ;Execution addr of load interpreter
orig EQU $D700
orig1 EQU $DE00
Globals EQU $BF00 ;ProDOS's global page
IntHandler EQU $FF9B ;Start of interrupt handler
pathBuf EQU orig
fcb EQU orig+$100 ;File Control Blocks
vcb EQU orig+$200 ;Volume Control Blocks
bmBuf EQU orig+$300 ;Bitmap buffer
genBuf EQU pathBuf+$500 ;General purpose buffer
*
* Constants
*
preTime EQU $20 ;command needs current date/time stamp
preRef EQU $40 ;command requires fcb address and verification
prePath EQU $80 ;command has pathname to preprocess
*
* volume status constants (bits)
*
* file status constants
*
dataAloc EQU $1 ;data block not allocated.
idxAloc EQU $2 ;index not allocated
topAloc EQU $4 ;top index not allocated
storTypMod EQU $8 ;storage type modified
useMod EQU $10 ;file usage modified
eofMod EQU $20 ;end of file modified
dataMod EQU $40 ;data block modified
idxMod EQU $80 ;index block modified
fcbMod EQU $80 ;has fcb/directory been modified? (flush)
*
* header index constants
*
hNamLen EQU $0 ;header name length (offset into header)
hName EQU $1 ;header name
hPassEnable EQU $10 ;password enable byte
hPassWord EQU $11 ;encoded password
hCreDate EQU $18 ;header creation date
* hCreTime EQU $1A ;header creation time
hVer EQU $1C ;sos version that created directory
hComp EQU $1D ;backward compatible with sos version
hAttr EQU $1E ;header attributes- protect etc.
hEntLen EQU $1F ;length of each entry
hMaxEnt EQU $20 ;maximum number of entries/block
hFileCnt EQU $21 ;current number of files in directory
hOwnerBlk EQU $23 ;owner's directory disk address
hOwnerEnt EQU $25 ;owner's directory entry number
hOwnerLen EQU $26 ;owner's directory entry length
vBitMap EQU hOwnerBlk
vTotBlk EQU hOwnerEnt ;(used for root directory only)
*
* Volume Control Block index constants
*
vcbSize EQU $20 ;Current VCB is 32 bytes per entry (ver 0)
vcbNamLen EQU 0 ;Volume name length byte
vcbName EQU 1 ;Volume name
vcbDevice EQU $10 ;Volume's device #
vcbStatus EQU $11 ;Volume status. (80=files open. 40=disk switched.)
vcbTotBlks EQU $12 ;Total blocks on this volume
vcbFreeBlks EQU $14 ;Number of unused blocks
vcbRoot EQU $16 ;Root directory (disk) address
*vcbBitMapOrg EQU $18 ;map organization (not supported by v 0)
*vcbBitMapBuf EQU $19 ;bit map buf num
vcbBitMap EQU $1A ;First (disk) address of bitmap(s)
vcbCurrBitMap EQU $1C ;Rel addr of bitmap w/space (add to vcbBitMap)
*vcbmnum EQU $1D ; relative bit map currently in memory
vcbOpenCnt EQU $1E ;Current number of open files.
*vcbaddr EQU $1F reserved
*
* File Control Block index constants
*
fcbSize EQU $20 ;Current FCB is 32 bytes per entry (ver 0)
fcbRefNum EQU 0 ;file reference number (position sensitive)
fcbDevNum EQU 1 ;device (number) on which file resides
*fcbHead EQU 2 ;block address of file's directory header
*fcbDirBlk EQU 4 ;block address of file's directory
fcbEntNum EQU 6 ;file entry number within dir block
fcbStorTyp EQU 7 ;storage type - seed, sapling, tree, etc.
fcbStatus EQU 8 ;status - index/data/eof/usage/type modified.
fcbAttr EQU 9 ;attributes - read/write enable, newline enable.
fcbNewLin EQU $A ;new line terminator (all 8 bits significant).
fcbFileBuf EQU $B ;buffer number
fcbFirst EQU $C ;first block of file (Master index/key blk)
fcbIdxBlk EQU $E ;curr block address of index (0 if no index)
fcbDataBlk EQU $10 ;curr block address of data
fcbMark EQU $12 ;current file marker.
fcbEOF EQU $15 ;logical end of file.
fcbBlksUsed EQU $18 ;actual number of blocks allocated to this file.
*fcbAddr EQU $1a reserved
fcbLevel EQU $1B ;level at which this file was opened
fcbDirty EQU $1C ;fcb marked as modified
fcbNLMask EQU $1F ;NewLine enabled mask
*
* zero page stuff
*
look EQU $0A
apple EQU $0C
relocTbl EQU $10
idxl EQU $10
indrcn EQU $10
devID EQU $12
src EQU $12
dst EQU $14
cnt EQU $16
code EQU $18
endCode EQU $1A
WNDLFT EQU $20
WNDWDTH EQU $21
WNDTOP EQU $22
WNDBTM EQU $23
CH EQU $24
CV EQU $25
INVFLG EQU $32
A1 EQU $3C ;SOURCE OF TRANSFER
A2 EQU $3E ;END OF SOURCE
A3 EQU $40
A4 EQU $42 ;DESTINATION OF TRANSFER
Acc EQU $45
ErrNum EQU $DE
OURCH EQU $057B ;80-col horizontal coord
* ProDOS block I/O equates
statCmd EQU $00 ;request status, no error=ready
rdCmd EQU $1
wrtCmd EQU $2
DUM $40
parm DS 2,0
device DS 1,0 ;parm+2
dhpCmd EQU device ;Command from ProDOS8
unitNum DS 1,0 ;Unit # from ProDOS 8 (DSSS 0000)
bufPtr DS 2,0 ;512-byte user's I/O buffer
blockNum DS 2,0 ;block # requested
DEND
*
intCmd EQU dhpCmd ;Interrupt command
*
DUM parm+8
zTemps DS 2,0
tPath EQU zTemps
dirBufPtr EQU zTemps
tIndex EQU zTemps ;Ptr to index blk buffer
dataPtr DS 2,0 ;Ptr to data blk buffer
posPtr DS 2,0 ;Position marker
userBuf DS 2,0 ;Ptr to user's buffer
DEND
*
* xdos parameters:
*
c_pCnt EQU $0 ; (count)
c_devNum EQU $1 ; (value)
c_refNum EQU $1 ; (value)
c_intNum EQU $1 ; (value)
c_path EQU $1 ;&2 (pointer)
c_isNewln EQU $2 ; (mask)
c_dataBuf EQU $2 ;&3 (value)
c_bufAdr EQU $2 ;&3 (address)
c_intAdr EQU $2 ;&3 (address)
c_mark EQU $2 ;->4 (value)
c_eof EQU $2 ;->4 (value)
c_attr EQU $3 ; (flags)
c_newl EQU $3 ; (character)
c_bufPtr EQU $3 ;&4 (pointer)
c_newPath EQU $3 ;&4 (pointer)
c_fileID EQU $4 ; (value)
c_reqCnt EQU $4 ;&5 (value)
c_blkNum EQU $4 ;&5 (address)
c_outRef EQU $5
c_auxID EQU $5 ;&6 (value)
c_xferCnt EQU $6 ;&7 (value)
c_fileKind EQU $7 ; (value)
c_date EQU $8 ;&9 (value)
c_outBlk EQU $8 ;&9 (count)
c_time EQU $a ;&b (value)
c_modDate EQU $a ;&b (value)
c_modTime EQU $c ;&d (value)
c_creDate EQU $e ;&f (value)
c_creTime EQU $10 ;&11 (value)
* Starting addresses of screen lines
SLIN04 EQU $0600 ;4th line of screen (starting from 0)
SLIN09 EQU $04A8
SLIN10 EQU $0528
SLIN11 EQU $05A8
SLIN12 EQU $0628
SLIN13 EQU $06A8
SLIN15 EQU $07A8
SLIN22 EQU $0750
SLIN23 EQU $07D0
* Error Codes specific to ProDOS 8
* Other error codes are in the GS/OS equate file
unclaimedIntErr EQU $01
vcbUnusable EQU $0A
fcbUnusable EQU $0B
badBlockErr EQU $0C ;Block allocated illegally
fcbFullErr EQU $42
vcbFullErr EQU $55
badBufErr EQU $56

237
MLI.SRC/FNDFIL.S Normal file
View File

@ -0,0 +1,237 @@
**************************************************
* Get File entry
FindFile JSR LookFile ;See if file exists
BCS NoFind ;Branch if an error was encountered
MovEntry LDY h_entLen ;Move entire entry info
:loop LDA (dirBufPtr),Y
STA d_file+d_stor,Y ; to a safe area
DEY
BPL :loop
LDA #$00 ;To indicate all is well
NoFind RTS ;Return condition codes
*-------------------------------------------------
* Follow path to a file
LookFile JSR PrepRoot ;Find volume and set up other boring stuff
BCS FndErr ;Pass back any error encountered
BNE LookFile0 ;Branch if more than root
LDA #>genBuf ;Otherwise, report a badpath error
STA dirBufPtr+1 ;(but first create a phantom entry for open)
LDA #<genBuf+4 ;Skip 4-byte blk link ptrs
STA dirBufPtr
LDY #d_auxID ;First move in id, and date stuff
:loop1 LDA (dirBufPtr),Y
STA d_file,Y
DEY
CPY #d_creDate-1
BNE :loop1
:loop2 LDA rootStuff-d_fileID,Y
STA d_file,Y
DEY
CPY #d_fileID-1
BNE :loop2
LDA #directoryFile*16;Fake directory file
STA d_file+d_stor
LDA genBuf+2 ;A forward link?
ORA genBuf+3
BNE :1 ;Yes
LDA #$02
STA d_file+d_eof+1
LDA #$01 ;Allocate 1 blk
STA d_file+d_usage
:1 LDA #badPathSyntax
RTS
* Scan subdir for file
LookFile0 STZ noFree ;Reset free entry indicator
SEC ;Indicate that dir to be searched has header in this blk
ScanDirLoop STZ totEnt ;reset entry counter
JSR LookName ;Look for name pointed to by pnPtr
BCC NameFound ;Branch if name was found
LDA entCnt ;Have we looked at all of the
SBC totEnt ; entries in this directory?
BCC :11 ;Maybe, check hi count
BNE LookFile2 ;No, read next directory block
CMP entCnt+1 ;Has the last entry been looked at (A=0)
BEQ ErrFNF ;Yes, give 'file not found' error
BNE LookFile2 ;Branch always
:11 DEC entCnt+1 ;Should be at least 1
BPL LookFile2 ;(this should be branch always...)
ErrDir LDA #dirError ;Report directory messed up
FndErr SEC
RTS
LookFile2 STA entCnt ;Keep running count
LDA #>genBuf ;Reset indirect pointer
STA dirBufPtr+1
LDA genBuf+2 ;Get link to next directory block
BNE NxtDir0 ;(if there is one)
CMP genBuf+3 ;Are both zero, i.e. no link?
BEQ ErrDir ;If so, then not all entries were accounted for
NxtDir0 LDX genBuf+3 ;A has value for block # (low)
JSR RdBlkAX ;Go read the next linked directory in
BCC ScanDirLoop ;Branch if no error
RTS ;Return error (in A)
* No more file entries
ErrFNF LDA noFree ;Was any free entry found?
BNE FNF0
LDA genBuf+2 ;Test link
BNE TellFree
CMP genBuf+3 ;If both are zero, then give up
BEQ FNF0 ; simply report 'not found'
TellFree STA d_entBlk
LDA genBuf+3
STA d_entBlk+1 ;Assume first entry of next block
LDA #$01 ; is free for use
STA d_entNum
STA noFree ;Mark d_entNum as valid (for create)
FNF0 JSR NxtPNameZ ;Test for 'file not found' versus 'path not found'
ErrPath1 SEC ;If non-zero then 'path not found'
BEQ :21
LDA #pathNotFound ;Report no such path
RTS
:21 LDA #fileNotFound ;Report file not found
RTS
* File entry found
NameFound JSR NxtPName ;Adjust index to next name in path
BEQ FileFound ;Branch if that was last name
LDY #d_stor ;Be sure this is a directory entry
LDA (dirBufPtr),Y ;High nibble will tell
AND #$F0
CMP #directoryFile*16;Is it a sub-directory?
BNE ErrPath1 ;Report the user's mistake
LDY #d_first ;Get address of first sub-directory block
LDA (dirBufPtr),Y
STA blockNum ;(no checking is done here for a valid
INY ; block number... )
STA d_head ;Save as file's header block too
LDA (dirBufPtr),Y
STA blockNum+1
STA d_head+1
JSR RdGBuf ;Read sub-directory into gbuf
BCS FndErr1 ;Return immediately any error encountered
LDA genBuf+4+hFileCnt;Get the number of files
STA entCnt ; contained in this directory
LDA genBuf+4+hFileCnt+1
STA entCnt+1
LDA genBuf+4+hPassEnable;Make sure password disabled
LDX #$00
SEC
ROL
TestPass0 BCC :1
INX
:1 ASL
BNE TestPass0
CPX #$05 ;Is password disabled?
BEQ MovHead
LDA #badFileFormat ;Tell them this directory is not compatible
FndErr1 SEC
RTS
MovHead JSR MoveHeadZ ;Move info about this directory
JMP LookFile0 ;Do next local pathname
*-------------------------------------------------
* Copy directory (vol/sub) header
MoveHeadZ LDX #$0A ;move info about this directory
:loop1 LDA genBuf+4+hCreDate,X
STA h_creDate,X
DEX
BPL :loop1
LDA genBuf+4 ;If this is root, then nothing to do
AND #$F0
EOR #$F0 ;Test header type
BEQ :11 ;Branch if root
LDX #$03 ;Otherwise, save owner info about this header
:loop2 LDA genBuf+4+hOwnerBlk,X
STA ownersBlock,X
DEX
BPL :loop2
:11 RTS
*-------------------------------------------------
* Save dir entry # & block
FileFound EQU *
EntAdr LDA h_maxEnt ;Figure out which is entry number this is
SEC
SBC cntEnt ;max entries - count entries + 1 = entry number
ADC #$00 ;(carry is/was set)
STA d_entNum
LDA blockNum
STA d_entBlk
LDA blockNum+1 ; & indicate blk # of this dir
STA d_entBlk+1
CLC
RTS
*-------------------------------------------------
* Search one dir block for file
LookName LDA h_maxEnt ;reset count of files per block
STA cntEnt
LDA #>genBuf
STA dirBufPtr+1
LDA #$04
LookName1 STA dirBufPtr ;Reset indirect pointer to genBuf
BCS LookName2 ;Branch if this block contains a header
LDY #$00
LDA (dirBufPtr),Y ;Get length of name in dir
BNE IsName ;Branch if there is a name
LDA noFree ;Test to see if a free entry has been declared
BNE LookName2 ;Yes bump to next entry
JSR EntAdr ;Set address for current entry
INC noFree ;Indicate a free spot has been found
BNE LookName2 ;Branch always
IsName AND #$0F ;Strip type (this is checked by 'FileFound')
INC totEnt ;(bump count of valid files found)
STA namCnt ;Save name length as counter
LDX pnPtr ;Get index to current path
CMP pathBuf,X ;Are both names of the same length?
BNE LookName2 ;No, bump to next entry
CmpNames INX ;(first) next letter index
INY
LDA (dirBufPtr),Y ;Compare names letter by letter
CMP pathBuf,X
BNE LookName2
DEC namCnt ;Have all letters been compared?
BNE CmpNames ;No, continue..
CLC ;By golly, we got us a match!
NoName RTS
LookName2 DEC cntEnt ;Have we checked all possible entries in this blk?
SEC
BEQ NoName ;Yes, give up
LDA h_entLen ;Add entry length to current pointer
CLC
ADC dirBufPtr
BCC LookName1 ;Branch if we're still in the first page
INC dirBufPtr+1 ;Look on second page
CLC ;Carry should always be clear before looking at next
BCC LookName1 ;Branch always...

200
MLI.SRC/GLOBALS.S Normal file
View File

@ -0,0 +1,200 @@
TTL 'Global pages - 64K'
ORG Globals
**************************************************
GoPro JMP mliEnt1 ;MLI call entry point
************ see rev note #36 ********************
* Jump vector to cold start/selector program, etc. Will
* be changed to point to dispatcher caller by the loader
jSpare JMP jSpare
*-------------------------------------------------
DateTime DB $60 ;Changed to $4C (JMP) if clock present
DA ClockBegin ;Clock routine entry address
SysErr JMP SysErr1 ;Error reporting hook
SysDeath JMP SysDeath1 ;System failure hook
SErr DB $00 ;Error code, 0=no error
*-------------------------------------------------
DevAdr01 EQU *
DA gNoDev ;slot zero reserved
DA gNoDev ;slot 1, drive 1
DA gNoDev ;slot 2, drive 1
DA gNoDev ;slot 3, drive 1
DA gNoDev ;slot 4, drive 1
DA gNoDev ;slot 5, drive 1
DA gNoDev ;slot 6, drive 1
DA gNoDev ;slot 7, drive 1
DevAdr02 DA gNoDev ;slot zero reserved
DA gNoDev ;slot 1, drive 2
DA gNoDev ;slot 2, drive 2
DevAdr32 DA gNoDev ;slot 3, drive 2
DA gNoDev ;slot 4, drive 2
DA gNoDev ;slot 5, drive 2
DA gNoDev ;slot 6, drive 2
DA gNoDev ;slot 7, drive 2
*-------------------------------------------------
* Configured device list by device number
* Access order is last in list first.
DevNum DB $00 ;Most recently accessed device
DevCnt DB $FF ;Number of on-line devices (minus 1)
DevLst HEX 0000000000 ;Up to 14 units may be active
HEX 0000000000
HEX 00000000
DB 0 ;Unused?
ASC '(C)APPLE ' ; AppleTALK writes over this area! DO NOT MOVE!
*-------------------------------------------------
mliEnt1 PHP
SEI ;Disable interrupts
JMP mliCont
aftIrq STA LCBANK1
JMP fix45 ;Restore $45 after interrupt in lang card*
old45 DB $00
afBank DB $00
*-------------------------------------------------
* Memory map of the lower 48K. Each bit represents one page
* (256 bytes) of memory. Protected areas are marked with a
* 1, unprotected with a 0. ProDOS dis-allows reading or
* buffer allocation in protected areas.
memTabl HEX C000000000000000
HEX 0000000000000000
HEX 0000000000000001
* The addresses contained in this table are buffer addresses
* for currently open files. These are informational only,
* and should not be changed by the user except through the
* MLI call setbuf.
GblBuf DA $0000 ;file number 1
DA $0000 ;file number 2
DA $0000 ;file number 3
DA $0000 ;file number 4
DA $0000 ;file number 5
DA $0000 ;file number 6
DA $0000 ;file number 7
DA $0000 ;file number 8
*-------------------------------------------------
* Interrupt vectors are stored here. Again, this area is
* informational only, and should be changed only by calls
* to the MLI to allocate_interrupt. Values of the A, X, Y,
* stack, and status registers at the time of the most recent
* interrupt are also stored here. In addition, the address
* interrupted is also preserved. These may be used for
* performance studies and debugging, but should not be changed
* by the user.
Intrup1 DA $0000 ;interupt routine 1
Intrup2 DA $0000 ;interupt routine 2
Intrup3 DA $0000 ;interupt routine 3
Intrup4 DA $0000 ;interupt routine 4
IntAReg DB $00 ;A-register
IntXReg DB $00 ;X-register
IntYReg DB $00 ;Y-register
IntSReg DB $00 ;Stack register
IntPReg DB $00 ;Status register
IntBankID DB $01 ;ROM, RAM1, or RAM2 ($D000 in LC)
IntAddr DA $0000 ;program counter return addr
*-------------------------------------------------
* The user may change the following options
* prior to calls to the MLI.
DateLo DW $0000 ;bits 15-9=yr, 8-5=mo, 4-0=day
TimeLo DW $0000 ;bits 12-8=hr, 5-0=min; low-hi format
Level DB $00 ;File level: used in open, flush, close
BUBit DB $00 ;Backup bit disable, setfileinfo only
Spare1 DB $00 ; Used to save A reg
NewPfxPtr DB $00 ;Used as AppleTalk alternate prefix ptr
* The following are informational only. MachID identifies
* the system attributes:
* (bit 3 off) bits 7,6- 00=ii 01=ii+ 10=iie 11=/// emulation
* (bit 3 on) bits 7,6- 00=na 01=na 10=//c 11=na
* bits 5,4- 00=na 01=48k 10=64k 11=128k
* bit 3 modifier for machid bits 7,6.
* bit 2 reserved for future definition.
* bit 1=1- 80 column card
* bit 0=1- recognizable clock card
*
* SltByt indicates which slots are determined to have ROMs.
* PfixPtr indicates an active prefix if it is non-zero.
* mliActv indicates an mli call in progress if it is non-zero.
* CmdAdr is the address of the last mli call's parameter list.
* SaveX and SaveY are the values of x and y when the MLI
* was last called.
MachID DB $00 ;Machine identification
SltByt DB $00 ;'1' bits indicate rom in slot(bit#)
PfixPtr DB $00 ;If = 0, no prefix active...
mliActv DB $00 ;If <> 0, MLI call in progress
CmdAdr DA $0000 ;Return address of last call to MLI
SaveX DB $00 ;X-reg on entry to MLI
SaveY DB $00 ;Y-reg on entry to MLI
*-------------------------------------------------
* The following space is reserved for language card bank
* switching routines. All routines and addresses are
* subject to change at any time without notice and will,
* in fact, vary with system configuration.
* The routines presented here are for 64K systems only.
Exit EOR $E000 ;Test for ROM enable
BEQ Exit1 ;Branch if RAM enabled
STA RDROM2 ;else enable ROM and return
BNE Exit2 ;Branch always
Exit1 LDA BnkByt2 ;For alternate RAM enable
EOR $D000 ; (mod by mliEnt1)
BEQ Exit2 ;Branch if not alternate RAM
LDA LCBANK2 ;else enable alt $D000
Exit2 PLA ;Restore return code
RTI ;Re-enable interrupts and return
mliCont SEC
ROR mliActv ;Indicate to interrupt routines MLI active
rpmCont LDA $E000 ;Preserve language card / ROM
STA BnkByt1 ; orientation for proper
LDA $D000 ; restoration when MLI exits...
STA BnkByt2
LDA LCBANK1 ;Now force ram card on
LDA LCBANK1 ; with RAM write allowed
JMP EntryMLI
irqXit LDA IntBankID ;Determine state of RAM card
IrqXit0 BEQ IrqXit2 ; if any. Branch if enabled
BMI IrqXit1 ;Branch if alternate $D000 enabled
LSR ;Determine if no RAM card present
BCC ROMXit ;Branch if ROM only system
LDA ROMIN2 ;else enable ROM first
BCS ROMXit ;Branch always taken...
IrqXit1 LDA LCBANK2 ;Enable alternate $D000
IrqXit2 LDA #$01 ;Preset bankid for ROM
STA IntBankID ;(reset if RAM card interupt)
ROMXit LDA IntAReg ;Restore accumulator...
RTI ; and exit!
IrqEnt BIT LCBANK1 ;This entry only used when ROM
BIT LCBANK1 ; was enabled at time of interupt
JMP IrqRecev ; A-reg is stored at $45 in zpage
*-------------------------------------------------
BnkByt1 DB $00
BnkByt2 DB $00
DS $BFFA-*,0 ; pad
DB $04 ;Referenced by GS/OS
DB $00
iBakVer DB $00 ;Reserved
iVersion DB $00 ;Version # of currently running interpreter
kBakVer DB $00 ;Undefined: reserved for future use
kVersion DB $23 ;Represents release 2.03

298
MLI.SRC/MEMMGR.S Normal file
View File

@ -0,0 +1,298 @@
**************************************************
* Allocate I/O buf
AllocBuf LDY #c_bufPtr+1 ;Index to user specified buffer
AllocBufZ LDA (parm),Y ;This buffer must be on a page boundary
TAX ;Save in X-reg for validation
CMP #$08
BCC BadBufr ;Cannot be lower than video!
CMP #$BC ;Nor greater than $BB00
BCS BadBufr ; since it would wipe out globals...
STA dataPtr+1
DEY
LDA (parm),Y ;Low addr should be zero!
STA dataPtr
BNE BadBufr ;Branch if it isn't
INX ;Add 4 pages for 1K buffer
INX
INX
INX
:loop1 DEX ;Test for conflicts
JSR CalcMemBit ;Test for free buffer space
AND memTabl,Y ;Report memory conflict
BNE BadBufr ; if any...
CPX dataPtr+1 ;Test all four pages
BNE :loop1
INX ;Add 4 pages again for allocation
INX
INX
INX
:loop2 DEX ;Set proper bits to 1
JSR CalcMemBit
ORA memTabl,Y ; to mark it's allocation
STA memTabl,Y
CPX dataPtr+1 ;Set all four pages
BNE :loop2
LDY fcbPtr ;Now calculate buffer number
LDA fcb+fcbRefNum,Y
ASL ;buffer number=(entnum)*2
STA fcb+fcbFileBuf,Y;Save it in FCB
TAX ;Use entnum*2 as index to global buffer addr tables
LDA dataPtr+1 ;Get addr already validated as good
STA GblBuf-1,X ;Store hi addr (entnums start at 1, not zero)
CLC
RTS ;All done allocating buffers
BadBufr LDA #badBufErr ;Tell user buf is in use or not legal otherwise
SEC ;Indicate error
RTS
**************************************************
* Locate ptr to I/O buf in global page
GetBufAdr TAX ;Index into global buffer table
LDA GblBuf-2,X ;Low buffer addr
STA bufAddrL
LDA GblBuf-1,X ;and high addr
STA bufAddrH
RTS
**************************************************
* Free I/O buf
ReleaseBuf JSR GetBufAdr ;Preserve buf adr in 'bufAddr'
TAY ;Returns high buffer addr in A
BEQ RelBufX ;Branch if unallocated buffer space
STZ GblBuf-1,X ;Take address out of buffer list
STZ GblBuf-2,X ;(X was set up by GetBufAdr)
FreeBuf LDX bufAddrH ;Get hi addr of buffer again
INX ;Add 4 pages to account for 1k space
INX
INX
INX
:loop DEX ;Drop to next lower page
JSR CalcMemBit ;Get bit and posn to memTabl of this page
EOR #$FF ;Invert mask
AND memTabl,Y ;Mark addr as free space now
STA memTabl,Y
CPX bufAddrH ;All pages freed yet?
BNE :loop ;Branch if not
RelBufX CLC ;Indicate no error
RTS
**************************************************
* Calculate memory allocation bit position
* entry: (X)=hi addr of buffer, low addr assumed zero.
*
* exit: (A)=allocation bit mask, (X)=unchanged,
* (Y)=pointer to memTabl byte
CalcMemBit TXA ;Move page address to A
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 ;Get page address again
LSR
LSR ;Now determine 2K set
LSR
TAY ;Return it in Y
PLA ;Restore bit mask
RTS ;Return bit position in A&Y, ptr to memtabl in X
**************************************************
* Check buffer validity
ValDBuf LDA userBuf+1 ;Get high addr of user's buffer
CMP #$02 ;Must be greater than page 2
BCC BadBufr ;Report bad buffer
LDX cBytes+1
LDA cBytes ;Get cbytes-1 value
SBC #$01 ;(carry is set)
BCS :1
DEX
:1 CLC
ADC userBuf ;Calculate end of request addr
TXA ;Do hi addr
ADC userBuf+1 ;All we care about is final addr
TAX ;Must be less than $BF (globals)
CPX #$BF
BCS BadBufr
INX ;Loop thru all affected pages
ValDBufZ DEX ;Check next lower page
JSR CalcMemBit
AND memTabl,Y ;If zero then no conflict
BNE BadBufr ;Branch if conflict...
CPX userBuf+1 ;Was that the last (lowest) page?
BNE ValDBufZ ;Branch if not
CLC ;Indicate all pages ok
RTS ;All done here
**************************************************
* GETBUF Call
GetBuf LDY #c_bufAdr ;Give user address of file buffer
LDA bufAddrL ; referenced by refnum
STA (parm),Y
INY
LDA bufAddrH
STA (parm),Y ;No errors possible if this rtn is called
CLC
RTS
**************************************************
* SETBUF Call
SetBuf LDY #c_bufAdr+1
JSR AllocBufZ ;Allocate new buffer address over old one
BCS SetBufErr ;Report any conflicts immediately
LDA bufAddrH
STA userBuf+1
LDA bufAddrL
STA userBuf
JSR FreeBuf ;Now free address space of old buffer
LDY #$00
LDX #$03
:loop LDA (userBuf),Y ;Move all four pages of
STA (dataPtr),Y ; the buffer to new location
INY
BNE :loop
INC dataPtr+1
INC userBuf+1
DEX
BPL :loop
CLC
SetBufErr RTS
**************************************************
*
* This is the routine that moves the 3 pages of dispatcher 1
* from $D100 of the alt 4k bank to its execution address ($1000).
* Since it is in the MLI and must swap the $D000-$DFFF banks,
* it must be resident at all times above $E000.
*
**************************************************
* NB. There is a vector @ $FEFD which points to this rtn
CallDisp LDA LCBANK2
LDA LCBANK2 ;Bring in the other $D000 space
LDA #>DispAdr ;Destination address of user-code
STA A2+1
LDA #<DispAdr
STA A2
LDA #$D1 ;Dispatcher is stored at $D100-$D3FF
STA A1+1
STZ A1
LDY #$00
LDX #$03 ;3 pages of code to move
MovPage DEY ;Nifty routine to move a page of code
LDA (A1),Y ;Move all 255 bytes on the page
STA (A2),Y
TYA
BNE MovPage
INC A1+1 ;Move pointers to next page
INC A2+1
DEX
BNE MovPage
LDA LCBANK1
LDA LCBANK1 ;Swap MLI's $D000 space back in
STZ mliActv
STZ SOFTEV ;Set up the reset vector
LDA #>DispAdr
STA SOFTEV+1 ; to dispatch entry
EOR #$A5 ;Set up power up byte
STA PWREDUP
JMP DispAdr
**************************************************
* Handles calls to mirror devices
* ProDOS unit #s are of the form DSSS xxxx
* where the bits of the low nibble are the
* attributes of the device.
* D=0/1 (drive 1/drive 2)
* The handler only supports 14 mirror devices
* A statusCmd ($00) call will return the #
* of blocks in (Y,X)
MirrorDevEntry LDX #$03 ;Default parm cnt
LDA dhpCmd ;Get cmd
STA spCmdNum
BNE :1
LDY #<spStatList ;Its a statusCmd
STY bufPtr
LDY #>spStatList
STY bufPtr+1
STZ blockNum
:1 CMP #$03 ;FormatCmd?
BNE :2 ;No
LDX #$01 ;parm cnt for a formatCmd
:2 STX spCmdList
LDA unitNum ;(dsss 0000)
LSR
LSR
LSR
LSR
TAX ;0000 dsss ($01-$0F; $00,$08,$0B-invalid)
LDA spUnits-1,X ;Get actual SP unit # which
STA spUnitNum ; corr to this ProDOS unit #
LDA spDrvAdrL-1,X
STA CallSPort+1 ;Get addr of SP dev driver
LDA spDrvAdrH-1,X
STA CallSPort+2 ; which handles this SP unit
LDX #$04
:CpyLoop LDA bufPtr-1,X
STA blkIOParms-1,X
DEX
BNE :CpyLoop
CallSPort JSR $0000 ;Go do it!
spCmdNum DB $00
DA spCmdList
BCS :Rtn
LDX spCmdNum ;Was a SP STATUS call executed?
BNE :Rtn ;No
LDX spDevTotBlks ;# of blocks
LDY spDevTotBlks+1
LDA genStatus
BIT #$10 ;Is dev online/disk in drive?
BNE :1 ;Yes
LDA #drvrOffLine
BRA :2
:1 AND #$44 ;Retain bits 6,2
EOR #$40 ;Is it write-protected?
BEQ :Rtn ;No
LDA #drvrWrtProt
:2 SEC
:Rtn RTS
*-------------------------------------------------
* This table was built during a P8 boot
spDrvAdrL DS $F,0 ;Actual entry points
spDrvAdrH DS $F,0 ; of a device's driver
* Command List used for all 4 commands viz
* 0-Status, 1-Read Block, 2-Write Block, 3-Format
* The caller must pass the parms using the
* usual zp locations $42-$47
spCmdList DB $03 ;parm count
spUnitNum DB $00 ;unit #
blkIOParms DA $0000 ;Data I/O buf
blokNum DB 0,0,0 ;blk # (only 2 bytes used)

51
MLI.SRC/MLI.MACS.S Normal file
View File

@ -0,0 +1,51 @@
_ReadTimeHex MAC
Tool $D03
<<<
_Int2Hex MAC
Tool $220B
<<<
_TLTextMountVol MAC
Tool $1201
<<<
_MessageCenter MAC
Tool $1501
<<<
_MMStartUp MAC
Tool $202
<<<
_MMShutDown MAC
Tool $302
<<<
_NewHandle MAC
Tool $902
<<<
_DisposeHandle MAC
Tool $1002
<<<
PushLong MAC
IF #=]1
PushWord #^]1
ELSE
PushWord ]1+2
FIN
PushWord ]1
<<<
PushWord MAC
IF #=]1
PEA ]1
ELSE
IF MX/2
LDA ]1+1
PHA
FIN
LDA ]1
PHA
FIN
<<<
_PtrToHand MAC
Tool $2802
<<<
Tool MAC
LDX #]1
JSL $E10000
<<<

453
MLI.SRC/NEWFNDVOL.S Normal file
View File

@ -0,0 +1,453 @@
**************************************************
* Get directory data
PrepRoot JSR FindVol ;Search VCB's and devices for specified volume
BCS NoVolume ;Branch if not found
LDA #$00 ;Zero out directory temps
LDY #$42
ClrDsp STA ownersBlock,Y ; & owner info
DEY
BPL ClrDsp
LDA DevNum ;Set up device number for this directory
STA d_dev
JSR MoveHeadZ ;Set up other header info from directory
LDY #$01 ; in genBuf & clean up misc
LDX vcbPtr
INX
RootMisc LDA vcb+vcbTotBlks,X;Misc info includes
STA h_totBlk,Y ; total # of blocks,
LDA vcb+vcbBitMap,X ; the disk addr of the first bitmap,
STA h_bitMap,Y
LDA |blockNum,Y ; directory's disk address,
STA d_head,Y
LDA h_fileCnt,Y ; & lastly, setting up a counter for
STA entCnt,Y ; the # of files in this directory
DEX ;Move low order bytes too
DEY
BPL RootMisc
NxtPName JSR NxtPNameZ ;Get new pnPtr in Y & next namlen in A
STY pnPtr ;Save new pathname pointer
RTS ;(status reg according to ACC)
*-------------------------------------------------
* Advance to next dir name
NxtPNameZ LDY pnPtr ;Bump pathname pointer to
LDA pathBuf,Y ; next name in the path...
SEC
ADC pnPtr ;If this addition results in zero
TAY ; then prefixed directory has been moved
BNE :1 ; to another device. Branch if not
LDA DevNum ;Revise devnum for prefixed directory
STA pathDev
:1 LDA pathBuf,Y ;Test for end of name (Z=1)
CLC ;Indicate no errors
NoVolume RTS
*-------------------------------------------------
* Find base dir
FindVol LDA #$00
LDY PfixPtr ;Use prefix volume name to look up VCB
BIT prfxFlg ;Is this a prefixed path?
BPL :1 ;Branch if it is
TAY ;Set ptr to volume name
:1 STY vnPtr ;Save pointer
STA DevNum ;Zero out device number until VCB located
Adv2NxtVCB PHA ;Acc now used as VCB lookup index
TAX ;Move pointer to X-reg for index
LDA vcb+vcbNamLen,X ;Get volume name length
BNE MatchVol ;Branch if claimed VCB to be tested
NxtVCB LDY vnPtr ;Restore ptr to requested volume name
PLA ;Now adjust VCB index to next vcb entry
CLC
ADC #vcbSize
BCC Adv2NxtVCB ;Branch if more VCB's to check
BCS LookVol ;Otherwise go look for unlogged volumes
MatchVol STA namCnt ;Save length of vol name to be compared
:loop1 CMP pathBuf,Y ;Is it the same as requested vol name?
BNE NxtVCB ;branch if not
INX
INY
LDA vcb+vcbName-1,X ;Bump to next character
DEC namCnt ;Was that the last character?
BPL :loop1 ;Branch if not
PLX ;Restore pointer to VCB that matches
STX vcbPtr ;Save it for future reference
LDA vcb+vcbDevice,X ;Get its device number
STA DevNum ;Save it
STZ blockNum+1 ;Assume prefix is not used and
LDA #$02 ; that root directory is to be used
STA blockNum
LDA vnPtr ;= 0 if no prefix
PfxDir TAY ;If prefix, then find ptr to prefixed dir name
STA pnPtr ;Save path ptr
BEQ ChkVolName ;Branch if no prefix
SEC ;Bump to next dir in prefix path
ADC pathBuf,Y
BCC PfxDir ;Branch if there is another dir in prefix
LDA pathBlok ;Volume verification will occur
STA blockNum ; at sub directory level
LDA pathBlok+1
STA blockNum+1
*-------------------------------------------------
******verify volume name******
ChkVolName JSR RdGBuf ;Read in directory (or prefix directory)
BCS WrgVol ;If error then look on other devices
JSR CmpPName ;Compare directory name with pathname
BCC WrgVolErr ;If they match, don't look elsewhere
WrgVol LDX vcbPtr ;Find out if current (matched) vcb is active
LDA vcb+vcbStatus,X ; i.e. does it have open files?
BMI LookVolErr ;Report not found if active
LookVol LDA vnPtr ;Make path pointer same as volume ptr
STA pnPtr
JSR MovDevNums ;Copy all device numbers to be examined
LDA DevNum ;Log current device first, before searching others
BNE WrgVol3
TryNxtUnit LDX DevCnt ;Scan look list for devices we need
:loop LDA lookList,X ; to search for the requested volume
BNE WrgVol4 ;Branch if we've a device to look at
DEX
BPL :loop ;Look at next guy
LookVolErr LDA #volNotFound ;Report that no mounted volume
SEC ; matches the requested
WrgVolErr RTS
WrgVol3 LDX DevCnt ;Now remove the device from the list
WrgVol4 CMP lookList,X ; of prospective devices (so we don't look twice)
BEQ :1 ;Branch if match
DEX ;Look until found
BPL WrgVol4 ;Branch always taken! (usually!) * * *
BMI LookVolErr ;Never unless device was manually removed from devlst (/ram)
:1 STA DevNum ;Preserve device we're about to investigate
STZ lookList,X ;Mark this one as tested
JSR ScanVCB ;Find VCB that claims this device, if any
BCS FndVolErr ;Branch if VCB full
LDX vcbPtr ;Did 'fnddvcb' find it or did it return free vcb?
LDA vcb,X
BEQ :2 ;Branch if free VCB
LDA vcb+vcbStatus,X ;Is this volume active?
BMI TryNxtUnit ;If so, no need to re-log
:2 LDA #$02 ;Go read root directory into genBuf
LDX #$00
JSR RdBlkAX
BCS TryNxtUnit ;Ignore if unable to read
JSR LogVCB ;Go log in this volume's proper name
BCS TryNxtUnit ;Look at next if non xdos disk was mounted
JSR CmpPName ;Is this the volume we're looking for?
BCS TryNxtUnit ;Branch if not
FndVolErr RTS ;return to caller
MovDevNums LDX DevCnt ;Copy all device numbers to be examined
:loop LDA DevLst,X
AND #$F0 ;Strip device type info
STA lookList,X ;Copy them to a temporary workspace
DEX
BPL :loop
LDX DevCnt
RTS
**************************************************
* Scan VCBs' for device #
* Input
* (DevNum) - Look for vcb with this device number
* Output
* C = - Got a match/Got a free slot
ScanVCB LDA #$00
LDY #$FF
ScanNxtVCB TAX ;New index to next VCB
LDA vcb+vcbDevice,X ;Check all devnums
CMP DevNum ;Is this the VCB were looking for?
BNE NotThisVCB ;Branch if not
STX vcbPtr
CLC ;Indicate found
RTS
NotThisVCB LDA vcb,X ;Is this a free VCB?
BNE :1 ;Branch if not
INY
STX vcbPtr
:1 TXA ;now...
CLC ; bump index to next VCB
ADC #vcbSize
BNE ScanNxtVCB
TYA ;Were any free VCB's available?
BPL :3 ;Yes
LDA #$00
:loop TAX ;Save index
LDA vcb+vcbStatus,X ;Any files opened?
BPL :2 ;No
TXA
CLC
ADC #vcbSize
BNE :loop
BEQ :ErrExit ;Always
:2 STX vcbPtr ;This slot can be used
STZ vcb,X ;Prepare it for use
STZ vcb+vcbDevice,X
:3 CLC ;Indicate no errors
:ErrExit LDA #vcbFullErr
RTS
*-------------------------------------------------
* Compare dir name with path level
CmpPName LDX #$00 ;Index to directory name
LDY pnPtr ;Index to pathname
LDA genBuf+4+hNamLen;Get directory name length (and type)
CMP #$E0 ;Also make sure it's a directory
BCC :1 ;Branch if not a directory
AND #$0F ;Isolate name length
STA namCnt ;Save as counter
BNE :2 ;Branch if valid length
:1 SEC ;Indicate not what were looking for
RTS
:loop LDA genBuf+4+hName-1,X;Get next char
:2 CMP pathBuf,Y
BNE :1 ;Branch if not the same
INX ;Check nxt char
INY
DEC namCnt
BPL :loop ;Branch if more to compare
CLC ;Otherwise we got a match!!!
RTS
*-------------------------------------------------
* Mount new volume
LogVCB LDX vcbPtr ;Is this a previously logged in volume
LDA vcb,X ;(A=0?)
BEQ LogVCBZ ;No, go ahead and prepare vcb
JSR CmpVCB ;Does VCB match volume read?
BCC VCBLogged ;Yes, don't disturb it
LogVCBZ LDY #vcbSize-1
ZeroVCB STZ vcb,X ;Zero out VCB entry
INX
DEY
BPL ZeroVCB
JSR TestSOS ;Make sure it's an xdos diskette
BCS VCBLogged ;If not, return carry set
JSR TestDupVol ;find out if a duplicate with open files already exists
BCS NotLog0
LDA genBuf+4+hNamLen;Move volume name to VCB
AND #$0F ;Strip root marker
TAY ;len byte to Y-reg
PHA
ORA vcbPtr ;Add in offset to VCB record
TAX
MovVolNam LDA genBuf+4+hNamLen,Y
STA vcb+hNamLen,X
DEX
DEY
BNE MovVolNam
PLA ;Get length again
STA vcb+hNamLen,X ;Save that too.
LDA DevNum
STA vcb+vcbDevice,X ;Save device number also
LDA genBuf+4+vTotBlk; & totol # of blocks on this unit,
STA vcb+vcbTotBlks,X
LDA genBuf+4+vTotBlk+1
STA vcb+vcbTotBlks+1,X
LDA blockNum ; & address of root directory
STA vcb+vcbRoot,X
LDA blockNum+1
STA vcb+vcbRoot+1,X
LDA genBuf+4+vBitMap; & lastly, the address
STA vcb+vcbBitMap,X ; of the first bitmap
LDA genBuf+4+vBitMap+1
STA vcb+vcbBitMap+1,X
NotLog0 CLC ;Indicate that it was logged if possible
VCBLogged RTS
*-------------------------------------------------
* Compare vol names to make sure they match
CmpVCB LDA genBuf+4+hNamLen;Compare volume name in VCB
AND #$0F ; with name in directory
CMP vcb+hNamLen,X ;Are they same length?
STX xvcbPtr
BNE :1
TAY
ORA xvcbPtr
TAX
:CmpLoop LDA genBuf+4+hNamLen,Y
CMP vcb+hNamLen,X
:1 SEC ;Anticipate different names
BNE NotSame
DEX
DEY
BNE :CmpLoop
CLC ;Indicate match
NotSame LDX xvcbPtr ;Get back offset to start of vcb
RTS
*-------------------------------------------------
* Look for duplicate vol
TestDupVol LDA #$00 ;Look for other logged in volumes with same name
:loop TAX
JSR CmpVCB
BCS :1 ;Branch if no match
LDA vcb+vcbStatus,X ;Test for any open files
BMI FoundDupVol ;Tell the sucker he can't look at this volume!
LDA #$00 ;Take duplicate off line if no open file
STA vcb,X
STA vcb+vcbDevice,X
BEQ NoDupVol ;Return that all is ok to log in new
:1 TXA ;Index to next VCB
CLC
AND #$E0 ;Strip odd stuff
ADC #vcbSize ;Bump to next entry
BCC :loop ;Branch if more to look at
NoDupVol CLC
RTS
FoundDupVol STA duplFlag ;A duplicate has been detected
STX vcbEntry ;Save pointer to conflicting vcb
SEC ;Indicate error
RTS
*-------------------------------------------------
* See if a quantity of free blks is available on volume
* Input
* (reqL,H) = # of blks required
TestFreeBlk LDX vcbPtr ;Find out if enough free blocks
LDA vcb+vcbFreeBlks+1,X; available to accomodate the request
ORA vcb+vcbFreeBlks,X; but first find out if we got a proper cnt for this vol
BNE CmpFreeBlk ;Branch if count is non-zero
* Compute VCB free blk count
TakeFreeCnt JSR CntBMs ;Get # of bitmaps
STA bmCnt ;Save it
STZ scrtch ;Start count at zero
STZ scrtch+1
LDA #$FF ;Mark 'first free' temp as unknown
STA noFree
JSR UpdateBitMap ;(nothing happens if it don't hafta.)
BCS TFBErr ;Branch if we got trouble
LDX vcbPtr ;Get address of first bit map
LDA vcb+vcbBitMap,X
STA blockNum
LDA vcb+vcbBitMap+1,X
STA blockNum+1
BitMapRd JSR RdGBuf ;Use g(eneral)buff(er) for temporary
BCS TFBErr ; space to count free blocks (bits)
JSR FreeCount ;Go count 'em
DEC bmCnt ;Was that the last bit map?
BMI ChgVCB ;If so, go change VCB to avoid doing this again!
INC blockNum ;Note: the organization of the bit maps
BNE BitMapRd ; are contiguous for sos version 0
INC blockNum+1 ;If some other organization is implemented,
BRA BitMapRd ; this code must be changed!
ChgVCB LDX vcbPtr ;Mark which block had first free space
LDA noFree
BMI DskFull ;Branch if no free space was found
STA vcb+vcbCurrBitMap,X;Update the free count
LDA scrtch+1 ;Get high count byte
STA vcb+vcbFreeBlks+1,X;Update volume control block
LDA scrtch
STA vcb+vcbFreeBlks,X; & low byte too...
CmpFreeBlk LDA vcb+vcbFreeBlks,X;Compare total available
SEC
SBC reqL ; free blocks on this volume
LDA vcb+vcbFreeBlks+1,X
SBC reqH
BCC DskFull
CLC
RTS
DskFull LDA #volumeFull
SEC
TFBErr RTS
*-------------------------------------------------
* Scan and count bitMap blks
FreeCount LDY #$00 ;Begin at the beginning
:loop LDA genBuf,Y ;Get bit pattern
BEQ :1 ;Don't bother counting nothin'
JSR CntFree
:1 LDA genBuf+$100,Y ;Do both pages with same loop
BEQ :2
JSR CntFree
:2 INY
BNE :loop ;Loop till all 512 bytes counted
BIT noFree ;Has first block with free space been found yet?
BPL :3 ;Branch if it has
LDA scrtch ;Test to see if any blocks were counted
ORA scrtch+1
BEQ :3 ;Branch if none counted
JSR CntBMs ;Get total # of maps
SEC ;Subtract countdown from total bit maps
SBC bmCnt
STA noFree
:3 RTS
*-------------------------------------------------
* Count # of 1 bits in a byte
CntFree ASL
BCC :1 ;Not a 1-bit
INC scrtch
BNE :1
INC scrtch+1
:1 ORA #$00 ;Loop until all bits counted
BNE CntFree
RTS
*-------------------------------------------------
* Compute # of bit map blks-1
CntBMs LDX vcbPtr
LDY vcb+vcbTotBlks+1,X;Return the # of bit maps
LDA vcb+vcbTotBlks,X; posible with the total count
BNE :1 ; found in the vcb...
DEY ;Adjust for bitmap block boundary
:1 TYA
LSR ;Divide by 16. The result is
LSR ; the number of bit maps
LSR
LSR
RTS

613
MLI.SRC/POSNOPEN.S Normal file
View File

@ -0,0 +1,613 @@
**************************************************
* GETMARK Call
GetMark LDX fcbPtr ;Get index to open file control block
LDY #c_mark ; & index to user's mark parameter
:loop LDA fcb+fcbMark,X
STA (parm),Y ;Transfer current position
INX ; to user's parameter list
INY
CPY #c_mark+3 ;Have all three bytes been transferred?
BNE :loop ;Branch if not...
CLC ;No errors
RTS
ErrMrkEOF LDA #outOfRange ;Report invalid position.
SEC
RTS
**************************************************
* SETMARK Call
SetMark LDY #c_mark+2 ;Get index to user's desired position
LDX fcbPtr ; & file's control block index
INX ;(bump by 2 for index to hi EOF)
INX
SEC ;Indicate comparisons are necessary
:loop LDA (parm),Y ;Move it to 'tPos'
STA tPosll-c_mark,Y
BCC :1 ;Branch if we already know mark<EOF
CMP fcb+fcbEOF,X ;Carry or Z flag must be clear to qualify
BCC :1 ;Branch if mark qualifies for sure
BNE ErrMrkEOF ;Branch if mark>EOF
DEX
:1 DEY dey ;Prepare to move/compare next lower byte of mark
TYA ;Test for all bytes moved/tested
EOR #c_mark-1 ;To preserve carry status
BNE :loop ;Branch if more
* Still in same data block
RdPosn LDY fcbPtr ;First test to see if new position is
LDA fcb+fcbMark+1,Y ; within the same (current) data block
AND #%11111110
STA scrtch ;(At a block boundary)
LDA tPoslh ;Get middle byte of new position
SEC
SBC scrtch
STA scrtch
BCC TypMark ;Branch if possibly l.t. current position
CMP #$02 ;Must be within 512 bytes of beginning of current
BCS TypMark ;No
LDA tPosHi ;Now make sure we're talking
CMP fcb+fcbMark+2,Y ; about the same 64K chunk!
BNE TypMark ;Branch if we aren't
JMP SavMark ;If we are, adjust FCB, posPtr and return
TypMark EQU * ;Now find out which type
LDA fcb+fcbStorTyp,Y; of file we're positioning on
BEQ :11 ;There is no such type as zero, branch never!
CMP #tree+1 ;Is it a tree class file?
BCC TreePos ;Yes, go position
JMP DirMark ;No, test for directory type
:11 LDY #fcbPtr ;Clear illegally typed FCB entry
STA fcb+fcbRefNum,Y
LDA #invalidRefNum ;Tell 'em there is no such file
SEC
RTS
* Need different data blk
TreePos EQU * ;Use storage type as number of index levels
LDA fcb+fcbStorTyp,Y; (since 1=seed, 2=sapling, and 3=tree)
STA levels
LDA fcb+fcbStatus,Y ;Must not forget previous data
AND #dataMod ;Therefore, see if previous data was modified
BEQ :21 ; then disk must be updated
JSR WrFCBData ;Yes, so go write current data block
BCS PosErr ;Return any error encountered
:21 LDY fcbPtr ;Test to see if current
LDA fcb+fcbMark+2,Y ; index block is going to be usable...
AND #%11111110 ; or in other words - is new position
STA scrtch ; within 128K of the beginning
LDA tPosHi ; of current sapling level chunk?
SEC
SBC scrtch
BCC PosNew2 ;Branch if a new index block is also needed
CMP #$02 ;New position is > begining of old. Is it within 128K?
BCS PosNew2 ;Branch if not
LDX levels ;Is the file we're dealing with a seed?
DEX
BNE DataLevel ;No, use current indexes
TestTiny LDA tPoslh ;Is new position under 512?
LSR
ORA tPosHi
BNE NoIdxData ;No, mark both data and index block as un-allocated
LDA fcb+fcbFirst,Y ;First block is only block and it's data!
STA blockNum
LDA fcb+fcbFirst+1,Y;(high block address)
JMP RdNewPos
PosNew2 EQU * ;Gota check to see if previous
LDA fcb+fcbStatus,Y ; index block was modified
AND #idxMod
BEQ PosnIdx ;Read in over it if current is up to date
JSR WrFCBIdx ;Go update index on disk (block addr in fcb)
BCS PosErr
PosnIdx LDX levels ;Before reading in top index, check
CPX #tree ; to be sure that there is a top index...
BEQ PosIndex ;Branch if file is full blown tree
LDA tPosHi ;Is new position within range
LSR ; of a sapling file (l.t. 128k)?
PHP ;Anticipate no good
LDA #topAloc+idxAloc+dataAloc;(to indicate no level is allocated for new posn)
PLP ;Z flag tells all...
BNE NoData ;Go mark 'em all dummy
JSR ClrStats ;Go clear status bits 0,1,2 (index/data alloc status)
DEX ;(unaffected since loaded above) Check for seed
BEQ TestTiny ;If seed, check for position l.t. 512...
JSR RdFCBFst ;Go get only index block
BCS PosErr ;Branch if error
LDY fcbPtr ;Save newly loaded index block's address
LDA blockNum
STA fcb+fcbIdxBlk,Y
LDA blockNum+1
STA fcb+fcbIdxBlk+1,Y
BCC DataLevel ;Branch always...
PosErr RTS ;Carry always set when branched to
PosIndex JSR ClrStats ;Clear all allocation requirements for prev posn
JSR RdFCBFst ;Get highest level index block
BCS PosErr
LDA tPosHi ;Then test for a sap level index block
LSR
TAY
LDA (tIndex),Y
INC tIndex+1
CMP (tIndex),Y ;(both hi and lo will be zero if no index exists)
BNE SapLevel
TAX ;Are both bytes zero?
BNE SapLevel ;No
DEC tIndex+1 ;Don't leave wrong pointers laying around!
NoIdxData LDA #idxAloc+dataAloc
BRA NoData
SapLevel STA blockNum ;Read in next lower index block
LDA (tIndex),Y ;(hi address)
STA blockNum+1
DEC tIndex+1
JSR RdFCBIdx ;Read in sapling level
BCS PosErr
DataLevel LDA tPosHi ;Now get block address of data block
LSR
LDA tPoslh ;( if there is one )
ROR
TAY
LDA (tIndex),Y ;Data block address low
INC tIndex+1
CMP (tIndex),Y
BNE PosNew3
TAX ;Are both bytes zero?
BNE PosNew3 ;No
LDA #dataAloc ;Show data block has never been allocated
DEC tIndex+1
NoData LDY fcbPtr ;Set status to show what's missing
ORA fcb+fcbStatus,Y
STA fcb+fcbStatus,Y
LSR ;Throw away bit that says data block un-allocated
LSR ; cuz we know that. Carry now indicates if index block
JSR ZipData ; also is invalid and needs to be zeroed (Carry undisturbed)
BCC SavMark ;Branch if index block doesn't need zipping
JSR ZeroIndex ;Go zero index block in user's i/o buffer
BRA SavMark
ZeroIndex LDA #$00
TAY
:loop1 STA (tIndex),Y ;Zero out the index half
INY
BNE :loop1 ; of the user's i/o buffer
INC tIndex+1
:loop2 STA (tIndex),Y
INY
BNE :loop2 ;Restore proper address
DEC tIndex+1
RTS ;That's all
ZipData LDA #$00 ;Also is invalid and needs to be zeroed
TAY
:loop1 STA (dataPtr),Y ;Zero out data area
INY
BNE :loop1
INC dataPtr+1
:loop2 STA (dataPtr),Y
INY
BNE :loop2
DEC dataPtr+1
RTS
* Read file data blk
PosNew3 STA blockNum ;Get data block of new position
LDA (tIndex),Y ;(hi address)
DEC tIndex+1
RdNewPos STA blockNum+1
JSR RdFCBData
BCS pritz ;Return any error
JSR ClrStats ;Show whole chain is allocated
* Got data blk wanted
SavMark LDY fcbPtr ;Update position in file control block
INY
INY
LDX #$02
:loop LDA fcb+fcbMark,Y ;Remember oldmark in case
STA oldMark,X ; calling routine fails later
LDA tPosll,X ;Set new mark
STA fcb+fcbMark,Y ; in FCB
DEY
DEX ;Move 3-byte position marker
BPL :loop
CLC ;Last, but not least, set up
LDA dataPtr ; indirect address to buffer page pointed
STA posPtr ; to by the current position marker
LDA tPoslh
AND #$01 ;(A)=0/1
ADC dataPtr+1 ;(posPtr) = start of pg in
STA posPtr+1 ; data blk which contains the mark
pritz RTS ;Carry set indicates error!
*-------------------------------------------------
* Reset block allocate flags
ClrStats LDY fcbPtr ;Clear allocation states for data block
LDA fcb+fcbStatus,Y ; and both levels of indexes
AND #$FF-topAloc-idxAloc-dataAloc
STA fcb+fcbStatus,Y ;This says that either they exist currently
RTS ; or that they're unnecessary for current position.
*-------------------------------------------------
* Set dir file position
DirMark CMP #directoryFile ;Is it a directory?
BEQ DirPos ;Yes...
LDA #badFileFormat ;No, there is a compatiblity problem -
JSR SysErr ; the damn thing should never been opened!
DirPos LDA scrtch ;Recover results of previous subtraction
LSR ;Use difference as counter as to how many
STA cntEnt ; blocks must be read to get to new position
LDA fcb+fcbMark+1,Y ;Test for position direction
CMP tPoslh ;Carry indicates direction...
BCC DirFwrd ;If set, position forward
DirReverse LDY #$00 ;Otherwise, read directory file in reverse order
JSR DirPos1 ;Read previous block
BCS DirPosErr ;Branch if anything goes wrong
INC cntEnt ;Count up to 128
BPL DirReverse ;Loop if there is more blocks to pass over
BMI SavMark ;Branch always
DirFwrd LDY #$02 ;Position is forward from current position
JSR DirPos1 ;Read next directory block
BCS DirPosErr
DEC cntEnt
BNE DirFwrd ;Loop if position not found in this bloc
BEQ SavMark ;Branch always
DirPos1 LDA (dataPtr),Y ;Get link address of previous
STA blockNum ; or next directory block
CMP #$01 ; but first be sure there is a link
INY
LDA (dataPtr),Y
BNE DirPos2
BCS DirPos2 ;Branch if certain link exists
LDA #eofEncountered ;Something is wrong with this directory file!
DirPosErr SEC ;Indicate error
RTS
DirPos2 STA blockNum+1 ;(high order block address)
*
* Drop into rfcbdat (Read file's data block)
*
*
* Note: for directory positioning, no optimization has been done since
* since directory files will almost always be less than 6 blocks.
* If more speed is required or directory type files are to be used
* for other purposes requiring more blocks, then the recommended
* method is to call RdFCBData for the first block and go directly to
* device (via jmp (iounitl)) handler for subsequent accesses.
* Also note that no checking is done for read/write enable since a
* directory file can only be opened for read access.
*
RdFCBData LDA #rdCmd ;Set read command
STA dhpCmd
LDX #dataPtr ;Use X to point at address of data buffer
JSR FileIOZ ;Go do file input
BCS :Ret ;Return any error
LDY fcbPtr
LDA blockNum
STA fcb+fcbDataBlk,Y;Save block number just read in FCB
LDA blockNum+1
STA fcb+fcbDataBlk+1,Y
:Ret RTS ;Carry set indicates error
*-------------------------------------------------
* Read sub index blk
RdFCBIdx LDA #rdCmd ;Prepare to read in index bloc
STA dhpCmd
LDX #tIndex ;Point at address of current index buffer
JSR FileIOZ ;Go read index block
BCS :Ret ;Report error
LDY fcbPtr
LDA blockNum
STA fcb+fcbIdxBlk,Y ;Save block address of this index in fcb
LDA blockNum+1
STA fcb+fcbIdxBlk+1,Y
CLC
:Ret RTS
*-------------------------------------------------
* Write key index blk
WrFCBFst1 LDA #wrtCmd ;Set write mode for device
DB $2C ;Skip next 2 bytes for pseudo-branch always to RWFst
* Read key index blk
RdFCBFst LDA #rdCmd ;Set read mode for device
RWFst PHA ;Save command
LDA #fcbFirst
ORA fcbPtr ;Add offset to fcbPtr
TAY
PLA
LDX #tIndex ;Read block into index portion of file buffer
*
* Drop into DoFileIO
*
DoFileIO STA dhpCmd ;Save command
LDA fcb,Y ;Get disk block address from FCB
STA blockNum ;Block zero not legal
CMP fcb+1,Y
BNE FileIO
CMP #$00 ;Are both bytes zero?
BNE FileIO ;No, continue with request
LDA #badBlockErr ;Otherwise report allocation error
JSR SysDeath ;Never returns...
FileIO LDA fcb+1,Y ;Get high address of disk block
STA blockNum+1
*-------------------------------------------------
* Set up and do file block I/O
* Entry
* (X) = buf ptr in page zero
FileIOZ PHP ;No interupts from here on out
SEI
LDA $00,X ;Get memory address of buffer from
STA bufPtr ; zero page pointed to by
LDA $01,X ; the X-register
STA bufPtr+1 ; & pass address to device handler
LDY fcbPtr
LDA fcb+fcbDevNum,Y ;Of course having the device number
STA DevNum ; would make the whole operation more meaningful...
LDA #$FF ;Also, set to
STA ioAccess ; indicate reg call made to dev handler
LDA DevNum ;xfer the device # for dispatcher to convert to unit #
STA unitNum
STZ SErr ;Clear global error value
JSR DMgr ;Call the driver
BCS :1 ;Branch if error
PLP ;Restore interupts
CLC
RTS
:1 PLP ;Restore interupts
SEC
RTS
*-------------------------------------------------
* Check point bit map & write key blk
WrFCBFirst JSR UpdateBitMap ;First update the bitmap
BRA WrFCBFst1 ; and go write file's first block!
*-------------------------------------------------
* Check point data blk buffer
WrFCBData LDX #dataPtr
LDA #fcbDataBlk ;Point at mem addr with X and disk addr with Y
ORA fcbPtr ;Add offset to fcbptr
TAY ; and put it in Y-reg
LDA #wrtCmd ;Write data block
JSR DoFileIO
BCS FileIOerr ;Report any errors
LDA #$FF-dataMod ;Mark data status as current
BRA FCBUpdate
*-------------------------------------------------
* Check point index blk buffer
WrFCBIdx JSR UpdateBitMap ;Go update bitmap
LDX #tIndex ;Point at address of index buffer
LDA #fcbIdxBlk ; & block address of that index block
ORA fcbPtr
TAY
LDA #wrtCmd
JSR DoFileIO ;Go write out index block
BCS FileIOerr ;Report any errors
LDA #$FF-idxMod ;Mark index status as current
FCBUpdate LDY fcbPtr ;Change status byte to
AND fcb+fcbStatus,Y ; reflect successful disk file update
STA fcb+fcbStatus,Y ;(carry is unaffected)
FileIOerr RTS
**************************************************
* ProDOS8 OPEN Call
Open JSR FindFile ;First of all look up the file...
BCC :1
CMP #badPathSyntax ;Is an attempt to open a root directory?
BNE ErrOpen ;No, pass back error
:1 JSR TestOpen ;Find out if any other files are writing
BCC Open1 ; to this same file. (branch if not)
ErrBusy LDA #fileBusy
ErrOpen SEC
RTS
WrgStorTyp LDA #badStoreType ;Report file is of wrong storage type!
SEC
RTS
Open1 LDY fcbPtr ;Get address of first free FCB found
LDA fcbFlg ;This byte indicates that a free FCB found
BNE AssignFCB ; if non-zero is available for use
LDA #fcbFullErr ;Report FCB full error
SEC
RTS
AssignFCB LDX #fcbSize-1 ;Assign fcb, but first
LDA #$00 ; clean out any old
ClrFCB STA fcb,Y ; rubbish left around...
INY
DEX
BPL ClrFCB
LDA #fcbEntNum ;Now begin claim by moving in file info
TAX ;Use X as source index
ORA fcbPtr
TAY ; and Y as destination (FCB)
FCBOwner LDA d_dev-1,X ;Move ownership information
STA fcb,Y ;Note: this code depends upon the defined
DEY ; order of both the FCB and directory entry
DEX
BNE FCBOwner ; buffer (d.). beware of changes!!! *************
LDA d_file+d_stor ;Get storage type
LSR ;Strip off file name length
LSR
LSR
LSR ;(by dividing by 16)
TAX ;Save in X for later type comparison
STA fcb+fcbStorTyp,Y; and in FCB for future access
LDA d_file+d_attr ;Get files attributes & use
AND #readEnable+writeEnable; it as a default access request
CPX #directoryFile ;If directory, don't allow write enable
BNE SavAttr1
AND #readEnable ;(Read-only)
SavAttr1 STA fcb+fcbAttr,Y
AND #writeEnable ;Check for write enabled requested
BEQ :1 ;Branch if read only open
LDA totEnt ;Otherwise, be sure no one else is reading
BNE ErrBusy ; same file (set up by TestOpen)
:1 CPX #tree+1 ;Is it a tree type file?
BCC :2 ;Test for further compatiblity. It must
CPX #directoryFile ; be either a tree or a directory
BNE WrgStorTyp ;Report file is of wrong storage type
:2 LDX #$06 ;Move address of first block of file,
:loop1 STA blockNum+1 ; end of file, and current usage count
LDA fcbPtr
ORA oFCBTbl,X ;This is done via a translation
TAY ; table between directory info and FCB
LDA d_file+d_first,X
STA fcb,Y
DEX ;Has all info been moved?
BPL :loop1
STA blockNum ;Last loop stored hi addr of first block
LDY fcbPtr
LDA cntEnt ;This was set up by 'TestOpen'...
STA fcb+fcbRefNum,Y ;Claim fcb for this file
JSR AllocBuf ;Go allocate buffer in memtables
BCS ErrOpen2 ;Give up if any errors occurred
JSR FndFCBuf ;Returns addrs of bufs in data & index pointers
LDA Level ;Mark level at which
STA fcb+fcbLevel,Y ; file was opened
LDA fcb+fcbStorTyp,Y;File must be positioned to beginning
CMP #tree+1 ;Is it a tree file?
BCS OpenDir ;No, assume it's a directory
LDA #$FF ;Fool the position routine into giving a
STA fcb+fcbMark+2,Y ; valid position with preloaded data, etc
LDY #$02 ;Set desired position to zero
LDA #$00
:loop2 STA tPosll,Y
DEY
BPL :loop2
JSR RdPosn ;Let tree position routine do the rest
BCC OpenDone ;Branch if successful
ErrOpen2 PHA ;Save error code
LDY fcbPtr ;Return buffer to free space
LDA fcb+fcbFileBuf,Y
BEQ :1 ;Branch if no buf #
JSR ReleaseBuf ;Doesn't matter if it was never allocated
LDY fcbPtr ; since error was encountered before file
:1 LDA #$00 ; was successfully opened, then
STA fcb+fcbRefNum,Y ; it's necessary to release FCB
PLA
SEC
RTS
OpenDir JSR RdFCBData ;Read in first block of directory file
BCS ErrOpen2 ;Return any error after freeing buffer & FCB
OpenDone LDX vcbPtr ;Index to volume control block
INC vcb+vcbOpenCnt,X;Add 1 to the number of files currently open
LDA vcb+vcbStatus,X ; & indicate that this volume has
ORA #$80 ; at least 1 file active
STA vcb+vcbStatus,X
LDY fcbPtr ;Index to file control block
LDA fcb+fcbRefNum,Y ;Return reference number to user
LDY #c_outRef
STA (parm),Y
CLC ;Indicate successful open!
RTS ;All done...
*-------------------------------------------------
* Test if file can be opened
* C=1
* Already opened with write access
* NB. Multiple write access is not allowed
* C=0
* File may be opened/already opened
* If fcbFlag <> 0, got a free FCB &
* (fcbPtr) = index into FCB table
* NB. Multiple read access is allowed
TestOpen LDA #$00
STA cntEnt ;This temp returns the refnum of a free FCB
STA totEnt ;This is used as a flag to indicate file is already open
STA fcbFlg ;This is a flag to indicate a free FCB is available
TestOpen1 TAY ;Index to next FCB
LDX fcbFlg ;Test for free FCB found
BNE :1 ;Branch if already found
INC cntEnt
:1 LDA fcb+fcbRefNum,Y ;Is this FCB in use?
BNE ChkActive ;Branch if it is
TXA ;If not, should we claim it?
BNE TestNxtFCB ;Branch if free FCB already found
STY fcbPtr ;Save index to free FCB
LDA #-1 ;Set fcb flag to indicate free FCB found
STA fcbFlg
BNE TestNxtFCB ;Branch always to test next FCB
ChkActive TYA ;Add offset to index to ownership info
ORA #fcbEntNum
TAY ;Put it back in Y-reg
LDX #fcbEntNum ;Index to directory entry owner info
WhoOwns LDA fcb,Y
CMP d_dev-1,X ;All bytes must match to say that its
BNE TestNxtFCB ; the same file again
DEY ;Index to next lower bytes
DEX
BNE WhoOwns ;Loop to check all owner info
INC totEnt ;File is already open,
LDA fcb+fcbAttr,Y ;Now see if it's already opened for write
AND #writeEnable
BEQ TestNxtFCB ;Branch if this file is read access only
SEC ;Multiple write access not allowed
RTS
TestNxtFCB TYA ;Calc position of next FCB
AND #%11100000 ;First strip any possible index offsets
CLC
ADC #fcbSize ;Bump to next FCB
BNE TestOpen1 ;Branch if more to compare
CLC ;Report no conflicts
RTS

823
MLI.SRC/PROLDR.S Normal file
View File

@ -0,0 +1,823 @@
TTL 'ProDOS Kernel Loader'
*---------------------------------------------------------*
* Disassembled with The Flaming Bird Disassembler *
* (c) Phoenix corp. 1992,93 - All rights reserved *
*---------------------------------------------------------*
ORG $2000
MX %11
* There are 3 boot entry points here
NormalBoot JMP ProStart ;Normal boot entry point...
JMP NetBootP8 ;Network booted into P8
JMP NetBootGSOS ;Network-booted into GS/OS
*-------------------------------------------------
* Messages
apple2Msg ASC "Apple II"
p8VerMsg ASC "ProDOS 8 V2.0.3 06-May-93"
blanks ASC " "
cpyRhtMsg ASC "Copyright Apple Computer, Inc., 1983-93"
rsvdMsg ASC "All Rights Reserved."
endGreetMsg EQU *
grtLnZ EQU blanks-p8VerMsg/2
grtLnZZ EQU cpyRhtMsg-blanks/2
grtLnZZZ EQU endGreetMsg-rsvdMsg/2
NetBootGSOS INC SetupRTS ;Setup and
NetBootP8 INC SetupRTS ; RTS entry point...
*-------------------------------------------------
ProStart LDA unitNum ;Get boot device number
STA bUnit ;Save it for later 'prefix'
JSR Greet ;Put up greeting message
SED
LDA #$99 ;Check we have a 65C02
CLC
ADC #$01 ; by using chip's decimal mode
CLD
BMI m48K ;Error
LDA #$01
TRB STATEREG
LDX #<tablIntrp ;Move interpreter loader to $800
LDY #>tablIntrp
JSR Reloc
BCS m48K ;Branch if error
LDY #$00
LDA #$FF ;Make sure there is
STA $BFFF ; at least 48K
EOR $BFFF
SEC
BNE m48K ;Branch if not
STA $BFFF ;Try again. Once may have been lucky!
LDA $BFFF
BNE m48K
LDA RDROM2 ;Enable Motherboard ROM
JSR WhichROM ;Get preliminary system configuration
BCS m48K ;Branch if apple /// emulation
LDA apple ;Test for 48K configuration
AND #$20 ; by testing for 64K plus
BNE m64K ;Branch if >48k
m48K JMP ReqEnh2 ;Must have at least 64K
m64K LDX #<tabl64 ;Now move/relocate whatever we got
LDY #>tabl64
JSR Reloc
LDA kVersion ;Get current revision number
STA XDOSver ; & save it for directory use
NoGood0 BCC :1
JMP NoGood
:1 LDA RDROM2 ;Enable Motherboard ROM
LDX VERSION ;Look for //e family
CPX #$06
BNE ItsAIIe
LDA #%11100000 ;phylum check on high 2 bits
BIT $FBC0 ;Another approved location
PHP ;Save the results from the bit
LDA apple
AND #%00110111 ;Mask off bits 7,6 and 3
PLP ;Get results back
BVC Set3 ;//c or //x
BMI Set7 ;Branch if //e
Set3 PHP ;Save the results from the bit again
ORA #%00001000 ;Set bit 3 on
PLP
BPL Mach2 ;Branch if //c
ORA #%01000000
BPL SaveMach ;Always...
Mach2 INC cFlag-LIcode+LoadIntrp;Make it easy to see if we're on //c later
BVS SaveMach
Set7 ORA #%10000000 ;Set bit 7 on
SaveMach STA apple
LDA RDROM2 ;Enable ROM for Cortland ID routine
SEC ;Carry will determine if cortland or not
JSR IDroutine ;RTS in all a //'s prior to Cortland
BCS ItsAIIe ;Branch if really a //e
INC cortLand ;Set loader's cortland flag!
STZ $04FB ;Screenhole
JSR SetVid
* If SetupRTS is zero, zero out OS_BOOT for AppleTalk.
* (SetupRTS reflects whether we're ProDOS 8 regular or
* running with the GSOS.)
LDA SetupRTS
BNE ItsP8
STAL OS_BOOT ;Flag system was booted w/P8
JSR GSPatches ;Patch GS/OS vectors
ItsP8 EQU *
ItsAIIe LDA bUnit ;Place boot devnum in globals
STA bbUnit
STA DevNum
JSR DevSrch ;Finish setting up globals
LDA bbUnit
STA DevNum
JSR LC1In
LDX #<TClkStuff ; & set up clock
LDY #>TClkStuff
JSR Reloc
NoGood1 BCS NoGood0 ;Give up any time we got problems
* Dispatcher 1 must go in bank 2 of language card
* in a 64K or larger system.
LDA #<CallDisp
STA jSpare+1 ;Put dispatcher relocator address
LDA #>CallDisp ; into jspare vector
STA jSpare+2
LDA LCBANK2
LDA LCBANK2 ;Switch in bank 2
LDX #<DispGS ;Relocate GS dispatcher
LDY #>DispGS
LDA SetupRTS
CMP #$02 ;GS/OS boot?
BEQ RelocDisp ;Yes
LDX #<DispBB ;Install Better Bye
LDY #>DispBB
LDA MachID
BIT #$00
BNE RelocDisp ;Never!
AND #%1100_0010 ;IIe/III emul/IIc
CMP #%1000_0010 ;IIe/IIc & 80-col card?
BEQ RelocDisp ;Go install BB dispatcher
LDX #<Disp64 ;Install old 40-col dispatcher
LDY #>Disp64
INC No80Col
RelocDisp JSR Reloc
LDA #$EE ;Nonsense byte to distinguish bank 2
STA $D000
JSR LC1In ;Switch bank 1 back in
BCS NoGood1
* Test for 128K so /RAM disk can be installed
ChkRAM LDA MachID
AND #$30
EOR #$30
BNE NoRAMdsk
************ see rev note #45 *************
LDX #$FF ;X used to init Aux SP to $FF
PHP ;Save interrupt status
PLA ; in A-reg
SEI ;No interrupts for safety's sake
STA SETALTZP ;Swap in Aux LC & zp & stack
STX $0101 ;Init Aux SP to $FF
STA SETSTDZP ;Back to main LC, zp, and stack
PHA ;Restore
PLP ; interrupt status
STA SETINTC3ROM ;Make sure internal slot 3 ROM is in
JSR RAM_1 ;Go install /RAM
* Now check for interrupt vector. If vector <$D000 then we
* have new ROMs and should re-point vector in language card to
* ROM vector and set a flag byte. If vector is >$D000, reset
* flag byte and do nothing.
NoRAMdsk LDA ROMIN2 ;Switch in ROM
LDY IrqVect
LDX IrqVect+1 ;Get hi byte of irq vector
* The jsr LC1In was moved here from after the BCS Chk4Card so the
* sta IrqFlag is written to the proper bank.
JSR LC1In
*--------------------- see rev note #29 ------------------------
CPX #$D0 ;Is it >$D000 (old ROMs)
LDA #$00 ;Anticipate not
BCS Chk4Card ; but branch if they are old ROMs
STA SETALTZP ;Swap Aux LC, zpg and stack
LDA #$FF ;Set Aux stack pointer at $FF
STA $0101 ; while we're here
STX IrqVect+1
STY IrqVect ;Save ROM vector in Aux lang. card
STA SETSTDZP ;Swap in main lc, zpg and stack
STX IrqVect+1
STY IrqVect ;Save ROM vector in main lang. card
LDA #$01 ;Set IrqFlag to show new ROMs
Chk4Card STA IrqFlag
STZ cortFlag ;Assume we're not on a cortland
LDA cortLand ;Are we running on a cortland?
BEQ NoCort ;If not branch, and muck w/slot 3!
INC cortFlag ;Make it a one if we're on cortland
BRA DoCard
* Check for a ROM in slot 3. Switch in internal
* $C300 firmware if no ROM seen
NoCort STA SETINTC3ROM ;Start with internal firmware switched in
LDA SltByt ;Get slots ROM pattern
AND #%00001000 ;Mask off all but slot 3
BNE IsROMin3 ;Branch if there is rom in slot three
BRA NoSlot3ROM ;Continue with boot....
* We've seen a ROM in slot 3. Is it an external, identifiable
* 80-col card with interrupt routines? If so, enable it.
* If not, switch in the internal $C300 firmware.
IsROMin3 STA SETSLOTC3ROM ;Switch in slot 3 ROM
LDA $C305 ;1st generic terminal card ID byte
CMP #$38
BNE HitSwtch ;Branch if not a terminal card
LDA $C307 ;2nd generic terminal card ID byte
CMP #$18
BNE HitSwtch ;Branch if not a terminal card
LDA $C30B ;3rd generic terminal card ID byte
CMP #$01
BNE HitSwtch ;Branch if not a terminal card
LDA $C30C ;Is it an Apple 80-col card compatible?
AND #$F0 ;Mask off lo nibble
CMP #$80 ; and check for $8n
BNE HitSwtch ;Branch if not an 80-col card
LDA MachID ;Get the machine ID
AND #%11001000
CMP #$C0 ;Is it a //+?
BEQ DoCard ;Branch if it is
LDA $C3FA ;Check for interrupt handler routine
CMP #$2C ; in the magic $C3FA spot
BEQ DoCard ;Branch if interrupt handler is there!
HitSwtch STA SETINTC3ROM ;Switch in internal $C300 ROM
* Verify that the card in the aux slot is actually there.
STA SET80COL ;80-store on
STA TXTPAGE2
LDA #$EE
STA $0400
ASL
ASL $0400
CMP $0400
BNE Maybee ;Branch if not there
LSR
LSR $0400
CMP $0400
Maybee STA TXTPAGE1 ;Main memory
STA CLR80COL ;80-store off
BEQ DoCard ;Branch if card is there
LDA MachID ;Get machine id byte
AND #%11111101 ;Mask off 80-col bit
BNE DoCard1
* OK, the card's good. Leave it enabled and update the MachID
DoCard LDA MachID
ORA #%00000010
DoCard1 STA MachID
NoSlot3ROM LDA cortLand ;Are we running on a cortland?
BEQ NotCortLand ;Branch if not
LDA #$4C ;Enable clock routine by
STA DateTime ; putting a JMP in front of clock vector
LDX #<cortClock ;Now set up for relocating
LDY #>cortClock ; the cortland clock driver
JSR Reloc ; and relocate it
LDA #$01 ;Denote clock present in MachID byte!
TSB MachID ; bit 0 set to 1
NotCortLand LDA SetupRTS ;Get value of setup entry point flag...
BEQ NoRTS ;Branch if normal boot...
LDA RDROM2 ;Make sure the ROM is in for consistency...
RTS ;Return to the caller at the setup entry point. ($2003/$2006)
SetupRTS DB $00 ;0-Normal Boot, 1-Ret 2-Ret to GS/OS
NoRTS EQU *
*************************************************
* Now set prefix to boot device.
*
JSR GoPro ;First 'online'(was labled bootpfx,#en3)
DB $C5
DA olParm
BCS NoGood ;Branch if problems
LDA pnBuf+1 ;Get volume name length
AND #$0F ;strip devnum
BEQ NoGood ;Branch if error
INC ;Add 1 for leading '/'
STA pnBuf ;Save prefix length
LDA #'/' ;Place leading '/' in path name buf
STA pnBuf+1
JSR GoPro ;Set prefix
DB $C6
DA PfxParm
BCS NoGood ;Branch if problems
TAX ;(A) = 0 after successful MLI call
STX dst ;(Zerored)
LDY #$02 ;Read root directory into buffer
LDA #>ABuf ; starting at $0C00
RdDirBlks STA dst+1
STA dbBufr+1 ;(using a pointer in zero page also)
STY dbBlock
STX dbBlock+1
JSR GoPro
DB $80 ;Block read
DA dbParms
BCS NoGood
LDY #$03 ;Get next block number from link
LDA (dst),Y
TAX
DEY
ORA (dst),Y ;If both bytes are the same i.e. 0, 0
BEQ ExitDirBlkRd ; then no more blocks of directory
LDA (dst),Y
TAY
LDA dst+1
CLC
ADC #$02 ;Add $200 to buffer pointer until
CMP #$14 ; it points past $13FF
BCC RdDirBlks ;If ok, read next block
ExitDirBlkRd JMP LoadIntrp ;All is well, load interpreter!!!
NoGood STA RDROM2 ;Make sure rom is there
JSR HOME ;Clear video
LDY #mesLen ;Print message centered on screen
:loop LDA errMess,Y
STA SLIN11+4,Y
DEY
BPL :loop
Hang BMI Hang
mesLen EQU 29
errMess ASC "Relocation/Configuration Error"
ReqEnh2 LDY #mes2Len
:loop2 LDA errMess2,Y ;Requires enhanced //
STA SLIN13+2,Y
DEY
BPL :loop2
Hang2 BMI Hang2
*-------------------------------------------------
mes2Len EQU 35
errMess2 ASC "REQUIRES ENHANCED APPLE IIE OR LATER"
olParm DB $02
bUnit DB $60 ;Boot Unit
DA pnBuf+1
PfxParm DB $01
DA pnBuf
* Dir block read
dbParms DB $03
bbUnit DB $00
dbBufr DA $0000
dbBlock DW $0000
cortLand DB $00 ;Non-zero if IIgs
No80Col DB $00 ;Flag 40-col dispatcher to be installed
*-------------------------------------------------
AuxGo EQU $03F0 ;Entry point to Aux LC driver call routine
cZero EQU $00
cMove EQU $01
cReloc EQU $04
cDone EQU $FF
entLen EQU $0C23
* Code move tables are explained in file Reloc.s
tablIntrp DB cMove ;Move interpreter loader code & tables
DA LoadIntrp ;Code is address independent
DW pcLen
DA LIcode
Pg3Tbl DB cMove
DA AuxGo ;was $3D6
DW $0010 ; and $002A
DA pg3Stuff
DB cMove
DA look ;dest addr
DW $0002 ;# of bytes to move
DA dst ;src addr
DB cMove ;Move 128K test to zero page
DA Test128
DW End128
DA Strt128
DB cDone
Disp64 DB cMove
DW $D100 ;lang card bank 2
DW $0300 ;3 pages
DA SEL_0 ;$5A00
DB cDone
DispBB DB cMove
DA $D100 ;lang card bank 2
DW $0300
DA SEL_1 ;$5D00
DB cDone
DispGS DB cMove
DA $D100 ;lang card bank 2
DW $0300
DA SEL_2 ;$6000
DB cMove
DA DispAdr ;$1000
DW $0300
DA SEL_2 ;$6000
DB cDone
*-------------------------------------------------
* The following table is for moving the 64K version of
* the MLI to its execution address.
tabl64 DB cMove ;Relocate the interrupt/break/reset
DA IntHandler ; handler and associated vectors
DW $0065 ;Number of bytes to relocate
DA MLI_3 ;Source address of code to relocate
DB cMove ;Move preset 64K version of globals
DA Globals
DW $0100
DA MLI_1
DB cZero ;Clear buffers/workspace
DA orig ;dest
DW $0700 ;# of bytes to zero
DB cMove ;Move 64k version of MLI to language card
DA orig1 ;See #45..put rwts in lc bnk2 to make MLI_2
DW $2100 ;MLI length
DA MLI_2
DB cMove ;Move 64K version of
DA RWTS ; Disk ][ routines
DW $0700
DA XRW_0
DB cDone ;Clock moved later
TClkStuff DB cMove ;Lastly move/relocate thunderclock
DA ClockBegin ; whether needed or not
DW $007D
DW TCLOCK_0
DB cReloc ;Adjust slot addresses
DA ClockBegin
DW $0069
DA ClockBegin
DB $00
clock64 EQU *+2
DB $C1 ;Last changed by DevSrch to correct slot#
DB $C1
DB $00
DB cDone
********** see rev note #50 *********
cortClock DB cMove ;Cortland clock relocating table
DA ClockBegin ;Destination address
DW $007D ;Length of 125 bytes
DW CCLOCK_0 ;Source load address of driver
DB cDone
****************** see rev note #56 *************
*
* Let's load and jsr to the appletalk configuaration file "atinit"
* if it is found. If it is not found, just continue with the loading
* and running of the ".SYSTEM" file.
LIcode EQU *
JSR GoPro ;Make a get file info call to make
DB $C4 ; atInit file is there and is
DA gfiList ; of the proper file type
BCC GFI_ok ;Branch if call successful...
CMP #fileNotFound ;Was error "file not found"?
BEQ LoadInt
BNE ATLoadErr ;Otherwise fatal i/o error in loading atInit
GFI_ok LDA gfiType ;Now see if atInit file is of proper type...
CMP #$E2 ;Is it the correct file type?
BNE ATLoadErr ;Error if wrong file type!
JSR GoPro ;Open atInit file
DB $C8
DA atOpen ; parameter list...
BNE ATLoadErr ; branch if error...
LDA #$9F ;39.75K
STA rdLen+1
STZ rdLen
JSR GoPro
DB $CA
DA rdParm
BNE ATLoadErr
JSR GoPro
DB $CC
DA clParm
BNE ATLoadErr
LDA RDROM2 ;Put ROM on line for atInit....
JSR $2000 ;Call the atInit routine to set up appletalk stuff
LoadInt JMP GoLoadInt ;Go execute the .SYSTEM file
ATLoadErr LDX atErr
:1 LDA atErr,X
STA SLIN15,X
DEX
BNE :1
ATerrHang BEQ ATerrHang
atErr STR "Unable to load ATInit file"
gfiList EQU *-LIcode+LoadIntrp
DB $0A ;Parameter count
DA atInitName ;Pointer to "atinit" file name
DB $00 ;access
gfiType EQU *-LIcode+LoadIntrp
DB $00 ;File type
DS 13,0 ;Space for rest of parameters...
atOpen EQU *-LIcode+LoadIntrp
DB $03
DW atInitName ;Pointer to "atinit" file name
DA $1400 ;Address of I/O buffer
DB $01 ;Reference number hard coded since no other files
atInitName EQU *-LIcode+LoadIntrp
STR "atinit" ;Name of appletalk config file
GoLoadInt EQU *-LIcode+LoadIntrp
LDA #>ABuf ;Search directory already in
STA idxl+1 ; memory between $0C00 & $13FF
LDA #<ABuf+4 ;Start 1 entry past header
BNE AddEntLen ;Always
NxtEntry LDA idxl ;Calc next entry posn
AddEntLen CLC
ADC entLen ;Bump to next entry address
STA idxl
BCS PageCros ;Branch if page cross
ADC entLen ;Test for end of block
BCC NoCros ;Branch if definitely not page cross
LDA idxl+1
LSR ;End of block?
BCC NoCros ;Branch if not
CMP #$09 ;End of directory?
BNE :1 ;Branch if an interpreter file
JMP JustQuit ;No interpreter file
:1 LDA #$04 ;Reset index to first entry in next block
STA idxl
PageCros INC idxl+1 ;Bump to next page
NoCros LDY #$10 ;First off, check file type
LDA #$FF ;Must be ProDOS SYS file
EOR (idxl),Y
BNE NxtEntry ;Branch if not
TAY ;else check to see if active
LDA (idxl),Y ;(Y)=0 (stortype/namelen)
BEQ NxtEntry ;Branch if deleted file
AND #$0F ;Strip file 'kind'
STA pnBuf ;Save name's length
CMP #$08 ;Must be at least 'x.SYSTEM'
BCC NxtEntry ;Otherwise, ignore it
TAY ;Compare last 7 characters for '.SYSTEM'
LDX #7-1
LookIntrp LDA (idxl),Y
EOR iterP,X
ASL
BNE NxtEntry ;Branch if something else
DEY
DEX
BPL LookIntrp
LDY #$00 ;Move name to pathname buffer
MovIntrp INY
LDA (idxl),Y
STA pnBuf,Y
ORA #$80 ;Make it printable in case of error
STA ioMess+$11,Y
CPY pnBuf ;All characters moved?
BNE MovIntrp ;Nope
LDA #" " ;Save a space after name
STA ioMess+$12,Y
TYA ;Update error message length
ADC #$13 ;(carry was set)
STA ioErrLen
JSR GoPro ;Open interpreter file
DB $C8
DA opParm
BNE BadLoad
JSR GoPro ;Get file's length
DB $D1
DA efParm
BNE BadLoad
LDA eof+2 ;Make sure file will fit
BNE TooLong
LDA eof+1
CMP #$9F ;Max size is 39.75K
BCS TooLong
STA rdLen+1
LDA eof ;Read entire file
STA rdLen
JSR GoPro
DB $CA
DA rdParm
BEQ GoClos ;Branch if successful read
CMP #badBufErr ;Memory conflict?
BEQ TooLong
BNE BadLoad ;Report i/o error
GoClos JSR GoPro
DB $CC
DA clParm
BNE BadLoad ;(branch never, we hope)
***************************************************
* If we are booting on a //c and an escape is in the keyboard buffer
* then clear it so we dont interfere with start application
* (pizza accelerator chip requires ESC to shift speed down)
LDA cFlag-LIcode+LoadIntrp;Booting on a 2c?
BEQ Going ;Branch if not
LDA KBD ;Fetch last key in board (pending or not)
CMP #$9B ;ESCAPE character? (with bit 7 on)
BNE Going ;Branch if not
STA KBDSTROBE ;Clear keyboard strobe
Going LDA RDROM2 ;Enable Motherboard ROM
JMP $2000 ;GoInterP
cFlag DB $00 ;=1 if an apple 2c
*-------------------------------------------------
* Transfer control to the dispatch/selector
JustQuit EQU *-LIcode+LoadIntrp
JSR GoPro
DB $65
DW quitParm
BadLoad LDY ioErrLen ;Center the bad news
LDA #$27 ;Report no interpreter
SEC
SBC ioErrLen
LSR
ADC ioErrLen
TAX
:NoItrp LDA ioMess,Y
STA SLIN15,X
DEX
DEY
BPL :NoItrp
BMI Hang10
TooLong LDY #$1E
:loop LDA lgMess,Y
STA SLIN15+5,Y
DEY
BPL :loop
Hang10 BMI Hang10
*-------------------------------------------------
lgMess EQU *-LIcode+LoadIntrp
ASC "** System program too large **"
ioMess EQU *-LIcode+LoadIntrp
ASC "** Unable to load X.System *********"
ioErrLen EQU *-LIcode+LoadIntrp
DB $00
opParm EQU *-LIcode+LoadIntrp
DB $03
DA pnBuf ;pathname
DA $1400
DB $01
efParm EQU *-LIcode+LoadIntrp
DB $02
DB $01
eof EQU efParm+2
HEX 000000
rdParm EQU *-LIcode+LoadIntrp
DB $04
DB $01
DA $2000
rdLen EQU rdParm+4
DW $0000
DW $0000
clParm EQU *-LIcode+LoadIntrp
DB $01
DB $00
quitParm EQU *-LIcode+LoadIntrp
DB $04
DB $00 ;=$EE for enhanced quit
DW $0000 ;addr of pathname
DB $00 ;reserved
DW $0000 ;reserved
iterP EQU *-LIcode+LoadIntrp
ASC ".SYSTEM"
pcLen EQU *-LIcode
pg3Stuff EQU * ;This stuff goes on page 3
* ------------------- see rev note 15 --------------------------
*
* Locate between vectors in page 3 starting at $3F0
*
* Note: since this is treated as a subroutine from the MLI,
* nothing may use the stack in main ram area!!
*
* x = 5 from calling routine to move parameter bytes in the call
DW $FA59 ;mon_Break
DW $FF59 ;mon_Reset
DB $5A ;Powerup byte
JMP OLDRST ;'&' vector
JMP OLDRST ;mon_ctrl-Y vector
DB $00,$40,$00 ;mon_nmi
DA IrqEnt ;Interrupt vector to global page
LC1In LDA LCBANK1 ;Swap LC bank1 in
LDA LCBANK1
RTS
*-------------------------------------------------
WhichROM STZ apple ;Assume standard apple ][ first
LDX VERSION ;Look at the approved location...
CPX #$38 ;Apple ][? (actually is it autostart ROM?)
BEQ TestLCRAM ;Yes
LDA #$80 ;else try for apple //e
CPX #$06
BEQ MuchRAM ;Yes, //e
LDA #$40 ;If that fails, try ][+
CPX #$EA ;Must be one of these values...
BNE WhatsIt
LDX $FB1E ;If it passes as ][+, then
CPX #$AD ; it might be /// in emulation
BEQ MuchRAM
LDA #$D0 ;Mark it as 48k /// emulation!
CPX #$8A ; if it passes the test
BNE WhatsIt ;Branch always, well, maybe
NSMach SEC ;48K not allowed so apple ///
RTS ; emulation is not sufficient memory
WhatsIt LDA #$02 ;Machine unknown if we land here
STA (dst),Y
BNE FindRAM ;branch always
MuchRAM STA apple ;Save ROM id
TestLCRAM JSR LC1In ;Test for the presence of
LDA #$AA ; 'language' card RAM
STA $D000
EOR $D000 ;If it is there, result is zero
BNE NSMach ;Branch if it is not
LSR $D000 ;else check twice just to be sure
LDA #$55
EOR $D000
BNE NSMach ;Non-standard machine
LDA #$20 ;Indicate at LC RAM available
ORA apple
FindRAM JMP Test128 ;Go test for 128K
*-------------------------------------------------
* The code below is moved to $80 before execution
Test128 EQU $80 ;Use zpage for this routine
Strt128 STA apple ;Save accumulated value
BPL Not128 ;Branch if sure it's less than 128K
LDA #$EE ;First try storing in Aux Mem
STA WRCARDRAM ;Write to aux while on main ZPage
STA RDCARDRAM ;Set to read aux ram
STA $0C00 ;Check for sparse mem mapping
STA $0800
LDA $0C00 ;See if sparse memory -same value
CMP #$EE ; 1K away
BNE NoAux
ASL $0C00 ;May be sparse mem so change value
ASL ; & see what happens
CMP $0C00
BNE NoAux
CMP $0800
BNE AuxMem
NoAux SEC ;Sparse mapping so no aux mem
BCS Back2Main
AuxMem CLC ;There is aux mem
Back2Main STA WRMAINRAM ;Switch back to write main ram
STA RDMAINRAM ;Switch back main ram read
BCS Not128 ;Branch if not 128K
LDA apple ;else update identity of machine
ORA #$30 ;Indicate 128K present
STA apple
Not128 LDA look+1 ;Futs with pointer for apple test
SEC
SBC #$05 ;Should result in $FB if zpage is ok
STA look+1
BCS *+4 ;(to the CLC)
DEC look
CLC
RTS
End128 EQU *-Strt128 ;Byte count for routine move to zpage

372
MLI.SRC/RAM0.S Normal file
View File

@ -0,0 +1,372 @@
************************************************************
* *
* PRODOS 8 KERNEL 59.5K RAMDISK (REV-E) *
* *
* COPYRIGHT APPLE COMPUTER, INC., 1983-86 *
* *
* ALL RIGHTS RESERVED *
* *
************************************************************
* This module consist of 3 object files
TTL 'EXTENDED 80 COL RAMDISK'
ORG EnterCard
MX %11
* After the main routine has determined that the command
* is ok, and the block to be read/written is within
* range, it tranfers control to this routine. This routine
* 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
* card's language card
* $68-$7F :returns blocks $68-$7F in bank 2
* of card's language card
*
DoCmd LDA RD80COL ;Read 80STORE
PHA ;Save for later
STA CLR80COL ;Turn off 80STORE
LDX #$04 ;Move the params for our use
:loop LDA $42,X ;CMD,UNIT,BUFPTR,&BLOCK(lo)
STA tCmd,X ;->tCmd,tUnit,R2L,R2,R1
DEX
BPL :loop
AND FormatFlag ;Format the volume first time
BNE doCommand ; thru, or when requested
doFormat LDX blockNum ;Save R1 during format
LDA #>VBlock1 ;Block to be cleared
JSR ClrBuf1 ;ClrBuf clears all buffers
LDY #$03 ;Format volume in 2 chunks
:loop1 LDA VDir,Y
STA VBlock1+4,Y
DEY
BPL :loop1
LDA #$FE ;Set last block as unusable to protect vectors
STA BitMap+$F
TYA ;Set bitmap bits to $FF
LDY #$0E ;15 bytes to set
:loop2 STA BitMap,Y
DEY
BNE :loop2
STY BitMap ;First byte=0
LDY #$07 ;Do other chunk
:loop3 LDA Access,Y
STA VBlock1+34,Y
DEY
BPL :loop3
LDA FormatFlag ;If 0, set to FF
BNE DFX ;else exitcard
STY FormatFlag ;Y=FF, won't format next time
STX R1 ;restore R1
* Now use the requested block number to determine
* which routine performs the transfer
doCommand ASL R1 ;Block requested->page requested
LDA R1 ;Get page requested
CMP #$BF ;In Language card?
BCS XferLC1 ;Yes, do it
CMP #$06 ;Bit map?
BNE :1
JMP TBMap ;Yes, transfer bitmap
:1 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 two-stage move: into the temp
* buffer and then to its real destination.
XferLC1 TAX ;Save R1 for later
JSR SetPtr ;Get direction
PHP ;Save direction
BCS LCwrt ;It is a write
LCrd TXA ;Get R1 back
CMP #$CF ;Which bank is it in?
BCS XferLC2 ;In main bank
ORA #$10 ;In secondary bank
BNE XferLC ;Branch always
XferLC2 STA LCBANK2 ;Turn on main $D000
STA LCBANK2
XferLC STA R1 ;Restore R1
LDA R2H ;Save R2 for later
PHA
LDX R2L
STA SETALTZP ;Now switch to other ZP
LDA #>ABuf ;Set R2 to Abuf
STA R2H
LDA #<ABuf
STA R2L
JSR SetPtr
TAY
:CpyLoop LDA (A1),Y ;Move A1,A2 to A4,A3
STA (A4),Y
LDA (A2),Y
STA (A3),Y
DEY
BNE :CpyLoop
STA SETSTDZP ;Restore normal ZP
STX R2L
PLA ;Restore R2
STA R2H
PLP ;Get direction
DFX BCS XLCwrt ;Write, done with move
STA LCBANK1 ;Now switch MLI part of LC in
STA LCBANK1
JSR BlockDo0 ;Read, transfer Abuf to main
XLCwrt JMP ExitCard
LCwrt JSR BlockDo0 ;Transfer main to Abuf
JMP LCrd ;Transfer Abuf to Lang card
*-------------------------------------------------
* BLOCKDo transfers a block between main memory and the
* 64K card. R1 contains the page address of the block
* in the card; R2 contains the page address of the block
* in main memory. The address in main memory is always
* in the language card, so the language card is always
* switched in. If CMD is 2, a write is done (R2->R1);
* if CMD is 1, a read is done (R1->R2).
BlockDo0 LDA #>ABuf ;Set up R1 = Abuf
BlockDo1 STA R1
BlockDo JSR SetPtr ;set pointers
BCS BlockWrite ;it's a write
STA WRMAINRAM ;transfer buffer directly to main ram
TAY ;0 left from SETPTR
:CpyLoop LDA (A1),Y ;Transfer A1,A2 to A4,A3
STA (A4),Y
LDA (A2),Y
STA (A3),Y
DEY
BNE :CpyLoop
STA WRCARDRAM ;Back the way it was
DoneWrt RTS ;MainWrt returns here
BlockWrite 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 to detect read or write.
SetPtr LDA tCmd ;The rest depends on read
LSR ;or write. Which is it?
BCS CmdWrt ;It's write
CmdRd LDA R2H ;Get dest page
STA A4+1 ;1st dest page (MOVE)
STA A3+1 ;2nd dest page
LDA R2L ;Low byte dest page
STA A4 ;1st dest page low
STA A3 ;2nd dest page low
LDA R1 ;Get source page
STA A1+1 ;1st source page
STA A2+1 ;2nd source page
LDA #$00 ;Source page aligned
STA A1 ;1st source page
STA A2 ;2nd source page
BEQ CmdBoth ;Update second pages
CmdWrt LDA R2H ;Get source page
STA A1+1 ;1st source page
STA A2+1 ;2nd source page
LDA R2L ;Get source page low
STA A1 ;1st source page low
STA A2 ;2nd source page low
LDA R1 ;Get dest page
STA A4+1 ;1st dest page
STA A3+1 ;2nd dest page
LDA #$00 ;Dest page aligned
STA A4 ;1st dest page
STA A3 ;2nd dest page
CmdBoth INC A2+1 ;Update 2nd source page
INC A3+1 ;Update 2nd dest page
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 ABUF with 0's
JSR BlockDo ;Transfer them 0's
JMP ExitCard ; & return
*-------------------------------------------------
* ClrBuf fills the buffer indicated by R1 to 0's
* Should only be called on a read or format.
ClrBuf0 LDA #>ABuf ;ABUF is temp buffer
ClrBuf1 STA R1 ;Assign to BLOCK
ClrBuf2 JSR SetPtr ;Set pointers
TAY ;A set to 0 by setptr
:CpyLoop STA (A1),Y
STA (A2),Y
DEY
BNE :CpyLoop
RTS
*-------------------------------------------------
* TREG maps the requested block into the aux card
* so that 8K data files will be contiguous (the index
* blocks will not be placed within data).
TReg CMP #$04 ;page 4 = vdir
BNE :1 ;Not vdir, continue
LDA #$07 ;Else xfer block 7
BNE GoTimes2
***************** See Rev Note #43 ********************
:1 CMP #$0F ;If any page<f (<block 8) requested
BCC TZip ; it is invalid
LDX #$00 ;X contains number of iterations
LDA blockNum ;Use true block number
CMP #$5D ;Beyond 8K blocks?
BCC TReg1 ;No, do normal
SBC #$50 ;else subtract offset
GoTimes2 JMP Times2 ;and multiply by 2
* Determine which 8K chunk it is in, place in X;
* block offset into chunk goes into Y.
TReg1 SEC
SBC #$08 ;block = block -6
:loop CMP #$11 ;If <=17, done
BCC :3 ;Yup, got iteration
SBC #$11 ;else block =block -17
INX ;Count iteration
BPL :loop ;Branch always
DB $00 ;Just in case (CRASH!)
* If remainder is 1, it's an index block: start index
* blocks at $1000,$2000..$19FF)
* If remainder is 0, 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)
:3 TAY ;Remainder in Y
CPY #$01 ;Is it index block?
BNE :4 ;No
TXA ;Index = 2*(8+X)
CLC
ADC #$08
BNE Times2 ;Multiply by 2
:4 INX ;Need iteration+1
TXA ;Page = 2 * (16 + 8X)
ASL
ASL
ASL
ASL
STA R1
TYA ;Get offset into 8K chunk
BEQ :5 ;if 0, no offset
DEY ;else offset = 2 * Y
TYA
:5 CLC
ADC R1
Times2 ASL ;A=2*A
JSR BlockDo1 ;Store in R1 and xfer
JMP ExitCard ; & return
*-------------------------------------------------
* When Block 3 is requested, the bitmap is returned. The
* Real bitmap is only 16 bytes long (BITMAP); the rest of
* the block is synthesized. The temporary buffer at $800
* is used to build/read a full size bitmap block.
TBMap LDA #>ABuf ;Use temporary buffer as BLOCK
STA R1
JSR SetPtr ;Set pointers/test read-write
BCS BitWrt ;Its a write!
BitRd JSR ClrBuf2
LDY #$0F ;Now put real bitmap there
:CpyLoop LDA BitMap,Y
STA (A1),Y
DEY
BPL :CpyLoop
JSR BlockDo ;Move temp buf to user buf
JMP ExitCard
BitWrt JSR BlockDo ;move user buf to temp buf
JSR SetPtr ;Set pointers
LDY #$0F ;move temp buf to bitmap
:CpyLoop LDA (A4),Y ;(pointer set by SETPTR)
STA BitMap,Y
DEY
BPL :CpyLoop
JMP ExitCard
*-------------------------------------------------
FormatFlag DB $00 ;Not formatted yet
tCmd DS 1,0 ;Command byte
tUnit DS 1,0 ;Unit byte (Not used)
R2L DS 1,0 ;Low byte of user buffer
R2H DS 1,0 ;Hi byte of user buffer
R1 DS 1,0 ;Page requested
BitMap EQU *
HEX 00FFFFFF ;Blocks 0-7 used
HEX FFFFFFFF
HEX FFFFFFFF
HEX FFFFFFFE
VDir EQU * ;Start of virt dir
TypeNameLen DB $F3 ;Storage type F, namelength 3
ASC 'RAM'
Access DB $C3 ;Destroy, Rename, Read enabled
DB $27 ;entry length
DB $0D ;Entries/Blk
DW $0000 ;File Count
DW $0003 ;Map_Pointer=Block 3
DB $7F ;Total_Blocks=128 blocks
*-------------------------------------------------
ExitCard LDA LCBANK1 ;Restore lang card
LDA LCBANK1
PLA ;Get 80STORE
BPL Ex0 ;80STORE wasn't on
STA SET80COL
Ex0 JMP $03EF ;Jump around PassIt (3ED,3EE)
DS $3EF-*,0 ;Pad thru $3EE
LDA #<NoErr ;Set up return to NoErr
STA PassIt
LDA #>NoErr
Ex1 STA PassIt+1 ;Also used by BlockWrite
CLC ;Transfer card to main
CLV ;Use standard zp/stk
JMP Xfer ;There's no place like home...
* NOTE: The previous section of code MUST NOT use $3FE & $3FF
* since the Interrupt Vector must go there if AUX interrupts
* are to be used.
DS 2,0 ;Pad to end of mem page

43
MLI.SRC/RAM1.S Normal file
View File

@ -0,0 +1,43 @@
**************************************************
ORG Srce
MX %11
* Move LCSrc to LCDest
LDY #$99 ;Move $9A bytes
:MovLoop LDA LCSrc,Y ;Get a byte of source
STA LCDest,Y
DEY
CPY #$FF
BNE :MovLoop
* Move RAMSrc to RAMDest
LDX #<RAMsrc
STX A1 ;Source low
DEX ;Source end low
STX A2
LDX #>RAMsrc ;Source high
STX A1+1
INX
STX A2+1 ;End high
LDA #<RAMdest
STA A4
LDA #>RAMdest
STA A4+1
SEC ;RAM to Card
JSR AuxMove ;Use built-in rtn to move
* Now install it into the system
LDA #<LCdest ;Put LC address into
STA DevAdr32 ; Slot 3, drive 2
LDA #>LCdest
STA DevAdr32+1
INC DevCnt
LDX DevCnt
LDA #%10110000+$F ;Unit # of /RAM ($B0+$F)
STA DevLst,X ;NB. $B0 ($30+hi-bit set)
RTS
DS \,0 ;Pad to end of mem page

98
MLI.SRC/RAM2.S Normal file
View File

@ -0,0 +1,98 @@
**************************************************
* Ram Disk function Handler
ORG LCDest
MX %11
EnterRAM CLD ;/RAM entry point
LDX #12-1 ;Save 12 bytes of params
:CpyLoop1 LDA A1,X
STA A1L1,X
DEX
BPL :CpyLoop1
LDX #1 ;Save XFER Vectors too
:CpyLoop2 LDA PassIt,X
STA SP1,X
DEX
BPL :CpyLoop2
LDA dhpCmd ;Get command
BEQ STAT ;0=STATUS
CMP #$04 ;Check for command too high
BCS IOErr ;If it is, IO ERR
EOR #$03 ;0=FORMAT,2=READ,1=WRITE
STA $42 ;CMD=>0=Format,2=Read,1=Write
BEQ Format ;Format the volume
LDY blockNum+1 ;Check for enormous blocknum
BNE IOErr ;I/O error if too big
LDA blockNum
BMI IOErr ;Largest block is $7F
* At this point, control is passed to the code in the
* alternate 64K. It is used for read, write, and
* format. After the request is completed, control
* is always passed back to NoErr.
Format LDA #<EnterCard ;Card entry point
STA PassIt ;Figure it out on card
LDA #>EnterCard
GoCard STA PassIt+1 ;Also used by MainWrt
SEC ;RAM->Card
CLV ;start with original z.p.
JMP Xfer ;transfer control
IOErr LDA #drvrIOError ;Get err num
BNE ErrOut ; & return (always)
WPErr LDA #drvrWrtProt
ErrOut SEC ;Flag error
BCS Restore ;Restore cmd and unitnum
STAT EQU *
NoErr LDA #$00 ;No error
CLC ;Flag no error
Restore PHP ;Save status
PHA ;Save error code
LDX #12-1 ;Restore 12 bytes of params
:CpyLoop LDA A1L1,X
STA A1,X
DEX
BPL :CpyLoop
LDA SP1 ;Restore XFER params
BIT $6060 ;This instruction is to put
STA PassIt ; an RTS at $FF58 as in ROM
LDA SP1+1
STA PassIt+1
* -------------------- See rev note 21 -----------------------
PLA ;Get error
PLP ;Get status
RTS
*-------------------------------------------------
* Write file buffer in MAIN to AUX block
* Assume A1,A2,A3,A4 ptrs are set in Aux Driver
MainWrt STA WRCARDRAM ;Xfer data to card
LDY #$00
:MovLoop LDA (A1),Y ;Pointers set in card by SETPTR
STA (A4),Y
LDA (A2),Y
STA (A3),Y
DEY
BNE :MovLoop
STA WRMAINRAM ;Done writing Card
LDA #<DoneWrt
STA PassIt
LDA #>DoneWrt
JMP GoCard
SP1 DS 2,0
A1L1 DS 12,0 ;12 bytes of storage
DS 11,0 ;Pad to int handler

692
MLI.SRC/READWRITE.S Normal file
View File

@ -0,0 +1,692 @@
**************************************************
* READ Call
Read JSR MovDBuf ;First transfer buffer adr & request count to a
JSR MovCBytes ; more accessible location, also get fcbAttr, CLC
PHA ;Save attributes for now
JSR CalcMark ;Calc mark after read, test mark>eof
PLA ;Carry Set indicates end mark>eof
AND #readEnable ;Test for read enabled first
BNE :1 ;Branch if ok to read
LDA #invalidAccess ;Report illegal access
BNE GoFix1 ;Branch always taken
:1 BCC Read2 ;Branch if result mark<eof
; Adjust request to read up to (but not including) end of file.
LDY fcbPtr
LDA fcb+fcbEOF,Y ;Result= (eof-1)-position
SBC tPosll
STA cBytes
STA rwReqL
LDA fcb+fcbEOF+1,Y
SBC tPoslh
STA cBytes+1
STA rwReqH
ORA cBytes ;If both bytes are zero, report EOF error
BNE NotEOF
LDA #eofEncountered
GoFix1 JMP ErrFixZ
Read2 LDA cBytes
ORA cBytes+1
BNE NotEOF ;Branch if read request definitely non-zero
GoRdDone JMP RWDone ;Do nothing
NotEOF JSR ValDBuf ;Validate user's data buffer range
BCS GoFix1 ;Branch if memory conflict
JSR GfcbStorTyp ;Get storage type
CMP #tree+1 ;Now find if it's a tree or other
BCC TreeRead ;Branch if a tree file
JMP DirRead ;Othewise assume it's a directory
TreeRead JSR RdPosn ;Get data pointer set up
BCS GoFix1 ;Report any errors
JSR PrepRW ;Test for newline, sets up for partial read
JSR ReadPart ;Move current data buffer contents to user area
BVS GoRdDone ;Branch if request is satisfied
BCS TreeRead ;Carry set indicates newline is set
LDA rwReqH ;Find out how many blocks are to be read
LSR ;If less than two,
BEQ TreeRead ; then do it the slow way
STA bulkCnt ;Save bulk block count
JSR GetFCBStat ;Make sure current data area doesn't need writing before
AND #dataMod ; resetting pointer to read directly into user's area.
BNE TreeRead ;Branch if data need to be written
* Setup for fast Direct Read rtn
STA ioAccess ; to force first call thru all device handler checking
LDA userBuf ;Make the data buffer the user's space
STA dataPtr
LDA userBuf+1
STA dataPtr+1
RdFast JSR RdPosn ;Get next block directly into user space
BCS ErrFix ;Branch on any error
RdFastLoop INC dataPtr+1
INC dataPtr+1 ;Bump all pointers by 512 (one block)
DEC rwReqH
DEC rwReqH
INC tPoslh
INC tPoslh
BNE :11 ;Branch if position does not get to a 64K boundary
INC tPosHi ;Otherwise, must check for a 128K boundary
LDA tPosHi ;If mod 128K has been
EOR #$01
LSR ; reached, set Carry
:11 DEC bulkCnt ;Have we read all we can fast?
BNE :12 ;Branch if more to read
JSR FixDataPtr ;Go fix up data pointer to xdos buffer
LDA rwReqL ;Test for end of read
ORA rwReqH ;Are both zero?
BEQ RWDone
BNE TreeRead ;No
:12 BCS RdFast
LDA tPosHi ;Get index to next block address
LSR
LDA tPoslh
ROR
TAY ;Index to address is int(pos/512)
LDA (tIndex),Y ;Get low address
STA blockNum
INC tIndex+1
CMP (tIndex),Y ;Are both hi and low addresses the same?
BNE RealRd ;No, it's a real block address
CMP #$00 ;Are both bytes zero?
BNE RealRd ;Nope -- must be real data
STA ioAccess ;Don't do repeatio just after sparse
BEQ NoStuff ;Branch always (carry set)
RealRd LDA (tIndex),Y ;Get high address byte
CLC
NoStuff DEC tIndex+1
BCS RdFast ;Branch if no block to read
STA blockNum+1
LDA ioAccess ;Has first call gone to device yet?
BEQ RdFast ;Nope, go thru normal route...
CLC
PHP ;Interupts cannot occur while calling dmgr
SEI
LDA dataPtr+1 ;Reset hi buffer address for device handler
STA bufPtr+1
JSR DMgr
BCS :31 ;Branch if error
PLP
BCC RdFastLoop ;No errors, branch always
:31 PLP ;Restore interupts
ErrFix PHA ;Save error code
JSR FixDataPtr ;Go restore data pointers, etc...
PLA
ErrFixZ PHA ;Save error code
JSR RWDone ;Pass back number of bytes actually read
PLA
SEC ;Report error
RTS
*-------------------------------------------------
* I/O finish up
RWDone LDY #c_xferCnt ;Return total # of bytes actually read
SEC ;This is derived from cbytes-rwreq
LDA cBytes
SBC rwReqL
STA (parm),Y
INY
LDA cBytes+1
SBC rwReqH
STA (parm),Y
JMP RdPosn ;Leave with valid position in FCB
*-------------------------------------------------
* Set up buffer indexing
* Exit
* C=1 newline enabled
* (Y) = index to first data byte to be xferred
* (X) = LOB of request count
PrepRW LDY fcbPtr ;Adjust pointer to user's buffer
SEC ; to make the transfer
LDA userBuf
SBC tPosll
STA userBuf
BCS :1 ;Branch if no adjustment to hi addr needed
DEC userBuf+1
:1 LDA fcb+fcbNLMask,Y ;Test for new line enabled
CLC
BEQ NoNewLine ;Branch if newline is not enabled
SEC ;Carry set indicates newline enabled
STA nlMask
LDA fcb+fcbNewLin,Y ;Move newline character
STA nlChar ; to more accessible spot
NoNewLine LDY tPosll ;Get index to first data byte
LDA dataPtr ;Reset low order of posPtr to beginning of page
STA posPtr
LDX rwReqL ; & lastly get low order count of requested bytes
RTS ;Return statuses...
*-------------------------------------------------
* Copy from I/O blk buffer to data buffer
* Exit if : 1. len goes to zero
* 2. next block is needed
* 3. newLine char is found
* Exit
* V = 1 - done
* V = 0 - next blk needed
ReadPart TXA ;(X)=low count of bytes to move
BNE :1 ;Branch if request is not an even page
LDA rwReqH ;A call of zero bytes should never get here!
BEQ SetRdDone ;Branch if nothin' to do
DEC rwReqH
:1 DEX
* NB. In order for the same Y-reg to be used below,
* the ptr to user's buffer had been adjusted (see
* code in PrepRW rtn)
RdPart LDA (posPtr),Y ;Move data to user's buffer
STA (userBuf),Y ; one byte at a time
BCS TestNewLine ;Let's test for newline first!
RdPart2 TXA ;Note: (X) must be unchanged from TestNewLine!
BEQ EndReqChk ;See if read request is satisfied...
RdPart1 DEX ;Decr # of bytes left to move
INY ;Page crossed?
BNE RdPart ;No, move next byte
LDA posPtr+1 ;Test for end of buffer
INC userBuf+1 ; but first adjust user buffer
INC tPoslh ; pointer and position
BNE :11
INC tPosHi
:11 INC posPtr+1 ;& sos buffer high address
EOR dataPtr+1 ;(Carry has been cleverly undisturbed.)
BEQ RdPart ;Branch if more to read in buffer
CLV ;Indicate not finished
BVC RdPartDone ;Branch always
EndReqChk LDA rwReqH ;NB. (X)=0
BEQ RdReqDone ;Branch if request satisfied
INY ;Done with this block of data?
BNE :31 ;No, adjust high byte of request
LDA posPtr+1 ;Maybe-check for end of block buffer
EOR dataPtr+1 ;(don't disturb carry)
BNE :32 ;Branch if hi count can be dealt with next time
:31 DEC rwReqH ;Decr count by 1 page
:32 DEY ;Restore proper value to Y-reg
BRA RdPart1
TestNewLine LDA (posPtr),Y ;Get last byte transfered again
AND nlMask ;Only bits on in mask are significant
EOR nlChar ;Have we matched newline character?
BNE RdPart2 ;No, read next
RdReqDone INY ;Adjust position
BNE SetRdDone
INC userBuf+1 ;Bump pointers
INC tPoslh
BNE SetRdDone
INC tPosHi
SetRdDone BIT SetVFlag ;(set V flag)
RdPartDone STY tPosll ;Save low position
BVS :41
INX ;Leave request as +1 for next call
:41 STX rwReqL ; & remainder of request count.
PHP ;Save statuses
CLC ;Adjust user's low buffer address
TYA
ADC userBuf
STA userBuf
BCC :42
INC userBuf+1 ;Adjust hi address as needed
:42 PLP ;Restore return statuses
SetVFlag RTS ;(this byte <$60> is used to set V flag)
*-------------------------------------------------
* Cleanup after direct I/O
FixDataPtr LDA dataPtr ;Put current user buffer
STA userBuf ; address back to normal
LDA dataPtr+1
STA userBuf+1 ;Bank pair byte should be moved also
LDY fcbPtr ;Restore buffer address
JMP FndFCBuf
*-------------------------------------------------
* Read directory file...
DirRead JSR RdPosn
BCS ErrDirRd ;Pass back any errors
JSR PrepRW ;Prepare for transfer
JSR ReadPart ;Move data to user's buffer
BVC DirRead ;Repeat until request is satisfied
JSR RWDone ;Update FCB as to new position
BCC :1 ;Branch if all is well
CMP #eofEncountered ;Was last read to end of file?
SEC ;Anticipate some other problem
BNE :Ret ;Branch if not EOF error
JSR SavMark
JSR ZipData ;Clear out data block
LDY #$00 ;Provide dummy back pointer for future re-position
LDX fcbPtr ;Get hi byte of last block
:loop LDA fcb+fcbDataBlk,X
STA (dataPtr),Y
LDA #$00 ;Mark current block as imposible
STA fcb+fcbDataBlk,X
INX
INY ;Bump indexes to do both hi & low bytes
CPY #$02
BNE :loop
:1 CLC ;Indicate no error
:Ret RTS
ErrDirRd JMP ErrFixZ
*-------------------------------------------------
* Copy caller's I/O len
* Exit
* (A)=attributes
* (Y)=(fcbptr)
MovCBytes LDY #c_reqCnt ;Move request count
LDA (parm),Y ; to a more accessible location
STA cBytes
STA rwReqL
INY
LDA (parm),Y
STA cBytes+1
STA rwReqH
LDY fcbPtr ;Also return (Y)=val(fcbptr)
LDA fcb+fcbAttr,Y ; & (A)=attributes
CLC ; & carry clear...
RTS
*-------------------------------------------------
* Point userBuf ($4E,$4F) to caller's data buffer
* Exit
* (A) = file's storage type
MovDBuf LDY #c_dataBuf ;Move pointer to user's buffer to bfm
LDA (parm),Y
STA userBuf
INY
LDA (parm),Y
STA userBuf+1
GfcbStorTyp LDY fcbPtr ;Also return storage type
LDA fcb+fcbStorTyp,Y;(on fall thru)
RTS
*-------------------------------------------------
* Copy file mark, compute and compare end mark
CalcMark LDX #$00 ;This subroutine adds the requested byte
LDY fcbPtr
CLC
:loop LDA fcb+fcbMark,Y ;Count to mark, and returns sum
STA tPosll,X ; in scrtch and also returns mark in tPos
STA oldMark,X ; and oldMark
ADC cBytes,X
STA scrtch,X ;On exit: Y, X, A=unknown
TXA ;Carry set indicates scrtch>eof
EOR #$02 ;(cBytes+2 always = 0)
BEQ EOFtest
INY
INX
BNE :loop ;Branch always
EOFtest LDA scrtch,X ;New mark in scrtch!
CMP fcb+fcbEOF,Y ;Is new position > eof?
BCC :Ret ;No, proceed
BNE :Ret ;Yes, adjust 'cBytes' request
DEY
DEX ;Have we compared all three bytes?
BPL EOFtest
:Ret RTS
*-------------------------------------------------
* Set new mark & eof
WrErrEOF JSR Plus2FCB ;Reset EOF to pre-error position
:loop LDA oldEOF,X ;Place oldEOF back into fcb
STA fcb+fcbEOF,Y
LDA oldMark,X ;Also reset mark to last best write position
STA fcb+fcbMark,Y
STA scrtch,X ; & copy mark to scrtch for
DEY ; test of EOF less than mark
DEX
BPL :loop
JSR Plus2FCB ;Get pointers to test EOF<mark
JSR EOFtest ;Carry set means mark>EOF!!
* Drop into WrAdjEOF to adjust EOF to mark if necessary.
WrAdjEOF JSR Plus2FCB ;Get (Y)=fcbPtr+2, (X)=2,(A)=(Y)
:loop1 LDA fcb+fcbEOF,Y ;Copy EOF to oldEOF
STA oldEOF,X
BCC :1 ; & if carry set...
LDA scrtch,X ; copy scrtch to fcb's EOF
STA fcb+fcbEOF,Y
:1 DEY
DEX ;Copy all three bytes
BPL :loop1
RTS
*-------------------------------------------------
* Set 3-byte indices
* Exit
* (A)=(Y)=(fcbPtr)+2
* (X)=2
Plus2FCB LDA #$02
TAX
ORA fcbPtr
TAY
RTS
**************************************************
* WRITE Call
Write EQU * ;First determine if requested
JSR MovCBytes ; write is legal
PHA ;Save attributes temporarily
JSR CalcMark ;Save a copy of EOF to oldEOF, set/clr Carry
JSR WrAdjEOF ; to determine if new mark > EOF
PLA ;Get attributes again
AND #writeEnable
BNE Write1 ;It's write enabled
ErrAccess LDA #invalidAccess ;Report illegal access
BNE WrtError ;Always
Write1 JSR TestWrProt ;Otherwise, ensure device is not write protected
BCS WrtError ;Report write potected and abort operation
LDA cBytes
ORA cBytes+1 ;Anything to write?
BNE :1 ;branch if write request definitely non-zero
JMP RWDone ;Do nothing
:1 JSR MovDBuf ;Move pointer to user's buffer to bfm
CMP #tree+1 ; zpage area, also get storage type
BCS ErrAccess ;If not tree, return an access error!
TreeWrite JSR RdPosn ;Read block we're in
BCS WrtError
JSR GetFCBStat ;Get file's status
AND #dataAloc+idxAloc+topAloc;Need to allocate?
BEQ TreeWrt1 ;No
LDY #$00 ;Find out if enough disk space is available
:loop INY ; for indexes and data block
LSR ;Count # of blks needed
BNE :loop
STY reqL ;Store # of blks needed
STA reqH ;(A)=0
JSR TestFreeBlk
BCS WrtError ;Pass back any errors
JSR GetFCBStat ;Now get more specific
AND #topAloc ;Are we lacking a tree top?
BEQ TestSapWr ;No, test for lack of sapling level index
JSR MakeTree ;Go allocate tree top and adjust file type
BCC AllocDataBlk ;Continue with allocation of data block
WrtError PHA ;Save error
JSR ErrFixZ
JSR WrErrEOF ;Adjust EOF and mark to pre-error state
PLA ;Restore error code
SEC ;Flag error
RTS
TestSapWr JSR GetFCBStat ;Get status byte again
AND #idxAloc ;Do we need a sapling level index block?
BEQ AllocDataBlk ;No, assume it's just a data block needed
JSR AddNewIdxBlk ;Go allocate an index block and update tree top
BCS WrtError ;Return any errors
AllocDataBlk JSR AllocWrBlk ;Go allocate for data block
BCS WrtError
JSR GetFCBStat ;Clear allocation required bits in status
ORA #idxMod ; but first tell 'em index block is dirty
AND #$FF-dataAloc-idxAloc-topAloc;Flag these have been allocated
STA fcb+fcbStatus,Y
LDA tPosHi ;Calculate position within index block
LSR
LDA tPoslh
ROR
TAY ;Now put block address into index block
INC tIndex+1 ;High byte first
LDA scrtch+1
TAX
STA (tIndex),Y
DEC tIndex+1 ;(Restore pointer to lower page of index block)
LDA scrtch ;Get low block address
STA (tIndex),Y ;Now store low address
LDY fcbPtr ;Also update file control block to indicate
STA fcb+fcbDataBlk,Y; that this block is allocated
TXA ;Get high address again
STA fcb+fcbDataBlk+1,Y
TreeWrt1 JSR PrepRW ;Write on
JSR WrtPart
BVC TreeWrite
JMP RWDone ;Update FCB with new position
*-------------------------------------------------
* Copy write data to I/O blk
* Logic is similar to ReadPart rtn
* Exit
* V = 1 - done
* V = 0 - More to write
WrtPart TXA
BNE WrtPart1 ;Branch if request is not an even page
LDA rwReqH ;A call of zero bytes should never get here!
BEQ SetWrDone ;Do nothing!
DEC rwReqH
WrtPart1 DEX
LDA (userBuf),Y ;Move data from user's buffer
STA (posPtr),Y ; one byte at a time
TXA
BEQ EndWReqChk
WrtPart2 INY ;Page crossed?
BNE WrtPart1 ;No, move next byte
LDA posPtr+1 ;Test for end of buffer
INC userBuf+1 ; but first adjust user buffer
INC tPoslh ; pointer and position
BNE :1
INC tPosHi
* Don't wrap around on file!
BNE :1
LDA #outOfRange ; Say out of range if >32 meg
BNE WrtError ;Always
:1 INC posPtr+1 ; and sos buffer high address
EOR dataPtr+1 ;(carry has been cleverly undisturbed.)
BEQ WrtPart1 ;Crunch if more to write to buffer
CLV ;Indicate not finished
BVC WrPartDone ;Branch always
EndWReqChk LDA rwReqH
BEQ WrtReqDone ;Branch if request satisfied
INY ;Are we done with this block of data?
BNE :11 ;Branch if not
LDA posPtr+1
EOR dataPtr+1 ;While this is redundant, it's necessary for
BNE :12 ; proper adjustment of request count
:11 DEC rwReqH ;(not finished- ok to adjust hi byte.)
:12 DEY ;Reset modified Y-reg
BRA WrtPart2
WrtReqDone INY ; and position
BNE SetWrDone
INC userBuf+1 ;bump pointers
INC tPoslh
BNE SetWrDone
INC tPosHi
SetWrDone BIT SetVFlag ;(set V flag)
WrPartDone STY tPosll ;Save low position
STX rwReqL ; and remainder of request count
PHP ;Save statuses
JSR GetFCBStat
ORA #dataMod+useMod
STA fcb+fcbStatus,Y
CLC ;Adjust user's low buffer address
LDA tPosll
ADC userBuf
STA userBuf
BCC :21
INC userBuf+1 ;Adjust hi address as needed
:21 JSR FCBUsed ; Set directory flush bit
PLP ;Restore return statuses
RTS
*-------------------------------------------------
* Make a tree file by adding a new master index blk
MakeTree JSR SwapDown ;First make curr 1st blk an entry in new top
BCS ErrMakeTree ;Return any errors
JSR GfcbStorTyp ;Find out if storage type has been changed to 'tree'
;(if not, assume it was originally a seed and
CMP #tree ; both levels need to be built
BEQ MakeTree1 ; Otherwise, only an index need be allocated)
JSR SwapDown ;Make previous swap a sap level index block
BCS ErrMakeTree
MakeTree1 JSR AllocWrBlk ;Get another block address for the sap level index
BCS ErrMakeTree
LDA tPosHi ;Calculate position of new index block
LSR ; in the top of the tree
TAY
LDA scrtch ;Get address of newly allocated index block again
TAX
STA (tIndex),Y
INC tIndex+1
LDA scrtch+1
STA (tIndex),Y ;Save hi address
DEC tIndex+1
LDY fcbPtr ;Make newly allocated block the current index block
STA fcb+fcbIdxBlk+1,Y
TXA
STA fcb+fcbIdxBlk,Y
JSR WrFCBFirst ;Save new top of tree
BCS ErrMakeTree
JMP ZeroIndex ;Zero index block in user's i/o buffer
*-------------------------------------------------
* Add new index blk
AddNewIdxBlk JSR GfcbStorTyp ;Find out if we're dealing with a tree
CMP #seedling ;If seed then an adjustment to file type is necessary
BEQ SwapDown ;Branch if seed
JSR RdFCBFst ;Otherwise read in top of tree.
BCC MakeTree1 ;Branch if no error
ErrMakeTree RTS ;Return errors
* Add a higher index level to file
SwapDown EQU * ;Make current seed into a sapling
JSR AllocWrBlk ;Allocate a block before swap
BCS SwapErr ;Return errors immediately
LDY fcbPtr ;Get previous first block
LDA fcb+fcbFirst,Y ; address into index block
PHA ;Save temporarly while swapping in new top index
LDA scrtch ;Get new block address (low)
TAX
STA fcb+fcbFirst,Y
LDA fcb+fcbFirst+1,Y
PHA
LDA scrtch+1 ; and high address too
STA fcb+fcbFirst+1,Y
STA fcb+fcbIdxBlk+1,Y;Make new top also the current index in memory
TXA ;Get low address again
STA fcb+fcbIdxBlk,Y
INC tIndex+1 ;Make previous the first entry in sub index
PLA
STA (tIndex)
DEC tIndex+1
PLA
STA (tIndex)
JSR WrFCBFirst ;Save new file top
BCS SwapErr
JSR GfcbStorTyp ;Now adjust storage type by adding 1
ADC #$01 ; (thus seed becomes sapling becomes tree)
STA fcb+fcbStorTyp,Y
LDA fcb+fcbStatus,Y ;Mark storage type modified
ORA #storTypMod
STA fcb+fcbStatus,Y
CLC ;Return 'no error' status
SwapErr RTS
*-------------------------------------------------
AllocWrBlk JSR Alloc1Blk ;Allocate 1 block
BCS AlocErr
JSR GetFCBStat ;Mark usage as modified
ORA #useMod
STA fcb+fcbStatus,Y
LDA fcb+fcbBlksUsed,Y;Bump current usage count by 1
CLC
ADC #$01
STA fcb+fcbBlksUsed,Y
LDA fcb+fcbBlksUsed+1,Y
ADC #$00
STA fcb+fcbBlksUsed+1,Y
WrOK CLC ;Indicate no error
AlocErr RTS ;All done
*-------------------------------------------------
* Do Status if not I/O yet
TestWrProt JSR GetFCBStat ;Check for a 'never been modified' condition
AND #useMod+dataMod+idxMod+eofMod
BNE WrOK ;Ordinary RTS if known write ok
LDA fcb+fcbDevNum,Y ;Get file's device number
STA DevNum ;Get current status of block device
* Status call
TestWrProtZ STA unitNum ;Make the device status call
LDA blockNum+1
PHA
LDA blockNum ;Save the current block values
PHA
STZ dhpCmd ;=statCmd
STZ blockNum ;Zero the block #
STZ blockNum+1
PHP
SEI
JSR DMgr ;Branch if write protect error
BCS :1
LDA #$00 ; Otherwise, assume no errors
:1 PLP ;Restore interrupt status
CLC
TAX ;Save error
BEQ :2 ;Branch if no error
SEC ; else, set carry to show error
:2 PLA
STA blockNum ;Restore the block #
PLA
STA blockNum+1
TXA
RTS ;Carry is indeterminate

409
MLI.SRC/RELOC.S Normal file
View File

@ -0,0 +1,409 @@
*******************************************************
* Program/data relocation routine is driven by a table
* describing program, vectors, and data segments. The
* table has the general format:
* (1)command: 0= zero destinaton range.
* 1= move data to from src to dst.
* 2= high address ref tbl, relocate & move.
* 3= lo-hi addr ref tbl, relocate & move.
* 4= program, relocate & move.
* >4= end of table.
* (2)dest addr: address of where segment is to be moved.
* (2)byte count: length of segment.
* (2)source addr: start address segment to be operated on,
* n/a if type=0, code does not have to be
* assembled at this address.
* (1)segments: number of address ranges to be tested
* and altered, n/a if type=0 or 1.
* limit and offset lists should each
* contain segments+1 (s) bytes.
* (s)limitlow: list of low page addresses to be tested.
* (s)limithigh: list of high page addresses to be tested.
* (s)offset: list of amounts to be added if
* low & high limits have been met.
*
* on entry: (X)=table address low, (Y)=table address high
* on exit: carry clear if no error; else carry set,
* (X)=addrLo, (Y)=addrHi of error causing source.
* (A)=0 if input table error, =$ff if illegal opcode.
*******************************************************
Reloc STX relocTbl
STY relocTbl+1 ;Save address of control table
RelLoop LDA (relocTbl) ;Get relocation command
CMP #$05 ;If 5 or greater then done...
BCS RelocEnd ;Branch if done
TAX
LDY #$01 ;Move destination address to
LDA (relocTbl),Y ; zero page for indirect access
STA dst
INY
LDA (relocTbl),Y
STA dst+1
INY
LDA (relocTbl),Y ;Also the length (byte count)
STA cnt ; of the destination area
INY
LDA (relocTbl),Y
STA cnt+1
BMI RelocErr ;Branch if >=32K
TXA ;Request to zero out destination?
BEQ Zero ;Branch if it is
INY
LDA (relocTbl),Y ;Now get the source address
STA src
STA code ;src is used for the move, 'code' is
INY ; used for relocation
CLC ;Add length to get final address
ADC cnt
STA endCode
LDA (relocTbl),Y
STA src+1
STA code+1
ADC cnt+1
STA endCode+1
DEX ;Now that set-up is done, test for 'move'
BEQ MovEm ;Branch if move only (no relocation)
STX wSize ;Save element size (1,2,3)
INY
LDA (relocTbl),Y ;Now get the number of ranges
STA segCnt ; that are valid relocation target addresses
TAX ;Separate serial range groups into tables
RLimLo INY ;Transfer low limits to 'limlo' table
LDA (relocTbl),Y
STA LimLo,X
DEX
BPL RLimLo
LDX segCnt
RLimHi INY
LDA (relocTbl),Y ;Transfer high limits to 'limhi' table
STA LimHi,X
DEX
BPL RLimHi
LDX segCnt
Rofset INY
LDA (relocTbl),Y ;Transfer offsets to 'ofset' table
STA Ofset,X
DEX
BPL Rofset
JSR AdjTbl ;Adjust 'relocTbl' to point at next spec
LDX wSize ;Test for machine code relocation
CPX #$03
BEQ RelCode ;Branch if program relocation
* 2/3 - Relocate addresses
JSR RelAdr ;Otherwise, relocate addresses in
RelocEnd1 JSR Move ; one or two byte tables, then move to destination
BRA RelLoop ;Do next table entry...
RelocEnd CLC
RTS
RelocErr JMP TblErr
*-------------------------------------------------
* 4 - Relocate instructions
RelCode JSR RelProg ;Go relocate machine code references
BRA RelocEnd1
* 0 - Zero block
Zero JSR AdjTbl ;Adjust 'relocTbl' pointer to next entry
LDA #$00 ;Fill destination range with zeros
LDY cnt+1 ;Is it at least a page?
BEQ ZPart ;Branch if less than 256 bytes
TAY
:ZeroLoop STA (dst),Y
INY
BNE :ZeroLoop
INC dst+1 ;bump to next page
DEC cnt+1
BNE :ZeroLoop
ZPart LDY cnt ;any bytes left to zero?
BEQ Zeroed ;branch if not
TAY
:loop STA (dst),Y
INY
CPY cnt
BCC :loop
Zeroed JMP RelLoop
* 1 - Copy block
MovEm JSR AdjTbl
BRA RelocEnd1
*-------------------------------------------------
* Advance table ptr
AdjTbl TYA ;Add previous table length to 'relocTbl'
SEC ; to get position of next entry in table
ADC relocTbl
STA relocTbl
BCC :Rtn
INC relocTbl+1
:Rtn RTS
*-------------------------------------------------
Move LDA src+1 ;Determine if move is up, down
CMP dst+1 ; or not at all
BCC MovUp ;Branch if definitely up...
BNE MovDown ;Branch if definitely down...
LDA src
CMP dst
BCC MovUp ;Branch if definitely up...
BNE MovDown ;Branch if definitely down...
RTS ;Otherwise, don't move nuting
*-------------------------------------------------
* src addr < dest addr
MovUp LDY cnt+1 ;Calc highest page of move up
TYA
CLC
ADC src+1
STA src+1 ; & adjust src & dst accordingly
TYA
CLC
ADC dst+1
STA dst+1
LDY cnt ;Move partial page first
BEQ :1 ;Branch if no partial pages
:MovLoop DEY
LDA (src),Y
STA (dst),Y
TYA ;End of page transfer?
BNE :MovLoop ;No
:1 DEC dst+1
DEC src+1
DEC cnt+1 ;Done with all pages?
BPL :MovLoop ;Branch if not
RTS
*-------------------------------------------------
* src addr > dest addr
MovDown LDY #$00
LDA cnt+1 ;Partial page move only?
BEQ :1 ;Branch if less than a page to be moved
:MovLoop1 LDA (src),Y
STA (dst),Y
INY
BNE :MovLoop1
INC dst+1 ;Bump addresses
INC src+1
DEC cnt+1 ;More pages?
BNE :MovLoop1 ;Branch if more pages
:1 LDA cnt ;Move partial page
BEQ :Rtn ;Branch if no more to move
:MovLoop2 LDA (src),Y
STA (dst),Y
INY
CPY cnt
BNE :MovLoop2
:Rtn RTS ;All done...
*-------------------------------------------------
* Address/page relocate
RelAdr LDY wSize ;Determine 1 or 2 byte reference
DEY
LDA (code),Y
JSR AdjAdr ;Relocate reference
LDA wSize ;Update and test 'code' pointer
JSR AdjCode
BCC RelAdr ;Branch if more to do
RTS
*-------------------------------------------------
* Instructions relocate
RelProg LDY #$00 ;Fetch next opcode
LDA (code),Y
JSR GetOpLen ;Determine if it's a 3-byte instruction
BEQ RPerr ;Branch if not an opcode
CMP #$03
BNE :1
LDY #$02
JSR AdjAdr ;Relocate address
LDA #$03
:1 JSR AdjCode ;Update and test 'code' for done
BCC RelProg ;Loop if more to do
RTS
*-------------------------------------------------
* Error handling...
RPerr PLA ;Return bad code address
PLA ;First un-do stack
LDX code
LDY code+1
LDA #$FF ;Indicate bad opcode
SEC ;Indicate error
RTS
*-------------------------------------------------
* Error return
TblErr LDX relocTbl ;Return table address error
LDY relocTbl+1
LDA #$00 ;Indicate input table error
SEC
RTS
*-------------------------------------------------
* Relocate absolute addr
AdjAdr LDA (code),Y ;Get page address
LDX segCnt ; and test against limits
:AdjLoop CMP LimLo,X ;Is it >= low?
BCC :Next ;Branch if not
CMP LimHi,X ;Is it =< highest page limit
BCC :1 ;Branch if it is
BEQ :1
:Next DEX ;Try next limit set
BPL :AdjLoop
RTS ;Teturn without adjustment
:1 CLC ;Add offset to form relocated
ADC Ofset,X ; page address
STA (code),Y ; & replace old address with result
RTS
*-------------------------------------------------
* Bump ptr to next addr
AdjCode CLC ;Update 'code' pointer
ADC code
LDY code+1
BCC :1 ;Branch if not page cross
INY ;Update high order address too
:1 CPY endCode+1 ;Has all code/data been processed?
BCC :2 ;Branch if definitely not
CMP endCode ;If carry results set, end of code
:2 STA code
STY code+1 ;Save updated values
RTS ;Return result (carry set=done)
*-------------------------------------------------
* Compute instruction len
GetOpLen PHA ;Form index to table and which 2-bit group
AND #$03 ;Low 2 bits specify group
TAY
PLA
LSR ;Upper 6 bits specify byte in table
LSR
TAX
LDA OpCodeLen,X
NxtGroup DEY ;Is opcode length in lowest 2 bits of A-reg?
BMI RtnLen ;Branch if it is
LSR
LSR ;Shift to next group
BNE NxtGroup ;If len=0 then error...
RtnLen AND #$03 ;Strip other garbage
RTS ;If z-flag true, then error!!!
*-------------------------------------------------
* The following table contains the length of each
* machine instruction (in two-bit groups).
OpCodeLen HEX 0928193C
HEX 0A280D3C
HEX 0B2A193F
HEX 0A280D3C
HEX 0928193F
HEX 0A280D3C
HEX 0928193F
HEX 0A280D3C
HEX 082A113F
HEX 0A2A1D0C
HEX 2A2A193F
HEX 0A2A1D3F
HEX 0A2A193F
HEX 0A280D3C
HEX 0A2A193F
HEX 0A280D3C
*-------------------------------------------------
* Relocation Data
wSize DB $00
segCnt DB $00
LimLo HEX 0000000000000000;Start of range pages
LimHi HEX 0000000000000000;End of pages+1
Ofset HEX 0000000000000000;Additive factors
*-------------------------------------------------
* Install an exit code
* The locations GSOS($E100A8) & GSOS2 ($E100B0)
* are patched if the boot OS is P8
GSPatches PHP
SEI
CLC
XCE
REP #$30
PHB
PHA
PHA ;long result
PushLong #ZZSize ;size 16 bytes
PushWord #$3101 ;userID
PushWord #attrLocked+attrNoCross+attrNoSpec
PHA
PHA
_NewHandle
LDA $01,S ;Let handle remain on stack
TAX ; since we need it later but
LDA $03,S ; move a copy to (Y,X)
TAY
PushLong #ExitPatch ; srcPtr
PHY
PHX ;destHndl
PushLong #ZZSize ;# of bytes to be copied
_PtrToHand
PLX ;Put 24 bits of the 32-bit
PLB ; handle that was left on stack
LDA |$0001,X ; deref
TAY ;mid & hi-byte of 24-bit ptr
LDA |$0000,X ; low 16-bit of 24-bit ptr
AND #$00FF ; Mask off mid byte
XBA ;Lobyte of ptr to Hi-byte in ACC
ORA #$005C ;Add in JMPL inst
STAL GSOS2 ;$5C xx
CLC
ADC #$000B ; ADC[]
STAL GSOS
TYA ; mid & hi byte of 24-bit ptr
STAL GSOS2+2 ;yy zz
ADC #$0000
STAL GSOS+2
PLB ;Discard the rest of the handle
PLB
SEC
XCE
PLP
RTS
*-------------------------------------------------
* Remove 3 words & adjust stack
* to return to caller
MX %00
ExitPatch LDA $01,S ;RTL-1 addr
STA $07,S
LDA $02,S
STA $07+1,S
PLA
PLA
PLA
LDA #$00FF
SEC
RTL
ZZSize EQU *-ExitPatch
DS $23,0

70
MLI.SRC/ROM.S Normal file
View File

@ -0,0 +1,70 @@
TTL 'lang. cd. irq, nmi, & reset'
***********************************************************
* This code is used when an IRQ happens while the RAM
* at $D000-$FFFF is switched on (inside an MLI
* call, for example) if we have the "new style"
* monitor ROMs
ORG $FF9B
LanIrq PHA
LDA Acc ;Save ($45)
STA old45 ;Now put A-reg into loc $45
PLA
STA Acc
PLA ;Get status register from stack
PHA ; (and restore it!)
AND #$10 ;Is it a break or interupt
BNE lBreak ;Branch if break
LDA $D000 ;Get bankID
EOR #$D8 ;Is the system active? (CLD)
BEQ SysActv ;Branch if it is
LDA #$FF ;In $D000 bank 2
SysActv STA IntBankID ;Update bank ID (=$00/$FF)
STA afBank
LDA #>aftIrq ;Push fake "RTI" vector
PHA ; with IRQ disabled
LDA #<aftIrq ;Set up return address
PHA
LDA #$04 ;Status reg w/int flag set
PHA
lBreak LDA #>ROMIrq ;Push ROM entry also
PHA
LDA #<ROMIrq
PHA
GoROM STA RDROM2 ;Switch to ROM (hits RTS immediately)
lReset LDA rReset+1
PHA ;Since reset, Acc can be destroyed
LDA rReset
PHA
JMP GoROM
rReset DA $FA62-1 ;Monitor reset-1
*-------------------------------------------------
fix45 STA IntAReg ;Preserve the Acc
LDA old45
STA Acc
LDA LCBANK1
LDA LCBANK1 ;Switch RAM in for write & read
LDA afBank
JMP IrqXit0
* (Y)=0
ZeroPfxPtrs STY NewPfxPtr ;Fix AppleTalk PFI bug
STY PfixPtr ;Flag not an active prefix
RTS
*(A)=flag
SetPfxPtrs STA NewPfxPtr
STA PfixPtr
RTS
DA NMI
DA lReset
IrqVect DA LanIrq

356
MLI.SRC/SEL0.S Normal file
View File

@ -0,0 +1,356 @@
***********************************************************
* *
* PRODOS 8 LOBOTOMIZED DISPATCHER ROUTINE *
* *
* COPYRIGHT APPLE COMPUTER, INC., 1983-86 *
* *
* ALL RIGHTS RESERVED *
* *
***********************************************************
TTL "DISPATCHER I"
***********************************************************
*
* DISPATCHER 1 - This code ORGs and operates at $1000 but
* is resident in memory at $D100 in the Alt 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.
*
* NOTE: This entire routine MUST remain no larger than 3 pages.
*
***********************************************************
ORG $1000
MX %11
HereIn LDA RDROM2
STA CLR80VID ;Disable 80 column hardware
STA CLRALTCHAR ;Switch in primary char set
STA CLR80COL ;Disable 80 column store
JSR SetNorm ;Normal white chars on black background
JSR Init ;Text pg1; text mode; set 40 col window
JSR SetVid ;Does a PR#0 (puts COUT1 in CSW)
JSR SetKBD ;Does an IN#0 to set Basic input to kbd
****************************************************
*
* Clear the memory Bit Map
ClrMap LDX #$17 ;Do all the bytes
LDA #$01
STA memTabl,X ;Protect page $BF00
DEX
LDA #$00 ;Clear the rest
:ClrLoop STA memTabl,X
DEX
BPL :ClrLoop
LDA #%11001111
STA memTabl ;Protect pages 0,1 & $400-$7FF (Screen)
Start EQU *
***************** See Rev Note #55 *********************
JSR HOME ;Clear the screen
JSR CROUT
LDX #<Msg0-MsgStart ;Load offset to message into x...
JSR PrntLoop
LDA #3 ;Set CV to 3rd line
STA CV
JSR CROUT ; & col 1
JSR GoPro ;Call the MLI (Remember, this code executes at $1000)
DB $C7
DA Prefix
LDX pnBuf ;Get PREFIX length
LDA #$00 ;Put a 0 at end of Prefix
STA pnBuf+1,X
******************* See Rev Note #69 *******************
LDX pnBuf ;Get length byte back
BEQ NilPfx ;Branch if no prefix to display!!!
:loop LDA pnBuf,X ;Display prefix directly
ORA #$80 ;Set hi bit for NORMAL text
STA SLIN04-1,X ; to the screen
DEX
BNE :loop
NilPfx LDX #$00
DEC CV
JSR CROUT ;Put the cursor on the first char
GetKey JSR RDKEY ;Wait for keyboard input
CMP #$8D ;Is it CR?
BEQ GotPfx ;Yes, and we accept what was entered
PHA ;No, save the char
JSR CLREOL ;Clear rest of line
PLA ;Get char back
CMP #$9B ;Is it ESC?
BEQ Start ;Yes, start over again
CMP #$98 ;If it is CTRL-X, start over
ReStrt BEQ Start ;(Used as an extended BEQ from PRMPT)
CMP #$89 ;Is it TAB?
BEQ BadKey ;No good if it is!
CMP #$FF ;Delete?
BEQ :1 ;Branch if it is
CMP #$88 ;Back Space?
BNE NotBS
:1 CPX #$00 ;If it is, are we at col 0?
BEQ *+5 ;If col 0, do nothing
DEC CH ; else move left 1 char
DEX ; decrement char count,
JSR CLREOL ; clear rest of line
JMP GetKey ;Go get another char
NotBS BCS Maybe
BadKey JSR BELL ;Ring the speaker (bell) if it isn't
JMP GetKey
Maybe CMP #$DB ;Ok, is it below 'Z'?
BCC *+4 ;Branch if yes
AND #$DF ;If not, shift it up upper case
CMP #$AE ;Is it below "."?
BCC BadKey ;If yes, it ain't good!
CMP #$DB ;Is it above "Z"?
BCS BadKey ;If so, it also ain't good
CMP #$BA ;Is it below ":"? ("." - "9" range)
BCC GoodKey ;Yes, it's good!
CMP #$C1 ;If not, is it at or above "A"? ("A" - "Z")
BCC BadKey ;No, reject it
GoodKey INX ;It's OK. Hallelulah!
CPX #39 ;Were there more than 39 chars?
BCS ReStrt ;Yes, too many! Go restart
STA pnBuf,X ;No, save the lucky char
JSR COUT ;Print it
JMP GetKey ; & go get another
GotPfx CPX #$00 ;OK, is our Prefix length (chars entered)=0?
BEQ Prmpt ;If yes, don't bother re-setting it
STX pnBuf ;Set prefix length
JSR GoPro ;Call the MLI
DB $C6
DA Prefix
BCC Prmpt ;If ok, go get Filename
JSR BELL ;If not, ring Bell
LDA #$00 ; & try again
BadPfx BEQ ReStrt ;Z flag must be set for extended Branch
Prmpt JSR HOME ;Clear the screen for application name
JSR CROUT ;Output a CR
********************* Rev Note #55 *******************
LDX #<Msg-MsgStart ; Load offset to message into x...
JSR PrntLoop
RetryRich LDA #$03 ;Set CV to 3rd line
STA CV
JSR CROUT ; & col 1
LDX #$00
********************* Rev Note #69 *******************
Loop1 JSR RDKEY
CMP #$9B ;ESC
BNE NotEsc
LDA CH
BNE Prmpt
BEQ BadPfx ;If ESC in col 0 go get PREFIX again
NotEsc CMP #$98 ;CTRL-X
ExtndBr BEQ Prmpt ;(Used as a branch extender)
CMP #$89 ;TAB
BEQ NotGud
CMP #$FF ;Delete?
BEQ :1
CMP #$88 ;BACK SPACE
BNE :2
:1 JMP EatEm ;Eat the previous character
:2 BCS GetIn1 ;> $88 and the char may be acceptable
NotGud JSR BELL ;Ring the bell (speaker)
JMP Loop1
GetIn1 CMP #$8D ;Is it a CR?
BEQ GetInpDone
CMP #$DB ;> than "Z"
BCC *+4 ;No
AND #$DF ;Make sure its Upper case
CMP #$AE ;Is it "."?
BCC NotGud ;Branch if less
CMP #$DB ;Must be less than "["
BCS NotGud
CMP #$BA ;OK if less than or equal to "9"
BCC ItsGud
CMP #$C1 ;Else must be > than "A"
BCC NotGud
ItsGud PHA
JSR CLREOL
PLA
JSR COUT ;No, print it
INX
CPX #39
BCS ExtndBr
STA pnBuf,X
JMP Loop1 ;Go get the next one
GetInpDone LDA #" "
JSR COUT ;After the CR, blank out the cursor
STX pnBuf ;Put the length in front of the name
* At this point the specified Pathname is in pnBuf ($280)
* and we can do a GET_FILE_INFO on it
JSR GoPro
DB $C4
DA Info
BCC InfoOK
JMP Error
InfoOK LDA Type
CMP #$FF ;Is it a type SYS file?
BEQ DoIt
LDA #$01 ;Not SYS File
JMP Error
DoIt LDA #$00 ;It's a type SYS all right!
STA ClsNum
JSR GoPro
DB $CC
DA Cls ;CLOSE all open files first
BCC ChkAcs
JMP Error
* Now check for the proper access
ChkAcs LDA Acess ;Get the allowed access
AND #readEnable ;Is READ disabled?
BNE :1 ;No. Access ok
LDA #drvrIOError ;I/O error
JMP Error ;Never returns!
:1 JSR GoPro
DB $C8
DA Opn ;OPEN it
BCC *+5
JMP Error
LDA RefNum
STA ReedNum ;Spread REFNUM around
STA eofNum
* Ok it's OPEN, let's get the EOF
JSR GoPro
DB $D1
DA EOF
BCS Error
LDA eofB+2 ;3rd of 3 bytes
BEQ EOFOK
LDA #drvrIOError ;I/O ERROR even though the
BNE Error ; file is simply too large
EOFOK LDA eofB ;Move EOF to Read # bytes
STA RCount
LDA eofB+1
STA RCount+1
JSR GoPro
DB $CA ;Do the READ
DA Reed
PHP ;Push the processor status
JSR GoPro
DB $CC ;Close it
DA Cls
BCC *+6
PLP ;Get status back (it is irrevalent now)
BNE Error ;(if CLOSE generated an error)
PLP ;We're here if CLOSE was OK
BCS *-4 ;JMP ERROR
JMP $2000
EatEm LDA CH ;Is the cursor in col 0?
BEQ EatEmBak ;Yes, ignore it
DEX
LDA #" "
JSR COUT ;Blank out the cursor
DEC CH ;Point to last character
DEC CH ; entered...
JSR COUT ; and blank it too
DEC CH ;Point to that location
EatEmBak JMP Loop1 ;Go back & get the next char
****************** See Rev Note #55 *****************
PrntLoop LDA Msg0,X ;Display string; offset is in X.
BEQ :Ret ;Branch if done.
JSR COUT ;Output character...
INX
BNE PrntLoop ;Branch always.
:Ret RTS
Error STA ErrNum
LDA #$0C ;Put error message on line 13
STA CV
JSR CROUT
LDA ErrNum
CMP #badSystemCall
BNE NextErr
*************** See Rev Note #55 **************
LDX #<Err1-MsgStart ;Load x with offset to message
BNE DoError
NextErr CMP #badPathSyntax
BEQ Error3
CMP #pathNotFound
BEQ Error3
CMP #volNotFound
BEQ Error3
CMP #fileNotFound
BEQ Error3
LDX #<Err2-MsgStart ; Load x with offset to message
BNE DoError
Error3 LDX #<Err3-MsgStart ;Load x with offset to message
DoError JSR PrntLoop
JMP RetryRich
*-------------------------------------------------
* Data
MsgStart EQU *
Msg0 ASC "ENTER PREFIX (PRESS "A2"RETURN"A2" TO ACCEPT)"
DB $00
Msg ASC "ENTER PATHNAME OF NEXT APPLICATION"
DB $00
Err1 DB $87
ASC "NOT A TYPE "A2"SYS"A2" FILE"
DB $00
Err2 DB $87
ASC "I/O ERROR "
DB $00
Err3 DB $87
ASC "FILE/PATH NOT FOUND "
DB $00
*
Info DB $0A ;10 PARAMETERS ON GFI
DA pnBuf ;Pathname buffer pointer
Acess DB $00 ;ACCESS
Type DB $00 ;File Type
DS $D,0 ;All the rest are unimportant
Opn DB $03 ;3 parameters on an OPEN
DA pnBuf
DA $1800 ;FCB Buffer
RefNum DB $00
Cls DB $01
ClsNum DB $00 ;REFERENCE #
Reed DB $04 ;4 Parameters for a READ
ReedNum DB $00
DA $2000 ;SYS files always load at $2000
RCount DW $0000
DW $0000
EOF DB $02
eofNum DB $00
eofB DS 3,0 ;Three byte EOF
Prefix DB $01
DA pnBuf
ZZSiz EQU *-HereIn
ZZFre EQU $2FF-ZZSiz
DS $35,0

468
MLI.SRC/SEL1.S Normal file
View File

@ -0,0 +1,468 @@
**************************************************
* Zero page use
SMrkPBlk EQU $60 ;SetMark parm blk
numActvDev EQU $65 ;# of active devices-1
currEnt EQU $67
listTotal EQU $68 ;tot # of SYS/DIR entries in curr dir
fnameLen EQU $69
dispCnt EQU $6A ;# of entries displayed
depth EQU $6B ;0=unit, 1=root dir
fnamePtr EQU $6C
Entry_Len EQU $6E ;These are read fr dir file
EntPerBlk EQU $6F
FileCount EQU $70
entryNum EQU $72 ;entry # within dir block
scrolledNum EQU $73 ;# of entries that were scrolled up
fTypeTbl EQU $74 ;$74-$F3 (128 entries)
namesBuf EQU $1400 ;Store for file incl subdir names
P8IOBuf EQU $1C00 ;1024-byte buf for opened files
entryBuf EQU $2000 ;Read buf for file entry & vol/sub dir header recs
**************************************************
* Improved Dispatcher/Selector
ORG DispAdr
MX %11
BetterBye CLD ;Flag this is a SELECTOR
LDA RDROM2 ;Enable Motherboard ROM
STZ SOFTEV
LDA #>BetterBye
STA SOFTEV+1
JSR SETPWRC ;Set powerup byte
LDA #$A0 ;Switch on $C3 video
JSR $C300
LDX #23
:ClrLoop STZ memTabl,X
DEX
BPL :ClrLoop
INC memTabl+23 ;Protect $BF page
LDA #%11001111 ;Flag $00,$01 & $04-$07 mem
STA memTabl ; pages as being used
LDA #$02
STA SMrkPBlk ;Set pCount
LDX DevCnt ;Get # of devices-1
STX numActvDev
LDA DevNum ;Is there a last accessed dev?
BNE IsDevOL ;Yes, start with that one
*-------------------------------------------------
NxtActvDev LDX numActvDev ;Start search fr this
LDA DevLst,X ;=DSSS IIII
CPX #$01 ;Last on the list?
BCS :1 ;No
LDX DevCnt ;Start all over again
INX
:1 DEX
STX numActvDev
IsDevOL STA OLUnit ;Chk if vol is online
JSR GoPro
DB $C5
DA OLinPBlk
BCS NxtActvDev ;No, try next device
STZ depth
LDA pnBuf+1 ;=DSSS LLLL
AND #$0F ;Isolate name len of vol
BEQ NxtActvDev ;Not online
ADC #$02 ;For the 2 added slashes
TAX
OpenFolder STX pnBuf ;len of PN
LDA #'/' ;Add a slash to the
STA pnBuf+1
STA pnBuf,X ; beginning & end of PN
STZ pnBuf+1,X
JSR GoPro ;Open the vol/sub dir
DB $C8
DA OpenPBlk
BCC FolderOpened
LDA depth
BEQ NxtActvDev
JSR BELL1
JSR ChopName
STX pnBuf
JMP GetKeyPress ;Pause
*-------------------------------------------------
FolderOpened INC depth
STZ listTotal ;# of SYS/DIR entries
LDA OpenRef
STA ReadRef
STA SMrkPBlk+c_refNum;Set ref #
LDA #$27+4 ;Read in the link blk ptrs
STA RdReqLen ; & vol/subdir header rec
STZ RdReqLen+1
JSR ReadEntry
BCS ScanDirDone
LDX #$03 ;Copy the file count,
:CpyLoop LDA entryBuf+hEntLen+4,X; entries/blk
STA Entry_Len,X ; & entry len
DEX
BPL :CpyLoop
STA RdReqLen ;=entry_len ($27)
LDA #$01 ;Start w/first file entry
STA entryNum ; skipping the header entry
STZ SMrkPBlk+c_mark+1
STZ SMrkPBlk+c_mark+2
LDA FileCount ;Is vol/sub dir empty?
ORA FileCount+1
BNE NxtFilEnt ;No
ScanDirDone BRA ClsDirFile ;Done with reading dir
NxtFilEnt BIT FileCount+1 ;Any more file entries?
BMI ScanDirDone ;Done
SkipEnt LDA SMrkPBlk+c_mark+1
AND #%11111110 ;Do a MOD 512 to force
STA SMrkPBlk+c_mark+1; a block alignment
LDY entryNum
LDA #$00
CPY EntPerBlk
BCC CalcOffset
TAY ;Y=0
STY entryNum
INC SMrkPBlk+c_mark+1;On fall thru next block
NxtPage INC SMrkPBlk+c_mark+1;2nd page of block
CalcOffset DEY ;Compute offset to file entry
CLC
BMI SetFilePos
ADC Entry_Len
BCC CalcOffset
BCS NxtPage ;Always
SetFilePos ADC #$04 ;Skip 4-byte header
STA SMrkPBlk+c_mark
JSR GoPro
DB $CE
DA SMrkPBlk
BCS ScanDirDone
JSR ReadEntry
BCS ScanDirDone
INC entryNum
LDA entryBuf+d_stor ;Get storType/namelen
AND #$F0 ;Isolate storage type
BEQ SkipEnt ;Deleted entry
DEC FileCount
BNE GoodRead
DEC FileCount+1
GoodRead ROR entryBuf+d_attr ;Check readEnable bit
BCC NxtFilEnt ;File cannot be read
LDA entryBuf+d_fileID;Get file type
CMP #$0F ;Is it a DIR file?
BEQ :1 ;Yes
CMP #$FF ;SYS file?
BNE NxtFilEnt ;No
:1 LDX listTotal ;# of SYS/DIR entries
CPX #128
BCS ClsDirFile
STA fTypeTbl,X ;Store filetype
JSR GetNameSlot
LDY #15
:CpyLoop LDA entryBuf+d_stor,Y;Copy filename including
STA (fnamePtr),Y ; the storType/namelen byte
DEY
BPL :CpyLoop
INY ;Y=0 ;(A)=storType/namelen
AND #$0F ;Isolate len byte
STA (fnamePtr),Y ;Save it
INC listTotal ;# of SYS/DIR entries
BNE NxtFilEnt
CantCls JMP NxtActvDev ;Hitch a ride
ClsDirFile JSR GoPro
DB $CC
DA ClsPBlk
BCS CantCls
* Display list of files in vol/subdir
JSR SETTXT
JSR HOME ;Clear scrn & posn cursor @ top of scrn
LDA #23
JSR TABV ;Posn cursor @ btm of scrn
LDY #helpStr-helpStr
LDA #20 ;Display Help Message
JSR ShowHelp ; starting @ scrn coords (23, 20)
JSR HomeCursor
LDX #$00
:loop LDA pnBuf+1,X ;Display full PN
BEQ :1 ; at top of screen
JSR PrtChar
INX
BNE :loop
:1 STZ currEnt
STZ scrolledNum
LDA listTotal ;# of SYS/DIR entries
BEQ GetKeyPress
CMP #21
BCC :2
LDA #20 ;Only 20 will be displayed
:2 STA dispCnt
LDA #2 ;Set the dimensions
STA WNDTOP ; of our display window
STA WNDLFT ; which is (2, 2) to (22, 24)
LDA #22
STA WNDWDTH
STA WNDBTM
:DspLoop JSR ShowEntry
INC currEnt
DEC dispCnt
BNE :DspLoop
STZ currEnt ;Highlight 1st entry
BEQ InvDsp ;Always
UpArwHit JSR ShowEntry
LDX currEnt ;Are we at the top of the list?
BEQ InvDsp ;Yes -> No entries to scroll down
DEC currEnt
LDA CV ;Are we at the top of our window?
CMP #$02
BNE InvDsp ;No, proceed to highlight entry
DEC scrolledNum ;Less 1 "scrolled up" entry
LDA #$16 ;Scroll down 1 line
BNE Scroll ;always
DwnArwHit JSR ShowEntry
LDX currEnt ;Is this the last SYS/DIR
INX
CPX listTotal ; entry in the dir?
BCS InvDsp ;Yes -> No entries to scroll up
STX currEnt
LDA CV ;Are we beyond the end of our window?
CMP #21
BNE InvDsp ;No
INC scrolledNum ;We have scrolled up 1 entry
LDA #$17 ;Scroll up 1 line
Scroll JSR COUT
InvDsp JSR SetInv ;Set 80-col card to inverse mode
JSR ShowEntry
GetKeyPress LDA KBD
BPL GetKeyPress
STA KBDSTROBE ;Clear keyboard strobe
JSR SetNorm
LDX listTotal ;Is vol/subdir empty?
BEQ :1 ;Yes, no entries were displayed
CMP #$8D ;CR?
BEQ AcceptEnt
CMP #$8A ;Down arrow?
BEQ DwnArwHit
CMP #$8B ;Up arrow?
BEQ UpArwHit
:1 CMP #$89 ;TAB?
BEQ NxtVol
CMP #$9B ;ESC?
BNE GetKeyPress
JSR ChopName
DEC depth
BRA ToOpenDir2 ;Go open parent dir
* Scans the full pathname, and chops
* off characters until it gets to a /
ChopName LDX pnBuf ;Get len of PN
:loop DEX ;Bump to previous char
LDA pnBuf,X
CMP #'/'
BNE :loop
CPX #$01 ;Have we reached the root?
BNE :Rtn ;No
LDX pnBuf ;Stay at root level
:Rtn RTS
NxtVol JMP NxtActvDev ;Hitch a ride
ToOpenDir1 INX ;1 more for the ending slash
ToOpenDir2 JMP OpenFolder
AcceptEnt JSR GoPro
DB $C6
DA SPfxPBlk
BCS NxtVol
* Extend the pathname
LDX currEnt
JSR GetNameSlot
LDX pnBuf ;Append filename
:CpyLoop INY
LDA (fnamePtr),Y ; to the PN
INX
STA pnBuf,X
CPY fnameLen
BCC :CpyLoop
STX pnBuf
LDY currEnt
LDA |fTypeTbl,Y ;Get filetype
BPL ToOpenDir1 ;Dir file
JSR SETTXT
JSR HOME
LDA #$95 ;Deactivate 80-col, home cursor & clrsrcn
JSR COUT
JSR GoPro
DB $C8
DA OpenPBlk
BCS NxtVol
LDA OpenRef
STA ReadRef
LDA #$FF ;Prepare to read the
STA RdReqLen ; entire file whose
STA RdReqLen+1 ; len is unknown
JSR ReadEntry
PHP ;Save err status
JSR GoPro
DB $CC
DA ClsPBlk
PLP
BCS NxtVol ;Read errs
JMP $2000 ;Transfer control to Applic
*-------------------------------------------------
ShowHelp STA CH
ShowIcon EQU *
:loop LDA helpStr,Y
BEQ :Rtn
JSR COUT
INY
BNE :loop
:Rtn RTS
*-------------------------------------------------
* Each file name 16 bytes/entry
* Allow up to 128 SYS/DIR names to be
* stored @ $1400-$1BFF
* Entry
* (X) = entry #
* Exit
* (Y) = 0
* (fnamePtr) = Ptr to name of entry
GetNameSlot STZ fnamePtr+1
TXA
ASL ;x16
ROL fnamePtr+1
ASL
ROL fnamePtr+1
ASL
ROL fnamePtr+1
ASL
ROL fnamePtr+1
STA fnamePtr
LDA #>namesBuf
CLC
ADC fnamePtr+1
STA fnamePtr+1
LDY #$00
LDA (fnamePtr),Y
STA fnameLen
RTS
*-------------------------------------------------
* Display name of an entry
ShowEntry LDA #2
STA OURCH
LDX currEnt
TXA
SEC
SBC scrolledNum
INC
INC
JSR TABV
LDA fTypeTbl,X
BMI Its_Sys ;SYS file
STZ OURCH ;DIR file
LDA INVFLG
PHA
LDY #FolderIcon-helpStr
JSR ShowIcon
PLA
STA INVFLG
Its_Sys JSR PrtBlnk ;Print a space instead
JSR GetNameSlot ; followed the file/subdir name
:loop INY
LDA (fnamePtr),Y
JSR PrtChar
CPY fnameLen
BCC :loop
PrtBlnk LDA #" "
BNE PrtAsIs ;Always
HomeCursor LDA #$99 ;ctrl-Y
PrtChar ORA #$80
PrtAsIs JMP COUT
ReadEntry JSR GoPro
DB $CA
DA RdPBlk
RTS
*-------------------------------------------------
* Data area
helpStr ASC "RETURN: Select | TAB: Chg Vol | ESC: "
ASC "Back"
DB $00
FolderIcon DB $0F ;Set Inverse Display mode
DB $1B ;Enable MouseText Mapping
DB $D8 ;MouseText chars
DB $D9
DB $18 ;Disable MouseText Mapping
DB $0E ;Set Normal Display mode
DB $00 ;end of string
OpenPBlk DB $03
DA pnBuf
DA P8IOBuf
OpenRef DB $00
ClsPBlk DB $01
DB $00
OLinPBlk DB $02
OLUnit DB $60
DA pnBuf+1
SPfxPBlk DB $01
DA pnBuf
RdPBlk DB $04
ReadRef DB $01
DA entryBuf
;RdReqLen DW 0
RdReqLen DB 0 ;Overflow

471
MLI.SRC/SEL2.S Normal file
View File

@ -0,0 +1,471 @@
**************************************************
* New GS/OS Dispatcher for P8
GQuit8 EQU $E0D000
ORG DispAdr
XC
XC
GS_Disp LDA LCBANK1 ;Enable read
CLC
XCE
JMPL GQuit8
DS 5,0 ;Pad with spaces
gqSign ASC 'GQ' ;Signature word
*-------------------------------------------------
* Control is passed back here by GQuit8
* after it has setup the required parameters
MX %10
GS_DispZ SEP #$20 ;8-bit A, 16-bit index regs
PHA
LDX #inBuf ;Boot Volname
JSR GetVolName
PLA
SEC ;Emulation mode
XCE
ORA #$00 ;Nil prefix?
BEQ :1
MX %11
:loop JSR GoPro
DB $C6
DA SPfxParm
BCC :1
JSR ShowAlrt
BRA :loop
:1 XCE
MX %10
REP #$10 ;16-bit index regs
LDA pnBuf+1 ;Application's name is passed here
CMP #'/' ;Does it begin with a slash?
BNE :2 ;No, so a partial PN is passed
LDX #pnBuf ;Full PN is passed
JSR GetVolName ;Application's vol name
:2 SEC ;Full emulation mode
XCE
Try2Open JSR GoPro
DB $C8
DA OpenParm
BCC Opened
JSR ShowAlrt
BRA Try2Open
Opened LDA OpenRefNbr
STA eofRefNbr
STA ReadRefNbr
STA ClsRefNbr
GetFileLen JSR GoPro
DB $D1
DA eofParm
BCC GotFileLen
JSR ShowAlrt
BRA GetFileLen
GotFileLen LDA theEOF
STA ReadLen
LDA theEOF+1
STA ReadLen+1
Try2Read JSR GoPro
DB $CA
DA ReadParm
BCC Try2Cls
JSR ShowAlrt
BRA Try2Read
Try2Cls JSR GoPro
DB $CC
DA ClsParm
BCC ClsOK
JSR ShowAlrt
BRA Try2Cls
ClsOK JSR Chk4Intrp
BNE RunApp ;It's not an Interpreter eg BI
JSR GetStartup ;Get the startup pgm
BCC RunApp ;Transfer control to Interpreter
LDA #volNotFound
BRA ShwErrAlrt
RunApp LDA RDROM2 ;Enable motherboard ROM
JMP $2000 ;Pass control to SYS application
*-------------------------------------------------
* (A)=Error Code
* Report Err & Quit
ShowAlrt CLC
XCE
REP #$30 ;Full 16-bit native mode
JSR Ask4Disk
BCS ShwErrAlrt
SEC ;Back to emulation mode
XCE
RTS
*-------------------------------------------------
* Put up a text box showing an error code
* (A)=err code. It calls P8's quit code
ShwErrAlrt CLC
XCE
REP #$30 ;Full 16-bit native mode
AND #$00FF
PHA ;Convert err code
PushLong #ErrNumStr
PushWord #4 ; into 4-byte ASCIIs char
_Int2Hex
PHA
PushLong #CantRunStr ;line1Ptr
PushLong #P8ErrStr ;line2Ptr
PushLong #acceptStr ;button1Ptr
PushLong #nullStr ;button2Ptr
_TLTextMountVol
PLA ;Not used
SEC ;Emulate 65C02
XCE
JSR GoPro
DB $65
DA QuitParms
*-------------------------------------------------
* On entry
* (A)=Error Code
MX %00
Ask4Disk LDY #$0000 ;ptr to volname
LDX #VolNameStr
AND #$00FF ;Err #
CMP #volNotFound
BEQ :1
CMP #drvrOffLine
BEQ :1
SEC
RTS
* Prompt for correct vol
:1 PHA ;Err code
PHY
PHX
TSC
PHD
TCD
LDA [$01] ;Get len byte
DEC
XBA
STA [$01]
PHA ;word result
PushLong #insDskStr ;line1Ptr
PHY
INX
PHX ;(Y,X) line2Ptr
PushLong #acceptStr ;button1Ptr
PushLong #cancelStr ;button2Ptr
_TLTextMountVol
LDA [$01]
XBA
INC
STA [$01]
PLA ;button # chosen
PLD
PLX
PLX
CMP #$0001 ;Return?
BNE NotRet ;No, Esc
CLC
PLA ;err #
RTS
NotRet SEC
PLA ;err #
RTS
*-------------------------------------------------
* Called with 8-bit Acc but 16-bit index regs
* (X)=16-bit mem location to PN
* Copies just the volname to our buf
* On return, (A)=len of volname
* This rtn will hang if there is no
* trailing slash
MX %10
GetVolName LDA |$0001,X ;Get prefix char (if any)
STA VolNameStr+1
LDY #$0002
:loop LDA |$0002,X ;Get char
CMP #'/' ;Is it a trailing slash?
BEQ :Done ;Yes
STA VolNameStr,Y
INX
INY
BRA :loop
:Done DEY ;backup 1
TYA
STA VolNameStr ;Set len byte
RTS
*-------------------------------------------------
* Application File was already loaded in mem @ $2000
* If it is an interpreter, the Tool Locator is check
* for the name of the program which will be launched
* by the interpreter. For example, click on a file
* with type BAS with cause the BI to be loaded &
* executed. BI will launch the BASIC program which
* is passed via MessageCenter call of Tool Locator
*
* Z=0 Application is not an interpreter
* Z=1 Success
* Ref: pg 88 ProDOS 8 Technical Reference Manual
Chk4Intrp LDA $2000 ;Check if it's an interpreter
CMP #$4C ;JMP inst
BNE :Rtn
LDA #$EE ;INC inst
CMP $2003
BNE :Rtn
CMP $2003+1
BEQ :1
:Rtn RTS
:1 LDA #$FF ;Init ErrFlag & push
PHA ; onto stack for later
CLC
XCE
REP #$30 ;Full native mode
PHA
_MMStartUp
PLA ;user ID
* Ref IIGS Toolbox Vol 2 pg 24-14
* IIGS Toolbox Vol 3 pg 52-4
* Any size for the message handle will do
* since MessageCenter will resize it
PHA ;Push back for later
PHA ;long result
PHA
PushLong #10 ;# of bytes to allocate
PHA ;userID
PushWord #$0000 ;attr
PHA
PHA
_NewHandle
PLA ;msg hndl
PLX
BCS ShutDnMM
PHX
PHA
PushWord #2 ;action=Get
PushWord #1 ;msgID=file
PHX ;msg Hndl
PHA
_MessageCenter
BCS DumpMsgHndl
PHA ;work space
PHA ; for ptr
TSC
PHD
INC
TCD
*
* DP Space:
* |--------------|
* | ErrFlag | B
* |--------------|
* | userID | 9-A
* |--------------|
* | msgHndl | 4-7
* |--------------|
* | 2 PHA's | 0-3
* |--------------|
*
LDA [$04] ;Deref the mem handle
STA $00
LDY #$0002
LDA [$04],Y
STA $00+2
; Ref Vol 2 pg 24-15
LDY #$0006
LDA [$00],Y ;Get printFlag
BNE DelMsg
LDA $00 ;Open
CLC
ADC #$0008
STA $00 ;Point @ name (pString)
BCC :2
INC $00+2
:2 LDA [$00]
AND #$00FF ;Isolate len byte
SEP #$20 ;NB. 8-bit Acc
CMP $2003+2 ;Are the lens same?
BEQ :3 ;Yes
BCS DelMsg ;No
:3 TAY
:CpyLoop LDA [$00],Y ;Copy PN of
STA $2000+6,Y ; pgm for Interpreter
STA inBuf,Y ; to run
DEY
BPL :CpyLoop
*
* Stack contents:
* | |
* |--------------|
* | ErrFlag | D
* |--------------|
* | userID | B-C
* |--------------|
* | msgHndl | 7-A
* |--------------|
* | 2 PHA's | 3-6
* |--------------|
* | DP reg | 1-2
* |--------------|
* | |<- SP
*
LDA #$00 ;Overwrite ErrFlag
STA $0D,S ; which was $FF
DelMsg REP #$20 ;16-bit Acc
PLD
PLA
PLA
PushWord #3 ;action=delete
PushWord #1 ;type=file
PHA
PHA
_MessageCenter
DumpMsgHndl _DisposeHandle ;msgHndl
ShutDnMM _MMShutDown ;userID still on stack
MX %11
SEC ;Full emulation mode
XCE
PLA ;Get ErrFlag
BNE :Ret
LDX inBuf ;Get len byte
LDA #'/'
:CpyLoop CMP inBuf,X ;Look for a trailing slash
BEQ :1 ;Got one
DEX
BNE :CpyLoop
BRA :Ret
:1 DEX ;Backup 1
STX inBuf ;len byte of vol name
JSR GoPro
DB $C6
DA SPfxParm
LDA #$00 ;Flag no errs
:Ret RTS
*-------------------------------------------------
* Get the name of startup program that will be
* launched by an interpreter. Verify it's there.
* BI will look for a BASIC program called STARTUP
* C=0 - Success
GetStartup CLC ;Native mode
XCE
REP #$10
LDX #$2000+6 ;Get full/partial PN
JSR GetVolName ; of startup program
:loop SEC ;Full emulation mode
XCE
JSR GoPro
DB $C4
DA GFIParm
BCC :Rtn
CLC
XCE
REP #$30 ;Full 16-bit native mode
JSR Ask4Disk ;Ask for disk w/startup pgm
BCC :loop
SEC ;Back to emulation mode
XCE
SEC ;Flag failure
:Rtn RTS
*-------------------------------------------------
* ProDOS8 Parm tables
SPfxParm DB $01
DA inBuf
OpenParm DB $03
DA pnBuf ;Application's PN
DA IOBuf ;1024-byte I/O buf
OpenRefNbr DB $00
eofParm DB $02
eofRefNbr DB $00
theEOF DB 0,0,0
ReadParm DB $04
ReadRefNbr DB $00
DA $2000 ;Read into this location
ReadLen DW $0000
DW $0000
ClsParm DB $01
ClsRefNbr DB $00
QuitParms DB $04
DB $00 ;=$EE for enhanced Quit
DA $0000 ;Addr of pathname
DB $00
DW $0000
GFIParm DB $0A
DA VolNameStr
DB $00
DB $00
DW $0000
DB $00
DW $0000
DW $0000
DW $0000
DW $0000
DW $0000
* Messages/Button strings
CantRunStr STR 'Can'27't run next application.'
P8ErrStr DB 20 ;len byte
ASC 'ProDOS Error = $'
ErrNumStr ASC ' '
nullStr DB $00
insDskStr STR 'Please insert the disk:'
acceptStr DB 13
ASC 'Accept: '
HEX 1B ;Enable mousetext chars
HEX 0F ;Inverse
ASC 'M' ;Return Icon
HEX 0E ;Normal
HEX 18 ; ;Disable mousetext chars
cancelStr STR 'Cancel: Esc'

92
MLI.SRC/TCLOCK.S Normal file
View File

@ -0,0 +1,92 @@
***********************************************************
* *
* PRODOS 8 CLOCK DRIVER INTERFACE ROUTINE *
* *
* COPYRIGHT APPLE COMPUTER, INC., 1983-86 *
* *
* ALL RIGHTS RESERVED *
* *
***********************************************************
DUM $3A
TENS EQU * ;NO CONFLICT SINCE MONTH IS LAST PROCESSED.
MONTH DS 1
WKDAY DS 1
DAY DS 1
HOUR DS 1
MINUTE DS 1
DEND
WrtTCP EQU $C10B
RdTCP EQU $C108 ;CLOCK READ ENTRY POINTS
ClkMode EQU $0538 ;(+$CN=$5F8+N)
ORG ClockBegin
ReadClk LDX ClkSlt ;PRESERVE CURRENT MODE FOR THUNDERCLOCK
LDA ClkMode,X
PHA
LDA #$A3 ;SEND NUMERIC MODE BYTE TO THUNDERCLOCK
JSR WrtTCP
ClkSlt EQU *+2
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 FIRST, MONTH LAST
Convrt LDA inBuf,Y ;CONVERT VALUES TO BINAR
AND #$07 ;NO VALUE > 5 DECIMAL
STA TENS ;MULTIPLY 'TENS' PLACE VALUE
ASL
ASL
ADC TENS ;NOW IT'S TIMES 5
ASL ;NOW IT IS TIMES 10!
ADC inBuf+1,Y ;ADD TO ASCII 'ONES' PLACE
SEC ;AND SUBTRACT OUT THE ASCII...
SBC #"0"
STA MONTH,X ;SAVE CONVERTED VALUE
DEY ;INDEX TO NEXT LOWER VALUE
DEY
DEY
DEX ;ARE THERE MORE VALUES?
BPL Convrt ;BRANCH IF THERE ARE
TAY ;A STILL CONTAINS MONTH, SAVE IN Y FOR NOW
LSR
ROR
ROR
ROR ;(HI BIT OF MONTH HELD IN CARRY)
ORA DAY
STA DateLo ;SAVE LOW VALUE OF DATE
PHP ;SAVE HI BIT OF MONTH FOR NOW
AND #$1F ;ISOLATE DAY AGAIN
; (WHEN MONTH >7 CARRY SET ACCOUNTED FOR IN FOLLOWING ADD)
ADC TDays-1,Y ;REMEMBER THAT Y=MONTH
BCC :1 ;BRANCH NOT SEPT 13 THRU 30
ADC #$03 ;ADJUST FOR MOD 7 WHEN DAY > 256
:1 SEC
:loop SBC #$07
BCS :loop ;LOOP UNTIL LESS THAN 0
ADC #$07 ;NOW MAKE IT IN THE RANGE OF 0-6
SBC WKDAY ; THE DELTA PROVIDES YEARS OFFSET
BCS :2 ;BRANCH IF POSITIVE
ADC #$07 ;ELSE MAKE IT POSITIVE AGAIN
:2 TAY ;LOOK UP YEAR!
LDA YrAdj,Y
PLP ;LASTLY, COMBINE WITH HI BIT OF MONTH
ROL
STA DateLo+1 ;AND SAVE IT
LDA HOUR
STA TimeLo+1 ;MOVE HOUR AND MINUTE TO PRODOS GLOBALS
LDA MINUTE
STA TimeLo
PLA
LDX ClkSlt ;RESTORE PREVIOUS MODE
STA ClkMode,X
RTS ;ALL DONE...
TDays HEX 001F3B5A
HEX 7897B5D3
HEX F2143351
YrAdj HEX 605F5E5D
HEX 626160
DS $80-$7D,0

180
MLI.SRC/WRKSPACE.S Normal file
View File

@ -0,0 +1,180 @@
***********************************************************
* Global Data
ownersBlock DW $0000
ownersEnt DB $00
ownersLen DB $00
*-------------------------------------------------
* Part of volume dir header
h_creDate DW $0000 ;Directory creation date
DW $0000 ;Directory creation time
DB $00 ;Version under which this directory was created
DB $00 ;Earliest version that it's compatible with
h_attr DB $00 ;Attributes (protect bit, etc.)
h_entLen DB $00 ;Length of each entry in this dir
h_maxEnt DB $00 ;Maximum # of entries per block
h_fileCnt DW $0000 ;Current # of files in this dir
h_bitMap DW $0000 ;Disk Addr of first allocation bit map
h_totBlk DW $0000 ;Total number of blocks on this unit
d_dev DB $00 ;Device number of this directory entry
d_head DW $0000 ;Disk Addr of <sub> directory header
d_entBlk DW $0000 ;Disk Addr of block which contains this entry
d_entNum DB $00 ;Entry number within block
*-------------------------------------------------
* Layout of file entry
d_file EQU *
d_stor EQU *-d_file
DB $00 ;storage type * 16 + file name length
DS 15,0 ;file name
d_fileID EQU *-d_file
DB $00 ;User's identification byte
d_first EQU *-d_file
DW $0000 ;First block of file
d_usage EQU *-d_file
DW $0000 ;# of blks currently allocated to this file
d_eof EQU *-d_file
DB 0,0,0 ;Current end of file marker
d_creDate EQU *-d_file
DW $0000 ;date of file's creation
d_creTime EQU *-d_file
DW $0000 ;time of file's creation
d_sosVer EQU *-d_file
DB $00 ;SOS version that created this file
d_comp EQU *-d_file
DB $00 ;Backward version compatablity
d_attr EQU *-d_file
DB $00 ;'protect', read/write 'enable' etc.
d_auxID EQU *-d_file
DW $0000 ;User auxillary identification
d_modDate EQU *-d_file
DW $0000 ;File's last modification date
d_modTime EQU *-d_file
DW $0000 ;File's last modification time
d_dHdr EQU *-d_file
DW $0000 ;Header block address of file's directory
*-------------------------------------------------
scrtch DS 4,0 ;Scratch area for allocation address conversion
oldEOF DS 3,0 ;Temp used in w/r
oldMark DS 3,0 ;Used by 'RdPosn' and 'Write'
xvcbPtr DB $00 ;Used in 'cmpvcb' as a temp
vcbPtr DB $00 ;Offset into VCB table
fcbPtr DB $00 ;Offset into FCB table
fcbFlg DB $00 ;This is a flag to indicate a free FCB is available
reqL DB $00 ;# of free blks required
reqH DB $00
levels DB $00 ;Storage type (seedling,sapling etc)
* # of entries examined or
* used as a flag to indicate file is already open
totEnt DB $00 ;(0=open)
entCnt DW $0000 ;File count
* entries/block loop count or
* as a temp to return the refnum of a free FCB
cntEnt DB $00
* Free entry found flag (if > 0)
* # of 1st bitMap block with free bit on
* or bit for free
noFree DB $00
*-------------------------------------------------
* Variable work area
bmCnt DB $00 ;# in bitMap left to search
sapPtr DB $00
pathCnt DB $00 ;Pathname len
pathDev DB $00 ;Dev num for prefix dir header
pathBlok DW $0000 ;Block of prefix dir header
bmPtr DB $00 ;VBM byte offset in page
basVal DB $00 ;VBM page offset
half DB $00 ;VBM buf page (0 or 1)
* bit map info tables (a & b)
bmaStat DB $00 ;VBM flag (If $80, needs writing)
bmaDev DB $00 ;VBM device
bmaDskAdr DW $00 ;VBM blk number
bmaCurrMap DB $00 ;bitMap blk offset for multiblk VBM
* New mark to be positioned to for SetMark
* or new moving mark (for Read)
* or new EOF for SETEOF
tPosll DB $00
tPoslh DB $00
tPosHi DB $00
rwReqL DB $00 ;Request count (R/W etc)
rwReqH DB $00
nlChar DB $00
nlMask DB $00
ioAccess DB $00 ;Has a call been made to disk device handler?
bulkCnt EQU *
cmdTmp DB $00 ;Test refnum, time, and dskswtch for (pre)processing
bkBitFlg DB $00 ;Used for ReviseDir to set or clear back up bit
duplFlag DB $00 ;Difference between volNotFound and dupVol by synPath
vcbEntry DB $00 ;Pointer to current VCB entry
* xdos temporaries added....
namCnt DB $00 ;ONLINE: vol len - loop index
* Characters in current pathname index level or
* New pathname : index to last name
rnPtr DB $00
pnPtr EQU * ; Old pathname: index to last name or
namPtr DB $00 ;ONLINE: index to data buffer
vnPtr DB $00 ;Old PfixPtr value
prfxFlg DB $00 ;Pathname fully qualified flag (if $FF)
clsFlshErr EQU * ;Close-all err code
tempX DB $00 ;ONLINE: devcnt
* The following are used for deallocation temps.
firstBlkL DB $00
firstBlkH DB $00
storType DB $00
deBlock DW $0000 ;Count of freed blks
dTree DB $00 ;EOFblk # (MSB)
dSap DB $00 ;EOFblk # (LSB)
dSeed DW $0000 ;EOF byte offset into blk
topDest DB $00 ;EOF-master index counter
dTempX DB $00 ;ONLINE: devcnt
* Device table built by Online
* Also used by SetEOF to keep track
* of 8 blks to be freed at a time
deAlocBufL DS 8,0
deAlocBufH DS 8,0
lookList EQU deAlocBufL
cBytes DW $0000 ;Len of path, etc
DB $00 ;cbytes+2 must always be zero. See "CalcMark"
bufAddrL DB $00
bufAddrH DB $00 ;Buffer allocation, getbuffr, and release buffer temps.
goAdr DA $0000 ;Jump vector used for indirect JMP
delFlag DB $00 ;Used by DeTree to know if called from delete
DS $FEFD-*,0
dispVect EQU *
DA CallDisp ;Dispatcher/Selector
* This flag is set in the loader indicating
* whether the machine is a cortland
cortFlag DB 0 ;0=>non-cortland / 1=>cortland

373
MLI.SRC/XDOSMLI.S Normal file
View File

@ -0,0 +1,373 @@
* * * * * * * * * * * * * * * * *
* The xdos machine language *
* interface (MLI) *
* system call processor *
* * * * * * * * * * * * * * * * *
ORG orig1
MX %11
EntryMLI CLD ;Cannot deal with decimal mode!!!
PLA ;Get processor status
STA Spare1 ;Save it on the global page temporarily
STY SaveY ;Preserve the y and x registers
STX SaveX
PLA ;Find out the address of the caller
STA parm
CLC ; & preserve the address of the call spec
ADC #$04
STA CmdAdr
PLA
STA parm+1
ADC #$00
STA CmdAdr+1 ;CmdAdr is in the globals
* Check cmd code
LDA Spare1
PHA
PLP ;Pull processor to re-enable interrupts
CLD ;No decimal! (** #46 **)
LDY #$00
STY SErr ;Clear any previous errors...
* Hashing algorithm used here adds high nibble
* (div by 16 first) to the whole cmd code
* and then masks it to 5 lower bits
* This compresses range of codes without any overlapping
INY ;Find out if we've got a valid command
LDA (parm),Y ;Get command #
LSR ;Hash it to a range of $00-$1F
LSR
LSR
LSR
CLC
ADC (parm),Y
AND #$1F
TAX
LDA (parm),Y ;Now see if result is a valid command number
CMP scNums,X ;Should match if it is
BNE scnErr ;Branch if not
* Get IOB address
INY ;Index to call spec parm list addr
LDA (parm),Y ;Make parm point to parameter count byte
PHA ; in parameter block
INY
LDA (parm),Y
STA parm+1
PLA
STA parm
* Check parm count
LDY #c_pCnt ;Now make sure parameter list has the
LDA pCntTbl,X ; proper number of parameters
BEQ GoClock ;Clock has 0 parameters
CMP (parm),Y
BNE scpErr ;Report error if wrong count
* Check class of function
LDA scNums,X ;Get call number again
CMP #$65
BEQ Special
ASL ;Carry set if bfm or dev mgr
BPL GoDevMgr
BCS GoBFMgr
LSR ;Shift back down for interupt mgr
* Isolate type
* 0-alloc, 1-dealloc, 2-special
AND #$03 ;Valid calls are 0 & 1
JSR IntMgr
BRA ExitMLI ;Command processed, all done
Special JMP jSpare ;QUIT
**************************************************
* Command $82 - Get the date and time
GoClock JSR DateTime ;go read clock
BRA ExitMLI ;No errors posible!
**************************************************
* READBLOCK and WRITEBLOCK commands ($80 and $81)
GoDevMgr LSR ;Save command #
ADC #$01 ;Valid commands are 1 & 2
STA dhpCmd ;(READ & WRITE)
JSR DevMgr ;Execute read or write request
BRA ExitMLI
*-------------------------------------------------
* Commands $C0 thru $D3
GoBFMgr LSR
AND #$1F ;Valid commands in range of $00-$13
TAX
JSR BFMgr ;Go do it...
ExitMLI STZ BUBit ;First clear bubit
LDY SErr ;Y holds error code thru most of exit
CPY #$01 ;If >0 then set carry
TYA ; & set z flag
PHP ;Disable interupts
SEI ; until exit complete
LSR mliActv ;Indicate MLI done.(** #46 **) (** #85 **)
PLX ;Save status register in X
LDA CmdAdr+1 ; until return address is placed
PHA ; on the stack returning is done via 'RTI'
LDA CmdAdr ; so that the status register is
PHA ; restored at the same time
PHX ;Place status back on the stack
TYA ;Return error, if any
LDX SaveX ;Restore x & y registers
LDY SaveY
ExitRPM PHA ; (exit point for rpm **en3**)
LDA BnkByt1 ;Restore language card status & return
JMP Exit
*-------------------------------------------------
gNoDev LDA #drvrNoDevice ;Report no device connected
JSR SysErr
scnErr LDA #badSystemCall ;Report no such command
BNE scErr1 ;Branch always
scpErr LDA #invalidPcount ;report parameter count is invalid
scErr1 JSR GoSysErr
BCS ExitMLI ;Branch always taken
TTL 'ProDOS Device Manager'
*-------------------------------------------------
* ProDOS device manager
* Block I/O setup
DevMgr LDY #$05 ;The call spec for devices must
PHP ;(do not allow interupts)
SEI
:loop LDA (parm),Y ; be passed to drivers in zero page
STA |dhpCmd,Y ;dhpCmd,unitNum,bufPtr,blockNum
DEY
BNE :loop
LDX bufPtr+1
STX userBuf+1
INX
INX ;Add 2 for 512 byte range
LDA bufPtr ;Is buffer page alligned?
BEQ :1 ;Branch if it is
INX ;Else account for 3-page straddle...
:1 JSR ValDBufZ ;Make sure user is not conflicting
BCS DevMgrErr ; with protected RAM
JSR DMgr ;Call internal entry for device dispatch
BCS DevMgrErr ;Branch if error occured
PLP
CLC ;Make sure carry is clear (no error)
RTS
DevMgrErr PLP
GoSysErr JSR SysErr
*-------------------------------------------------
* NOTE: interrupts must always be off when entering here
* Do block I/O rtn
DMgr LDA unitNum ;Get device number
AND #$F0 ;Strip misc lower nibble
STA unitNum ; & save it back
LSR ;Use as index to device table
LSR
LSR
TAX
LDA DevAdr01,X ;Fetch driver address
STA goAdr
LDA DevAdr01+1,X
STA goAdr+1
GoCmd JMP (goAdr) ;Goto driver (or error if no driver)
TTL 'ProDOS Interrupt Manager'
*-------------------------------------------------
* ProDOS interrupt manager
* Handle ALLOC_INTERRUPTS ($40) and
* DEALLOC_INTERRUPTS ($41) Calls
IntMgr STA intCmd ;Allocate intrupt or deallocate?
LSR ;(A=0, carry set=dealloc)
BCS DeAlocInt ;Branch if deallocation
LDX #$03 ;Test for a free interupt space in table
AlocInt LDA Intrup1-2,X ;Test high addr for zero
BNE :1 ;Branch if spot occupied
LDY #c_intAdr+1 ;Fetch addr of routine
LDA (parm),Y ;Must not be in zero page!!!!
BEQ BadInt ;Branch if the fool tried it
STA Intrup1-2,X ;Save high address
DEY
LDA (parm),Y
STA Intrup1-3,X ; & low address
TXA ;Now return interupt # in range of 1 to 4
LSR
DEY
STA (parm),Y ;Pass back to user
CLC ;Indicate success!
RTS
:1 INX
INX ;Bump to next lower priority spot
CPX #$0B ;Are all four allocated already?
BNE AlocInt ;Branch if not
LDA #irqTableFull ;Return news that four devices are active
BNE IntErr1
BadInt LDA #paramRangeErr ;Report invalid parameter
IntErr1 JSR SysErr
DeAlocInt LDY #c_intNum ;Zero out interupt vector
LDA (parm),Y ; but make sure it is valid #
BEQ BadInt ;Branch if it's <1
CMP #$05 ; or >4
BCS BadInt
ASL
TAX
LDA #$00 ;Now zip it
STA Intrup1-2,X
STA Intrup1-1,X
CLC
RTS
*-------------------------------------------------
* IRQ Handler - If an IRQ occurs, we eventually get HERE
IrqRecev LDA Acc ;Get Acc from 0-page where old ROM put it
STA IntAReg
STX IntXReg ;Entry point on RAM card interupt
STY IntYReg
TSX
STX IntSReg
LDA IrqFlag ;Irq flag byte = 0 if old ROMs
BNE :1 ; and 1 if new ROMs
PLA
STA IntPReg
PLA
STA IntAddr
PLA
STA IntAddr+1
:1 TXS ;Restore return addr & p-reg to stack
LDA MSLOT ;Set up to re-enable $cn00 rom
STA IrqDev+2
TSX ;Make sure stack has room for 16 bytes
BMI NoStkSave ;Branch if stack safe
LDY #16-1
StkSave PLA
STA SvStack,Y
DEY
BPL StkSave
NoStkSave LDX #$FA ;Save 6 bytes of zero page
ZPgSave LDA $00,X
STA SvZeroPg-$FA,X
INX
BNE ZPgSave
* Poll interupt routines for a claimer
LDA Intrup1+1 ;Test for valid routine
BEQ :1 ;Branch if no routine
JSR goInt1
BCC IrqDone
:1 LDA Intrup2+1 ;Test for valid routine
BEQ :2 ;Branch if no routine
JSR goInt2 ;Execute routine
BCC IrqDone
:2 LDA Intrup3+1 ;Test for valid routine
BEQ :3 ;Branch if no routine
JSR goInt3
BCC IrqDone
:3 LDA Intrup4+1 ;Test for valid routine
BEQ IrqDeath ;Branch if no routine
JSR goInt4 ;Execute routine
BCC IrqDone
*************** see rev note #35 *************************
IrqDeath INC IrqCount ;Allow 255 unclaimed interrupts
BNE IrqDone ; before going to system death...
LDA #unclaimedIntErr
JSR SysDeath
* IRQ processing complete
IrqDone LDX #$FA
:loop LDA SvZeroPg-$FA,X
STA $00,X
INX
BNE :loop
LDX IntSReg ;Test for necessity of restoring stack elements
BMI :1
LDY #$00
:loop2 LDA SvStack,Y
PHA
INY
CPY #16
BNE :loop2
:1 LDA IrqFlag ;Check for old ROMs
BNE IrqDoneX ;Branch if new ROMs
* Apple II or II+ monitor
LDY IntYReg ;Restore registers
LDX IntXReg
LDA CLRROM ;Re-enable I/O card
IrqDev LDA $C100 ;Warning, self modified
LDA IrqDev+2 ;Restore device ID
STA MSLOT
IrqDoneX JMP irqXit
IrqFlag DB $00 ;irq flag byte. 0=old ROMs; 1=new ROMs
IrqCount DB $00 ;Unclaimed interrupt counter.(note #35)
SvStack DS 16,0
SvZeroPg DS 6,0
goInt1 JMP (Intrup1)
goInt2 JMP (Intrup2)
goInt3 JMP (Intrup3)
goInt4 JMP (Intrup4)
*-------------------------------------------------
* System error handler
SysErr1 STA SErr
PLX
PLX ;Pop 1 level of return
SEC
RTS
*-------------------------------------------------
* System death handler
SysDeath1 TAX ;System death!!!
STA CLR80VID ;Force 40 columns on rev-e
LDA TXTSET ;Text mode on
LDA cortFlag ;Check if we're on a cortland
BEQ NoSupHires
STZ NEWVIDEO ;Force off SuperHires
NoSupHires LDA TXTPAGE1 ;Display page 1 on
LDY #$13
DspDeath LDA #' '
STA SLIN10+10,Y
STA SLIN12+10,Y
LDA Death,Y
STA SLIN11+10,Y
DEY
BPL DspDeath
TXA
AND #$0F
ORA #"0"
CMP #"9"+1
BCC :1 ;Branch if not >9
ADC #$06 ;Bump to alpha A-F
:1 STA SLIN11+28
Halt BRA Halt ;Hold forever

567
MLI.SRC/XRW1.S Normal file
View File

@ -0,0 +1,567 @@
TTL 'xdos R/W routines revised'
****************************************************
*
* PRODOS 8 DISK II DRIVER (RWTS)
*
* COPYRIGHT APPLE COMPUTER INC., 1980-1986
*
* ALL RIGHTS RESERVED
*
* REVISED 11/8/82 BY J.R.H.
*
****************************************************
****************************
* *
* critical timing *
* requires page bound *
* considerations for *
* code and data *
* code----- *
* virtually the entire *
* 'write' routine *
* must not cross *
* page boundaries. *
* critical branches in *
* the 'write', 'read', *
* and 'read adr' subrs *
* which must not cross *
* page boundaries are *
* noted in comments. *
* *
****************************
* *
* Equates *
* *
maxCmd EQU 4 ;Commands 0-3 only
dvMot EQU $E8
DUM $3A
wTemp DS 1
midNib1 DS 1
midNib2 DS 1
lstNib DS 1
slotZ DS 1
yEnd DS 1
DEND
************************
* *
* device address *
* assignments *
* *
************************
phaseOff EQU $C080 ;stepper phase off.
*phaseOn EQU $C081 ;stepper phase on.
q6l EQU $C08C ;q7l,q6l=read
q6h EQU $C08D ;q7l,q6h=sense wprot
q7l EQU $C08E ;q7h,q6l=write
q7h EQU $C08F ;q7h,q6h=write store
****************************************
*
* Equates for rwts and block
*
****************************************
motorOff EQU $C088
motorOn EQU $C089
drv0En EQU $C08A
*drv1en EQU $C08B
ORG $D000
************************
* *
* block i/o *
* *
************************
BlockIO CLD ;This must be first as it is an ID value
JSR ResetPhase
* this is patch 76 part 1. part 2 is in xrw2.
* this is patch 77, use to be 'lda q7l+14,x'.
LDA q7l,X ;Turn off write enable please!!!
* (pad is just spare bytes but the number is critical for page
NOP
NOP
JSR doCheck
BCS BadBlk ;Branch if block # is out of range
LDY #$05
:loop ASL
ROL ibTrk
DEY
BNE :loop
ASL
BCC :1
ORA #$10 ;Adjust for upper 4 blks of trk
:1 LSR
LSR
LSR
LSR
PHA ;Save sector#
JSR RegRWTS
PLA ;Restore sector #
BCS Quit ;Branch if error encountered
INC bufPtr+1
ADC #$02
JSR RegRWTS ;Get second half of block
DEC bufPtr+1
Quit LDA ibStat
RTS
BadBlk LDA #drvrIOError
SEC
RTS
**************************
* *
* read/write a *
* track and sector *
* *
**************************
RegRWTS LDY #$01 ;Retry count
STY seekCnt ;Only one recalibrate per call
STA ibSect
LDA unitNum ;Get slot # for this operation
AND #$70
STA slotZ
JSR ChkPrev ;Make sure other drives in other slots are stopped
*
* Now check if the motor is on, then start it
*
JSR ChkDrv ;Set zero flag if motor stopped
PHP ;Save test results
LDA #dvMot
STA monTimeH
LDA unitNum ;Determine drive one or two
CMP iobPrevDn ;Same drive used before?
STA iobPrevDn ;Save it for next time
PHP ;Keep results of compare
ASL ;Get drive number into carry
LDA motorOn,X ;Turn on the drive
BCC DrvSel ;Branch if drive 1 selected
INX ;Select drive 2
DrvSel LDA drv0En,X
PLP ;Was it same drive?
BEQ :1 ;Yes
PLP ;Must indicate drive off by setting zero flag
LDY #$07 ;Delay 150 ms before stepping
:WaitLoop JSR msWait ;(on return A=0)
DEY
BNE :WaitLoop
PHP ;Now zero flag set
:1 LDA dhpCmd ;Make sure this command needs seeking
BEQ :2 ;Branch if status check
LDA ibTrk ;Get destination track
JSR MySeek ; & go to it
* Now at the desired track. Was the motor
* on to start with?
:2 PLP ;Was motor on?
BNE TryTrk ;If so, don't delay, get it today!
* Motor was off, wait for it to speed up.
MotOff LDA #$01 ;Wait exactly 100 us for each count in monTime
JSR msWait
LDA monTimeH
BMI MotOff ;count up to 0000
****************************************
*
* Motor should be up to speed.
* If it still 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.
TryTrk LDA dhpCmd ;Get command code #
BEQ StatCmd ;If $00, then status command
LSR ;Set carry=1 for read, 0 for write
BCS :1 ;Must prenibblize for write
JSR PreNibl16
:1 LDY #$40 ;Only 64 retries of any kind
STY retryCnt
TryAdr LDX slotZ ;Get slot num into X-reg
JSR RdAdr16 ;Read next address field
BCC RdRight ;If read it right, hurrah!
TryAdr2 DEC retryCnt ;Another mistake!!
BPL TryAdr ;Well, let it go this time...
LDA #drvrIOError ;Anticipate a bad drive error
DEC seekCnt ;Only recalibrate once!
BNE HndlErr ;Tried to recalibrate a second time, error!
LDA curTrk ;Save track we really want
PHA
ASL
ADC #$10 ;Pretend track is 8>curtrk
LDY #$40
STY retryCnt ;Reset retries to 64 max
BNE ReCal1 ;Branch always
* Have now read an address field correctly.
* Make sure this is the desired track, sector, and volume.
RdRight LDY track ;On the right track?
CPY curTrk
BEQ RtTrk ;if so, good
* Recalibrating from this track
LDA curTrk ;Preserve destination track
PHA
TYA
ASL ;(washing machine fix!)
ReCal1 JSR SetTrk
PLA
JSR MySeek
BCC TryAdr ;Go ahead and recalibrate
* Drive is on right track, check volume mismatch
RtTrk LDA sector ;Check if this is the right sector
CMP ibSect
BNE TryAdr2 ;No, try another sector
LDA dhpCmd ;read or write?
LSR ;The carry will tell
BCC WriteIt ;Carry was set for read operation,
JSR Read16 ; cleared for write
BCS TryAdr2 ;Carry set upon return if bad read
AllDone EQU * ;Was CLC
LDA #$00 ;No error
DB $D0 ;Branch never (skip 1 byte)
HndlErr SEC ;Indicate an error
STA ibStat ;Give him error #
LDX slotZ ;Get the slot offset
LDA motorOff,X ;Turn it off...
RTS ;All finished!
WriteIt JSR Write16 ;Write nybbles now
StatDone BCC AllDone ;If no errors
LDA #drvrWrtProt ;Disk is write protected!!
BNE HndlErr ;Branch always
StatCmd LDX slotZ
LDA q6h,X ;Test for write protected
LDA q7l,X
ROL ;Write protect-->carry-->bit-0=1
LDA q6l,X ;Keep in read mode...
JMP StatDone ;Branch always taken
* This is the 'seek' routine
* seeks track 'n' in slot #x/$10
* If drivno is negative, on drive 0
* If drivno is positive, on drive 1
MySeek ASL ;Assume two phase stepper
STA track ;Save destination track(*2)
JSR AllOff ;Turn all phases off to be sure
JSR DrvIndx ;Get index to previous track for current drive
LDA drv0Trk,X
STA curTrk ;This is where i am
LDA track ; & where i'm going to
STA drv0Trk,X
JSR Seek ;Go there!
AllOff LDY #$03 ;Turn off all phases before returning
NxtOff TYA ;(send phase in Acc)
JSR ClrPhase ;Carry is clear, phases should be turned off
DEY
BPL NxtOff
LSR curTrk ;Divide back down
CLC
RTS ;All off... now it's dark
**************************
* *
* fast seek subroutine *
**************************
* *
* on entry ---- *
* *
* x-reg holds slotnum *
* times $10. *
* *
* a-reg holds desired *
* halftrack. *
* (single phase) *
* *
* curtrk holds current *
* halftrack. *
* *
* on exit ----- *
* *
* a-reg uncertain. *
* y-reg uncertain. *
* x-reg undisturbed. *
* *
* curtrk and trkn hold *
* final halftrack. *
* *
* prior holds prior *
* halftrack if seek *
* was required. *
* *
* montimel and montimeh *
* are incremented by *
* the number of *
* 100 usec quantums *
* required by seek *
* for motor on time *
* overlap. *
* *
* --- variables used --- *
* *
* curtrk, trkn, count, *
* prior, slottemp *
* montimel, montimeh *
* *
**************************
Seek STA trkNbr ;Save target track
CMP curTrk ;On desired track?
BEQ SetPhase ;Yes,energize phase and return
LDA #$00
STA trkCnt ;Halftrack count
SeekLoop LDA curTrk ;Save curTrk for
STA prior ; delayed turnoff
SEC
SBC trkNbr ;delta-tracks
BEQ SeekEnd ;branch if curTrk=destination
BCS Out ;(move out, not in)
EOR #$FF ;Calc trks to go
INC curTrk ;Incr current track (in)
BCC MinTst ;(always taken)
Out ADC #$FE ;Calc trks to go
DEC curTrk ;Decr current track (out)
MinTst CMP trkCnt
BCC MaxTst ; & 'trks moved'
LDA trkCnt
MaxTst CMP #$09
BCS Step2 ;If trkcnt>$8 leave y alone (y=$8)
TAY ;else set acceleration index in y
SEC
Step2 JSR SetPhase
LDA OnTable,Y ;For 'ontime'
JSR msWait ;(100 usec intervals)
LDA prior
CLC ;For phaseoff
JSR ClrPhase ;Turn off prior phase
LDA OffTable,Y
JSR msWait
INC trkCnt ;'tracks moved' count
BNE SeekLoop ;(always taken)
SeekEnd JSR msWait ;Settle 25 msec
CLC ;Set for phase off
SetPhase LDA curTrk ;Get current track
ClrPhase AND #$03 ;Mask for 1 of 4 phases
ROL ;Double for phaseon/off index
ORA slotZ
TAX
LDA phaseOff,X ;Turn on/off one phase
LDX slotZ ;Restore x-reg
RTS ; & return
**************************
* *
* 7-bit to 6-bit *
* 'deniblize' tabl *
* (16-sector format) *
* *
* valid codes *
* $96 to $ff only. *
* *
* codes with more than *
* one pair of adjacent *
* zeroes or with no *
* adjacent ones (except *
* bit 7) are excluded. *
* *
* *
* nibls in the ranges *
* of $a0-$a3, $c0-$c7, *
* $e0-$e3 are used for *
* other tables since no *
* valid nibls are in *
* these ranges. *
**************************
dNibble EQU *-$96
HEX 0004
HEX FFFF080C
HEX FF101418
TwoBit3 HEX 008040C0 ;Used in fast prenib as
HEX FFFF1C20 ; lookup for 2-bit quantities
HEX FFFFFF24
HEX 282C3034
HEX FFFF383C
HEX 4044484C
HEX FF505458
HEX 5C606468
TwoBit2 HEX 00201030 ;Used in fast prenib
EndMarks HEX DEAAEBFF ;Table using 'unused'
HEX FFFFFF6C ; nibls ($c4,$c5,$c6,$c7)
HEX FF707478
HEX FFFFFF7C
HEX FFFF8084
HEX FF888C90
HEX 94989CA0
TwoBit1 HEX 0008040C ;Used in fast prenib
HEX FFA4A8AC
HEX FFB0B4B8
HEX BCC0C4C8
HEX FFFFCCD0
HEX D4D8DCE0
HEX FFE4E8EC
HEX F0F4F8FC
* page align the following tables.
***************************
* *
* 6-bit to 2-bit *
* conversion tables. *
* *
* dnibl2 abcdef-->0000fe *
* dnibl3 abcdef-->0000dc *
* dnibl4 abcdef-->0000ba *
* *
***************************
* *
* 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. *
* *
***************************
dNibble2 DB $00
dNibble3 DB $00
dNibble4 DB $00
Nibbles HEX 9602000097
HEX 0100009A0300009B
HEX 0002009D0202009E
HEX 0102009F030200A6
HEX 000100A7020100AB
HEX 010100AC030100AD
HEX 000300AE020300AF
HEX 010300B2030300B3
HEX 000002B4020002B5
HEX 010002B6030002B7
HEX 000202B9020202BA
HEX 010202BB030202BC
HEX 000102BD020102BE
HEX 010102BF030102CB
HEX 000302CD020302CE
HEX 010302CF030302D3
HEX 000001D6020001D7
HEX 010001D9030001DA
HEX 000201DB020201DC
HEX 010201DD030201DE
HEX 000101DF020101E5
HEX 010101E6030101E7
HEX 000301E9020301EA
HEX 010301EB030301EC
HEX 000003ED020003EE
HEX 010003EF030003F2
HEX 000203F3020203F4
HEX 010203F5030203F6
HEX 000103F7020103F9
HEX 010103FA030103FB
HEX 000303FC020303FD
HEX 010303FE030303FF
nBuf2 DS $56,0 ;nibble buffer for R/W of low 2-bits of each byte
ibTrk DB $00
ibSect DB $00
ibStat DB $00
iobPrevDn DB $00
curTrk DB $00
drv0Trk EQU *-2
HEX 00000000000000 ;for slots 1 thru 7
HEX 00000000000000 ;drives 1 & 2
retryCnt DS 1,0
seekCnt DS 1,0
************************
* *
* readadr---- *
* *
************************
count EQU * ;'must find' count
last DS 1,0 ;'odd bit' nibls
chkSum DS 1,0 ;Used for address header cksum
csSTV DS 4,0
* checksum, sector, track, and volume.
sector EQU csSTV+1
track EQU csSTV+2
volume EQU csSTV+3
trkCnt EQU count ;Halftracks moved count
prior DS 1,0
trkNbr DS 1,0
************************
* *
* mswait ---- *
* *
************************
monTimeL equ csSTV+2 ;Motor-on time
monTimeH equ monTimeL+1 ;counters.
**************************
* *
* phase on-, off-time *
* tables in 100-usec *
* intervals. (seek) *
* *
**************************
OnTable HEX 013028
HEX 24201E
HEX 1D1C1C
OffTable HEX 702C26
HEX 221F1E
HEX 1D1C1C
**************************
* *
* mswait subroutine *
* *
**************************
* *
* delays a specified *
* number of 100 usec *
* intervals for motor *
* on timing. *
* *
* on entry ---- *
* *
* a-reg: holds number *
* of 100 usec *
* intervals to *
* delay. *
* *
* on exit ----- *
* *
* a-reg: holds $00. *
* x-reg: holds $00. *
* y-reg: unchanged. *
* carry: set. *
* *
* montimel, montimeh *
* are incremented once *
* per 100 usec interval*
* for moton on timing. *
* *
* assumes ---- *
* *
* 1 usec cycle time *
* *
**************************
msWait LDX #$11
:loop DEX ;Delay 86 usec
BNE :loop
INC monTimeL
BNE :1 ;double-byte
INC monTimeH ; increment
:1 SEC
SBC #$01 ;Done 'n' intervals?
BNE msWait ;(A-reg counts)
RTS

644
MLI.SRC/XRW2.S Normal file
View File

@ -0,0 +1,644 @@
****************************
* *
* read address field *
* subroutine *
* (16-sector format) *
* *
****************************
* *
* reads volume, track *
* and sector *
* *
* on entry ---- *
* *
* xreg: slotnum times $10 *
* *
* read mode (q6l, q7l) *
* *
* on exit ----- *
* *
* carry set if error. *
* *
* if no error: *
* a-reg holds $aa. *
* y-reg holds $00. *
* x-reg unchanged. *
* carry clear. *
* *
* csstv holds chksum, *
* sector, track, and *
* volume read. *
* *
* uses temps count, *
* last, csum, and *
* 4 bytes at csstv. *
* *
* expects ---- *
* *
* original 10-sector *
* normal density nibls *
* (4-bit), odd bits, *
* then even. *
* *
* caution ---- *
* *
* observe *
* 'no page cross' *
* warnings on *
* some branches!! *
* *
* assumes ---- *
* *
* 1 usec cycle time *
* *
****************************
RdAdr16 LDY #$FC
STY count ;'must find' count
RdASyn INY
BNE :loop1 ;Low order of count
INC count ;(2k nibbles to find
BEQ RdErr ; adr mark, else err)
:loop1 LDA q6l,X ;Read nibble
BPL :loop1 ;*** no page cross! ***
RdASyn1 CMP #$D5 ;Adr mark 1?
BNE RdASyn ;(loop if not)
NOP ;Added nibble delay
LDA q6l,X
BPL *-3 ;*** no page cross! ***
CMP #$AA ;Adr mark 2?
BNE RdASyn1 ; (if not, is it am1?)
* (added nibl delay)
LDY #$03 ;Index for 4-byte read
LDA q6l,X
BPL *-3 ;*** no page cross! ***
CMP #$96 ;Adr mark 3?
BNE RdASyn1 ; (if not, is it am1?)
SEI ;No interupts until address is tested.(carry is set)
LDA #$00 ;Init checksum
RdAddrFld STA chkSum
LDA q6l,X ;Read 'odd bit' nibble
BPL *-3 ;*** no page cross! ***
ROL ;Align odd bits, '1' into lsb
STA last ; (save them)
LDA q6l,X ;Read 'even bit' nibble
BPL *-3 ;*** no page cross! ***
AND last ;Merge odd and even bits
STA csSTV,Y ;Store data byte
EOR chkSum
DEY
BPL RdAddrFld ;Loop on 4 data bytes
TAY ;If final checksum
BNE RdErr ; nonzero, then error
LDA q6l,X ;First bit-slip nibble
BPL *-3 ;*** no page cross! ***
CMP #$DE
BNE RdErr ;Error if nonmatch
NOP ;delay
LDA q6l,X ;Second bit-slip nibble
BPL *-3 ;*** no page cross! ***
CMP #$AA
BNE RdErr ;Error if nonmatch
CLC ;Clear carry on
RTS ;Normal read exits
RdErr SEC
RTS
**************************
* *
* read subroutine *
* (16-sector format) *
* *
**************************
* *
* reads encoded bytes *
* into nbuf1 and nbuf2 *
* *
* first reads nbuf2 *
* high to low, *
* then reads nbuf1 *
* low to high. *
* *
* on entry ---- *
* *
* x-reg: slotnum *
* times $10. *
* *
* read mode (q6l, q7l) *
* *
* on exit ----- *
* *
* carry set if error. *
* *
* if no error: *
* a-reg holds $aa. *
* x-reg unchanged. *
* y-reg holds $00. *
* carry clear. *
* caution ----- *
* *
* observe *
* 'no page cross' *
* warnings on *
* some branches!! *
* *
* assumes ---- *
* *
* 1 usec cycle time *
* *
**************************
Read16 TXA ;Get slot #
ORA #$8C ;Prepare mods to read routine
STA Read4+1 ;Warning: the read routine is self modified!!!
STA Read5+1
STA Read6+1
STA Read7+1
STA Read8+1
LDA bufPtr ;Modify storage addresses also
LDY bufPtr+1
STA Ref3+1
STY Ref3+2
SEC
SBC #$54
BCS :1
DEY
:1 STA Ref2+1
STY Ref2+2
SEC
SBC #$57
BCS :2 ;Branch if no borrow
DEY
:2 STA Ref1+1
STY Ref1+2
LDY #$20 ;'must find count'
rSync DEY
BEQ RdErr2 ;Branch if can't find data header marks
LDA q6l,X
BPL *-3
rSync1 EOR #$D5 ;First data mark
BNE rSync
NOP ;Waste a little time...
LDA q6l,X
BPL *-3
CMP #$AA ;Data mark 2
BNE rSync1 ;If not, check for first again
NOP
LDA q6l,X
BPL *-3
CMP #$AD ;Data mark 3
BNE rSync1 ;If not, check for data mark 1 again
LDY #$AA
LDA #$00
RdData1 STA wTemp ;Use zpage for checksum keepin
Read4 LDX $C0EC ;Warning: self modified
BPL Read4
LDA dNibble,X
STA nBuf2-$AA,Y ;Save the two-bit groups in nbuf
EOR wTemp ;Update checksum
INY ;Bump to next nBuf2 position
BNE RdData1 ;Loop for all $56 two-bit groups
LDY #$AA ;Now read directly into user buffer
BNE Read5 ;Branch always taken!!!
RdErr2 SEC
RTS
Ref1 STA $1000,Y ;Warning: self modified!
Read5 LDX $C0EC
BPL Read5
EOR dNibble,X ;Get actual 6-bit data from dNibble table
LDX nBuf2-$AA,Y ;Get associated two-bit pattern
EOR dNibble2,X ; & combine to form whole byte
INY
BNE Ref1 ;Loop for $56 bytes
PHA ;Save this byte for now, no time to store...
AND #$FC ;Strip low 2 bits...
LDY #$AA ;Prepare for next $56 bytes
Read6 LDX $C0EC
BPL Read6
EOR dNibble,X
LDX nBuf2-$AA,Y
EOR dNibble3,X
Ref2 STA $1000,Y ;Warning: self modified
INY
BNE Read6 ;Loop until this group of $56 read in
*
Read7 LDX $C0EC
BPL Read7
AND #$FC
LDY #$AC ;Last group is $54 long
RdData2 EOR dNibble,X
LDX nBuf2-$AC,Y
EOR dNibble4,X ;Combine to form full byte
Ref3 STA $1000,Y
Read8 LDX $C0EC ;Warning: self modified
BPL Read8
INY
BNE RdData2
AND #$FC
EOR dNibble,X ;Check sum ok?
BNE RdErr1 ;Branch if not
LDX slotZ ;Test end marks
LDA q6l,X
BPL *-3
CMP #$DE
CLC
BEQ RdOK ;Branch if good trailer...
RdErr1 SEC
RdOK PLA
LDY #$55 ;Place last byte into user buffer
STA (bufPtr),Y
RTS
* This subroutine sets the slot
* dependent track location.
SetTrk JSR DrvIndx ;Get index to drive number
STA drv0Trk,X
RTS
*****************************************
*
* Subrtn to tell if motor is stopped
*
* If motor is stopped, controller's
* shift reg will not be changing.
*
* return y=0 and zero flag set if it is stopped.
*
*****************************************
ChkDrv LDX slotZ
ChkDrv0 LDY #$00 ;init loop counter
:loop LDA q6l,X ;read the shift reg
JSR :ChkDrvRTS ;delay
PHA
PLA ;more delay
CMP q6l,X
BNE :ChkDrvRTS
LDA #$28
DEY
BNE :loop
:ChkDrvRTS RTS
DrvIndx PHA ;Preserve Acc
LDA unitNum ;DSSS xxxx where D=0/1 & SSS=slot #
LSR
LSR
LSR
LSR ;0000 DSSS
CMP #$08 ;C=1 -> drive 2
AND #$07 ;0000 0SSS
ROL ;0000 SSSD
TAX ;Into X for index to table
PLA ;Restore A
RTS
************************
* *
* write subr *
* (16-sector format) *
* *
************************
* *
* writes data from *
* nbuf1 and buf *
* *
* first nbuf2, *
* high to low. *
* then direct from *
* (buf), low to high. *
* self modified code!! *
* on entry ---- *
* *
* x-reg: slotnum *
* times $10. *
* *
* *
* on exit ----- *
* *
* carry set if error. *
* (w prot violation) *
* *
* if no error: *
* *
* a-reg uncertain. *
* x-reg unchanged. *
* y-reg holds $00. *
* carry clear. *
* *
* assumes ---- *
* *
* 1 usec cycle time *
* *
************************
Write16 SEC ;Anticipate wprot err
LDA q6h,X
LDA q7l,X ;Sense wprot flag
BPL :1
JMP WExit ;Exit if write protected
:1 LDA nBuf2
STA wTemp
LDA #$FF ;Sync data
STA q7h,X ;(5) Goto write mode
ORA q6l,X ;(4)
LDY #$04 ;(2) For five nibbles
NOP ;(2)
PHA ;(3)
PLA ;(4)
WSync PHA ;(3) exact timing
PLA ;(4) exact timing
JSR WrNibl7 ;(13,9,6) write sync
DEY ;(2)
BNE WSync ;(3-) must not cross page!
LDA #$D5 ;(2) 1st data mark
JSR WrNibl9 ;(15,9,6)
LDA #$AA ;(2) 2nd data mark
JSR WrNibl9 ;(15,9,6)
LDA #$AD ;(2) 3rd data mark
JSR WrNibl9 ;(15,9,6)
TYA ;(2) zero checksum
LDY #$56 ;(2) nbuf2 index
BNE wData1 ;(3) branch always taken
wData0 LDA nBuf2,Y ;(4) prior 6-bit nibble
wData1 EOR nBuf2-1,Y ;(5) xor with current
TAX ;(2) index to 7-bit nibl (nBuf2 must be on page bdry)
LDA Nibbles,X ;(4) must not cross page boundary
LDX slotZ ;(3) restore slot index
STA q6h,X ;(5) store encoded byte
LDA q6l,X ;(4) time must = 32 us per byte!
DEY ;(2)
BNE wData0 ;(3-) must not cross page boundary
LDA wTemp ;(3) get prior nibble (from nBuf2)
WRefDr1 LDY #$00 ;(2) warning: load value modified by prenib!
WData2 EQU *
WRefAdr1 EOR $1000,Y ;(4) warning: address modified by prenib!
AND #$FC ;(2)
TAX ;(2) index to Nibbles table
LDA Nibbles,X ;(4)
WRefDr2 LDX #$60 ;(2) warning: load value modified by prenib
STA q6h,X ;(5) write nibl
LDA q6l,X ;(4) handshake
WRefAdr2 LDA $1000,Y ;(4) prior nibl. warning: address modified by prenib
INY ;(2) all done with this page?
BNE WData2 ;(3-) loop until page end
LDA midNib1 ;(3) get next (precalculated and translated) nibl
BEQ WrtDone ;(2+) branch if code writen was page aligned
LDA yEnd ;(3) get byte address of last byte to be written
BEQ WData4 ;(2+) branch if only 1 byte left to write
LSR ;(2) test for odd or even last byte (carry set or clear)
LDA midNib1 ;(3) restore nibl to a
STA q6h,X ;(5)
LDA q6l,X ;(4)
LDA midNib2 ;(3) =byte 0 of second page. xor'd with byte 1 if above test set carry
NOP ;(2) waste time
INY ;(2) y=1
BCS WrtOdd ;(2+) branch if last byte to be odd
WData3 EQU *
WRefAdr3 EOR $1100,Y ;(4) warning: address modified by prenib
AND #$FC ;(2) strip low 2 bits
TAX ;(2) index to Nibbles table
LDA Nibbles,X ;(4) get nibble
WRefDr3 LDX #$60 ;(2) restore slot index. warning: modified by prenib
STA q6h,X ;(5)
LDA q6l,X ;(4)
WRefAdr4 LDA $1100,Y ;(4) warning: modified by prenib
INY ;(2) got prior nibble, bump to next
WRefAdr5 EOR $1100,Y ;(4) warning: modified by prenib
WrtOdd CPY yEnd ;(3) set carry if this is last nibble
AND #$FC ;(2)
TAX ;(2)
LDA Nibbles,X ;(4)
WRefDr4 LDX #$60 ;(2) restore slot. warning: modified by prenib
STA q6h,X ;(5)
LDA q6l,X ;(4)
WRefAdr6 LDA $1100,Y ;(4) get prior. warning: these warnings are all the same
INY ;(2)
BCC WData3 ;(3-) branch if that was not the las
BCS *+2 ;(3) waste 3 cycles, branch always
BCS WrtDone ;(3) branch always
WData4 LDA |midNib1 ;(4) absolute reference to zero page
STA q6h,X ;(5)
LDA q6l,X ;(4)
PHA ;(3) waste 14 us total
PLA ;(4)
PHA ;(3)
PLA ;(4)
WrtDone LDX lstNib ;(3) use last nibl (anded with $fc) for checksum
LDA Nibbles,X ;(4)
WRefDr5 LDX #$60 ;(2) restore slot. warning: see above warnings...
STA q6h,X ;(5)
LDA q6l,X ;(4)
LDY #$00 ;(2) set y to index end mark table
PHA ;(3) waste another 11 us
PLA ;(4)
NOP ;(2)
NOP ;(2)
WrEndMrk LDA EndMarks,Y ;(4) dm4, dm5, dm6, and turn off byte
JSR WrNibl ;(15,6) write it
INY ;(2)
CPY #$04 ;(2) have all end marks been written?
BNE WrEndMrk ;(3)
CLC ;(2,9)
WExit LDA q7l,X ;Out of write mode
LDA q6l,X ;Into read mode
RTS ;Return from write
****************************
* *
* 7-bit nibl write subrs *
* *
* a-reg or'd prior exit *
* carry cleared *
* *
****************************
WrNibl9 CLC ;(2) 9 cycles, then write
WrNibl7 PHA ;(3) 7 cycles, then write
PLA ;(4)
WrNibl STA q6h,X ;(5) nibble write subrtn
ORA q6l,X ;(4) clobbers acc, not carry
RTS ;(6)
****************************
* *
* preniblize subr *
* (16-sector format) *
* *
****************************
* *
* converts 256 bytes of *
* user data in (buf) into *
* 6 bit nibls into nbuf2 *
* high 6 bits are trans- *
* lated 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 users *
* buffer data. *
****************************
PreNibl16 LDA bufPtr ;First self modify addresses so we can be fast!
LDY bufPtr+1 ;Y contains high order address
CLC ;All offsets are -$AA...
ADC #$02 ;The highest set is bufPtr+$AC
BCC :1 ;Branch if no carry
INY ;Otherwise add carry to high address
:1 STA PrN3+1 ;Self mod 3
STY PrN3+2
SEC
SBC #$56 ;middle set is buf+$56
BCS :2 ;branch if no borrow
DEY ;otherwise deduct from high...
:2 STA PrN2+1 ;self mod 2
STY PrN2+2
SEC
SBC #$56 ;Low set is exactly bufPtr
BCS :3
DEY
:3 STA PrN1+1 ;self mod 1
STY PrN1+2
LDY #$AA ;Count up to 0
PreNib4 EQU *
PrN1 LDA $1000,Y ;Fetch byte from lowest group. warning: self modified
AND #%00000011 ;Strip high 6 bits
TAX ;Index to 2 bit equiv
LDA TwoBit1,X
PHA ;save pattern
PrN2 LDA $1056,Y ;fetch from middle group
AND #%00000011
TAX
PLA ;Restore pattern
ORA TwoBit2,X ;Combine second group with first
PHA ;Save new pattern
PrN3 LDA $10AC,Y ;Get highest group
AND #%00000011
TAX
PLA ;Restore new pattern
ORA TwoBit3,X ; & form final nibble
PHA
TYA
EOR #$FF
TAX
PLA
STA nBuf2,X ;Save in nibble buffer!
INY ;Bump to next set
BNE PreNib4 ;Loop until all $56 nibbles formed
LDY bufPtr ;Now prepare data bytes for write16 routine
DEY ;Prepare end addr
STY yEnd
LDA bufPtr
STA WRefDr1+1 ;warning: the following storage addresses starting
BEQ WrMod1 ; with 'wref' are referces into code space,
EOR #$FF ; changed by this routine
TAY ;Index to last byte of page pointed to by buf
LDA (bufPtr),Y ;Pre-niblize the last byte of the page with
INY ; the first byte of the next page
EOR (bufPtr),Y
AND #$FC
TAX
LDA Nibbles,X ;Get disk 7-bit nibble equivalent
WrMod1 STA midNib1
BEQ WrMod3 ;Branch if data to be written is page aligned
LDA yEnd ;Find out if last byte is even or odd address
LSR ;Shift even/oddness into carry
LDA (bufPtr),Y ;If even, then leave intact
BCC WrMod2 ;Branch if odd
INY ;If even, then pre-xor with byte 1
EOR (bufPtr),Y
WrMod2 STA midNib2 ;Save result for write routine
WrMod3 LDY #$FF ;Index to last byte of data to be writen
LDA (bufPtr),Y ; to be used as checksum
AND #$FC ;Strip extra bits
STA lstNib ;Save it
LDY bufPtr+1 ;Now modify address reference to user data
STY WRefAdr1+2
STY WRefAdr2+2
INY
STY WRefAdr3+2
STY WRefAdr4+2
STY WRefAdr5+2
STY WRefAdr6+2
LDX slotZ ; & lastly index references to controller
STX WRefDr2+1
STX WRefDr3+1
STX WRefDr4+1
STX WRefDr5+1
RTS ;All done
ChkPrev EOR iobPrevDn ;Same slot as last?
ASL
BEQ :Rtn ;Yes
LDA #$01
STA monTimeH
:CkLoop LDA iobPrevDn ;=DSSS xxxx
AND #$70 ;=0SSS 0000
TAX
BEQ :Rtn ;Branch if no previous ever (boot only)
JSR ChkDrv0 ;Find out if previous drive running
BEQ :Rtn ;Branch if stopped
LDA #$01 ;Waste some time
JSR msWait
LDA monTimeH
BNE :CkLoop
:Rtn RTS
* ----------------- see rev notes 14, 18 & 70 -------------
ResetPhase LDA unitNum ;Get unit number
AND #$7F ;Map off hi bit (drive bit)
TAX
* clear all the phases and force read mode
* patch 76 part 2. part 1 is in xrw1.
LDA phaseOff,X ;make sure all motor
LDA phaseOff+2,X ; phases are off
LDA phaseOff+4,X
LDA phaseOff+6,X
RTS
* ---------------------------------------------------------
doCheck LDA dhpCmd ;Get the command number
CMP #maxCmd ;Is the command allowable?
BCS doChkBad ;Branch if not!
LDA blockNum
LDX blockNum+1
STX ibTrk ;Calculate block's track & sector
BEQ doChkOK ;Branch if block # in range
DEX ;else test further
BNE doChkBad ;Bad range
CMP #$18 ;Must be <$118 (280)
BCC doChkOK
doChkBad SEC ;Set carry for an error
RTS
doChkOK CLC
RTS
LD6EA DS 2,0 ;Not used
* ---------------------------------------------------------
* Variables for handling mirror devices
* NB. Values of SmartPort unit #s: $00, $01-$7E
* Status List - ref pg 122 IIGS Firmware
spStatList EQU *
genStatus DB 0
spDevTotBlks DB 0,0,0 ;# of blocks
spUnits DS $F,0 ;table of SmartPort unit #s
DB 0

BIN
P8_SRC.2mg Normal file
View File

Binary file not shown.

6
Readme.md Normal file
View File

@ -0,0 +1,6 @@
Disassembly of the ProDOS 8 v2.03
The Merlin-16+ Assembler is recommended as the preferred tool to re-assemble the source files. There are instructions within the disk image on how to generate the P8 binary.
Special Thanks:
Denis Molony for providing the Java program DiskBrowser which was used to format the listings of the source files.