diff --git a/MLI.SRC/ALLOC.S b/MLI.SRC/ALLOC.S new file mode 100644 index 0000000..0575439 --- /dev/null +++ b/MLI.SRC/ALLOC.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/BFMGR.S b/MLI.SRC/BFMGR.S new file mode 100644 index 0000000..0869464 --- /dev/null +++ b/MLI.SRC/BFMGR.S @@ -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 diff --git a/MLI.SRC/CCLOCK.S b/MLI.SRC/CCLOCK.S new file mode 100644 index 0000000..4af9382 --- /dev/null +++ b/MLI.SRC/CCLOCK.S @@ -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 diff --git a/MLI.SRC/CLOSEEOF.S b/MLI.SRC/CLOSEEOF.S new file mode 100644 index 0000000..46e6d89 --- /dev/null +++ b/MLI.SRC/CLOSEEOF.S @@ -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$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 diff --git a/MLI.SRC/DATATBLS.S b/MLI.SRC/DATATBLS.S new file mode 100644 index 0000000..2b8fce7 --- /dev/null +++ b/MLI.SRC/DATATBLS.S @@ -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 ' ' \ No newline at end of file diff --git a/MLI.SRC/DESTROY.S b/MLI.SRC/DESTROY.S new file mode 100644 index 0000000..8ab394e --- /dev/null +++ b/MLI.SRC/DESTROY.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/DETREE.S b/MLI.SRC/DETREE.S new file mode 100644 index 0000000..873785e --- /dev/null +++ b/MLI.SRC/DETREE.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/DEVSRCH.S b/MLI.SRC/DEVSRCH.S new file mode 100644 index 0000000..4903fd4 --- /dev/null +++ b/MLI.SRC/DEVSRCH.S @@ -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 + 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 + 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 \ No newline at end of file diff --git a/MLI.SRC/EQUATES.S b/MLI.SRC/EQUATES.S new file mode 100644 index 0000000..0f42fe7 --- /dev/null +++ b/MLI.SRC/EQUATES.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/FNDFIL.S b/MLI.SRC/FNDFIL.S new file mode 100644 index 0000000..991e739 --- /dev/null +++ b/MLI.SRC/FNDFIL.S @@ -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 ;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... \ No newline at end of file diff --git a/MLI.SRC/GLOBALS.S b/MLI.SRC/GLOBALS.S new file mode 100644 index 0000000..c9afd39 --- /dev/null +++ b/MLI.SRC/GLOBALS.S @@ -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 diff --git a/MLI.SRC/MEMMGR.S b/MLI.SRC/MEMMGR.S new file mode 100644 index 0000000..3f6a0f9 --- /dev/null +++ b/MLI.SRC/MEMMGR.S @@ -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 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 + 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) \ No newline at end of file diff --git a/MLI.SRC/MLI.MACS.S b/MLI.SRC/MLI.MACS.S new file mode 100644 index 0000000..dc4a6be --- /dev/null +++ b/MLI.SRC/MLI.MACS.S @@ -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 + <<< \ No newline at end of file diff --git a/MLI.SRC/NEWFNDVOL.S b/MLI.SRC/NEWFNDVOL.S new file mode 100644 index 0000000..bd9a02e --- /dev/null +++ b/MLI.SRC/NEWFNDVOL.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/POSNOPEN.S b/MLI.SRC/POSNOPEN.S new file mode 100644 index 0000000..29f6a24 --- /dev/null +++ b/MLI.SRC/POSNOPEN.S @@ -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 markEOF + 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 \ No newline at end of file diff --git a/MLI.SRC/PROLDR.S b/MLI.SRC/PROLDR.S new file mode 100644 index 0000000..0cc3d9b --- /dev/null +++ b/MLI.SRC/PROLDR.S @@ -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 + 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 + 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 + 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 ; into jspare vector + STA jSpare+2 + LDA LCBANK2 + LDA LCBANK2 ;Switch in bank 2 + LDX #DispGS + LDA SetupRTS + CMP #$02 ;GS/OS boot? + BEQ RelocDisp ;Yes + + LDX #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 + 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 ; 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 #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 #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 + 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 pageABuf ;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 + +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 diff --git a/MLI.SRC/RAM1.S b/MLI.SRC/RAM1.S new file mode 100644 index 0000000..5d92794 --- /dev/null +++ b/MLI.SRC/RAM1.S @@ -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 ;Source high + STX A1+1 + INX + STX A2+1 ;End high + 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 + 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 \ No newline at end of file diff --git a/MLI.SRC/RAM2.S b/MLI.SRC/RAM2.S new file mode 100644 index 0000000..ed8a152 --- /dev/null +++ b/MLI.SRC/RAM2.S @@ -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 +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 + JMP GoCard + +SP1 DS 2,0 +A1L1 DS 12,0 ;12 bytes of storage + DS 11,0 ;Pad to int handler \ No newline at end of file diff --git a/MLI.SRC/READWRITE.S b/MLI.SRC/READWRITE.S new file mode 100644 index 0000000..0673a35 --- /dev/null +++ b/MLI.SRC/READWRITE.S @@ -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 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 EOFEOF!! + +* 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 \ No newline at end of file diff --git a/MLI.SRC/RELOC.S b/MLI.SRC/RELOC.S new file mode 100644 index 0000000..8e5b148 --- /dev/null +++ b/MLI.SRC/RELOC.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/ROM.S b/MLI.SRC/ROM.S new file mode 100644 index 0000000..38f8861 --- /dev/null +++ b/MLI.SRC/ROM.S @@ -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 #ROMIrq ;Push ROM entry also + PHA + LDA # $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 #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 \ No newline at end of file diff --git a/MLI.SRC/SEL2.S b/MLI.SRC/SEL2.S new file mode 100644 index 0000000..6475ca4 --- /dev/null +++ b/MLI.SRC/SEL2.S @@ -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' \ No newline at end of file diff --git a/MLI.SRC/TCLOCK.S b/MLI.SRC/TCLOCK.S new file mode 100644 index 0000000..40f66eb --- /dev/null +++ b/MLI.SRC/TCLOCK.S @@ -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 \ No newline at end of file diff --git a/MLI.SRC/WRKSPACE.S b/MLI.SRC/WRKSPACE.S new file mode 100644 index 0000000..ee5c222 --- /dev/null +++ b/MLI.SRC/WRKSPACE.S @@ -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 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 \ No newline at end of file diff --git a/MLI.SRC/XDOSMLI.S b/MLI.SRC/XDOSMLI.S new file mode 100644 index 0000000..f4ac55c --- /dev/null +++ b/MLI.SRC/XDOSMLI.S @@ -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 diff --git a/MLI.SRC/XRW1.S b/MLI.SRC/XRW1.S new file mode 100644 index 0000000..c840842 --- /dev/null +++ b/MLI.SRC/XRW1.S @@ -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 diff --git a/MLI.SRC/XRW2.S b/MLI.SRC/XRW2.S new file mode 100644 index 0000000..9065ad1 --- /dev/null +++ b/MLI.SRC/XRW2.S @@ -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 \ No newline at end of file diff --git a/P8_SRC.2mg b/P8_SRC.2mg new file mode 100644 index 0000000..c30f3e0 Binary files /dev/null and b/P8_SRC.2mg differ diff --git a/Readme.md b/Readme.md new file mode 100644 index 0000000..03d7653 --- /dev/null +++ b/Readme.md @@ -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. \ No newline at end of file