diff --git a/BuildResults/RISC/Lib/SlotMgr.lib b/BuildResults/RISC/Lib/SlotMgr.lib deleted file mode 100644 index d2b70c9..0000000 Binary files a/BuildResults/RISC/Lib/SlotMgr.lib and /dev/null differ diff --git a/OS/SlotMgr/SlotInterrupts.a b/OS/SlotMgr/SlotInterrupts.a index 903d45d..a288b0b 100644 --- a/OS/SlotMgr/SlotInterrupts.a +++ b/OS/SlotMgr/SlotInterrupts.a @@ -97,8 +97,8 @@ SIntCORE PROC EXPORT WITH SlotIntQElement,slotIntGlobals EXPORT InitSPTbl,InitSDTbl - EXPORT SIntINSTALL,SIntREMOVE,DAFBVia2SlotInt,PSCVIA2SlotInt,NiagraVIA2SlotInt - EXPORT SlotInt,SlotIntCommon,Via2SlotInt,RbvSlotInt,OssSlotInt + EXPORT SIntINSTALL,SIntREMOVE + EXPORT SlotIntCommon EXPORT RunSlotHandlers ; accessed by level 3 Sonic Interrupt on

; Sonora based systems @@ -232,150 +232,6 @@ SIntREMOVE bsr.s GetSlotIntQHead ; a1 := pointer to qheader ; ;____________________________________________________________________________ -SlotInt -PSCVIA2SlotInt - MoveQ #~$78, D0 ; mask for slot bits (active low) - ; (slots c,d,e, onboard video vbl) - Or.b PSCVIA2SInt(a1), D0 ; read and mask slot interrupt indicators - Not.l D0 ; convert to active high bit mask - Bne.l SlotIntCommon ; if interrupt pending, service it - Rts ; if not, return from interrupt rb, end - -DAFBVia2SlotInt - move.b #$02,vIFR(a1) ; reset the VIA any slot interrupt flag <3> - if nonSerializedIO then - nop ; force write to complete - endif - moveq.l #~$7F,d0 ; mask for slot bits (active low) (5 slots+Enet+Video) <3> <9> - or.b vBufA(a1),d0 ; read and mask slot interrupt indicators <3> - not.l d0 ; convert to active high bit mask <3> - bne SlotIntCommon ; if interrupt pending, service it <3> - rts ; if not, return from interrupt <3> - -; ¥¥¥ÊThese need moved (into HardwarePrivateEqu.a?) ¥¥¥ -AIV3Base EQU $FEE00000 ; base address of AIV3 (Apple Integrated VIA 3) -AIV3SlotInt EQU $0002 -VBLIRQ EQU 6 - -AIV3Int EQU $0003 -AnySlot EQU 1 - -NiagraVIA2SlotInt - move.b #$02,vIFR(a1) ; reset the VIA any slot interrupt flag - - lea AIV3Base,a0 ; get base address - btst #AnySlot,AIV3Int(a0) ; any of our slots interrupting? - beq.s @notOurs ; no, exit - - moveq #0,D0 ; clear the register - btst #VBLIRQ,AIV3SlotInt(a0) ; check for VSC interrupt pending - bne.s @notOurs ; IF VBLIRQ pending THEN - ori.b #%00100000,D0 ; set slot E interrupt flag - bra SlotIntCommon -@notOurs - rts ; if not, return from interrupt rb, end - -Via2SlotInt - eieioSTP - move.b #$02,vIFR(a1) ; reset the VIA any slot interrupt flag - eieioSTP - moveq.l #~$3F,d0 ; mask for slot bits (active low) - eieioSTP - or.b vBufA(a1),d0 ; read and mask slot interrupt indicators - not.l d0 ; convert to active high bit mask - eieioSTP - bne SlotIntCommon ; if interrupt pending, service it - rts ; if not, return from the interrupt - -RbvSlotInt - eieioSTP - move.b #$82,RvIFR(a1) ; reset the RBV any slot interrupt flag - eieioSTP - moveq.l #~$7F,d0 ; mask for slot bits (active low) - eieioSTP - or.b RvSInt(a1),d0 ; get slot interrupt indicators - eieioSTP - not.l d0 ; convert to active high bit mask - -;¥¥¥¥¥¥¥¥¥¥¥¥ -; for PDM's with EVT1/2 boards, we need a small hack to swap the -; slot interrupt lines, since they're reversed on the logic board. -; AMIC versions >= 3 are used on EVT3 and greater boards, so -; we'll check for it and avoid the hack if it's present. Remove this hack -; when we no longer need to support EVT1/2 boards. - - IF hasHMC AND forPDMProto THEN ; - TestFor AMICExists ; do we have an AMIC? - beq.s @hackDone ; no, skip the hack - - btst.b #2,RvSEnb(a1) ; see if bit 2 is enabled (set) - bne.s @chkCF1 ; yes, we have a new AMIC (>=3), see if CF EVT1 - move.b #$84,RvSEnb(a1) ; try setting bit 2 - btst.b #2,RvSEnb(a1) ; did it set? - beq.s @doPDMHack ; no, must be AMIC1/2 (EVT1/2) - move.b #$04,RvSEnb(a1) ; else, restore it - bra.s @hackDone ; and skip the hack - -@chkCF1 lea $5ffffffe,a0 ; get CPU ID reg - move.b (a0)+,d1 ; - cmpi.b #$30,d1 ; are we a CF EVT1? - bne.s @hackDone ; no, exit - move.b (a0),d1 ; - cmpi.b #$13,d1 ; check 2nd byte of id - bne.s @hackDone ; not CF, no hack - - lea $F0000008, a0 ; get Bart ID Register - move.l (a0), d1 ; - cmp.l #$43184000, d1 ; is this the first rev of Bart - bne.s @hackDone ; new bart, so don't do hack - - move.b d0,d1 ; yes get interrupt bits - andi.b #%00001100,d1 ; get slot int bits ..CB (we loose slot E) - lsl.b #1,d1 ; map over into .DC. - andi.b #%11100011,d0 ; keep VBL & slot E (VDS) bits - or.b d1,d0 ; 'or' slots C,D into other bits - bra.s @hackDone ; and continue processing - - -@doPDMHack andi.w #$78,d0 - lsr.w #3,d0 - move.b @swapTbl(d0.w),d0 - lsl.w #3,d0 -@hackDone - ENDIF -;¥¥¥¥¥¥¥¥¥¥¥¥ - - and.b RvSEnb(a1),d0 ; only look at enabled ones - bne.s SlotIntCommon ; if interrupt pending, service it - rts ; if not, return from the interrupt - - IF hasHMC THEN ; -@swapTbl dc.b $00 ; 0000 - dc.b $04 ; 0001 - dc.b $02 ; 0010 - dc.b $06 ; 0011 - dc.b $01 ; 0100 - dc.b $05 ; 0101 - dc.b $03 ; 0110 - dc.b $07 ; 0111 - - dc.b $08 ; 1000 - dc.b $0c ; 1001 - dc.b $0a ; 1010 - dc.b $0e ; 1011 - dc.b $09 ; 1100 - dc.b $0d ; 1101 - dc.b $0b ; 1110 - dc.b $0f ; 1111 - ENDIF - - -OssSlotInt - moveq.l #$3F,d0 ; mask for slot bits (active high) - and.b OSSIntStat+1(a1),d0 ; get slot interrupt indicators - bne.s SlotIntCommon ; if interrupt pending, service it - rts ; if not, return from the interrupt - SlotIntCommon subq.l #4,sp ; allocate a long (only a byte is used) move.b d0,(sp) ; save the interrupt pending bit mask diff --git a/OS/SlotMgr/SlotMgr.a b/OS/SlotMgr/SlotMgr.a index b821d33..5f85bfb 100644 --- a/OS/SlotMgr/SlotMgr.a +++ b/OS/SlotMgr/SlotMgr.a @@ -774,7 +774,7 @@ IdSave$d EQU D2 ;Save the sResource Id. MOVE.L a2,a0 MOVE.L a3,a1 MOVE.L d1,d0 - _BlockMove + _BlockMoveData MOVEM.L (SP)+,A0-A1 ;Restore A0-A1, destroyed by _BlockMove. BNE.S Err1 @@ -1483,12 +1483,6 @@ EndStatLoad RTS ; Patch out Drivers for any Apple Cards that need it. BeginGetSlotDrvr - IF NOT LC930 THEN - Import GetDriverPatch - Bsr GetDriverPatch ; If GetDriverPatch returns a - Tst.b D0 ; result >= 0, donÕt execute - Bge.s ExitGetSlotDrvr ; Patched, so just return. - ENDIF ; This is the original entry-point. It is called by GetDevIndex Export OrigGetSlotDrvr OrigGetSlotDrvr @@ -1518,240 +1512,6 @@ ExitGetSlotDrvr RTS EJECT -;____________________________________________________________________________ -; -; GetDriverPatch and support (called from _SGetDriver). -; -; Entry/Exit: A0 points to spBlock. -; -; Purpose: The purpose of GetDriverPatch is to identify Apple -; Cards whose Driver code is faulty, and execute fixed -; versions from the CPU ROM. ItÕs job is to -; call GetDevIndex to determine whether the card/device -; pointed to by the incoming spBlock is one that needs -; patching. If so, it attempts to allocate enough space -; for the driver in the system heap, copy it there, and -; then return a handle to the driver in spBlock.spResult. -; If the driver canÕt be loaded (e.g., not enough memory), -; the appropriate Slot Manager error is returned. -;____________________________________________________________________________ - -GetDriverPatch Proc Export - With spBlock,LoadTblRec - -@saveRegs Reg A0/A3-A5/D3-D4 ; Define registers for work/saving, and - Movem.l @saveRegs,-(Sp) ; store them on the stack. - Link A6,#-spBlockSize ; Get a stack frame. - - Move.l A0,A3 ; Save spBlockPtr. - -; First, look to see if we even need to be attempting to patch the driver on this -; card/device. -; - Bsr GetDevIndex ; Get the card/device index into D0. - Move.l D0,D3 ; If the device index is negative, then - Bmi @done ; driver doesnÕt need patching. CSS - -; Next, check to see that weÕre pointing to the sResource that has the driver or -; driver loader in it (i.e., we donÕt want to be opening the driver multiple -; times). -; - Lea LoadTbl,A1 ; Point to base of LoadTbl. - Mulu #LTEntrySize,D3 ; Adjust index. - - Move.l A1,A0 ; Point to base of LoadTbl. - Move.b ltSpID(A0,D3),D0 ; Get spID. - Move.b ltSpExtDev(A0,D3),D1 ; Get spExtDev. - - Moveq #0,D4 ; Clear value holder. - Move.b D0,D4 ; Save spID - Swap D4 ; and - Move.b D1,D4 ; Save spExtDev. - - Move.l Sp,A0 ; Point to local spBlock. - - Move.b spSlot(A3),spSlot(A0) ; Get pointer to right sResource list: - Move.b spID(A3),spID(A0) ; Need spSlot, spID, and - Move.b D4,spExtDev(A0) ; spExtDev. - _SRsrcInfo - Bne.s @errRtn - - Swap D4 ; Get spID. - - Move.b D4,spID(A0) ; Make sure this sResource is the one - _SFindStruct ; with the driver in it. - Bne.s @errRtn - -; Finally, now that we know that we on the right card/device and are looking at the right -; sResource, allocate relocatable space in the System heap and tell the caller where that -; space is. -; - Move.l A1,A4 ; Point to base of LoadTbl. - Add.l ltAddrOff(A1,D3),A4 ; Add offset to driver and save pointer. - - Move.l A1,A0 ; Point to base of LoadTbl. - Add.l ltSizeOff(A1,D3),A0 ; Add offset to driver size and get pointer. - Move.l (A0),D3 ; Save driver size. - - Move.l D3,D0 ; Compact/Reserve some space for ourselves - _ResrvMem ,SYS ; in the System heap. - Bne.s @errRtn ; Get out if we couldnÕt reserve the space. - - Move.l D3,D0 ; Attempt to allocate some space in the - _NewHandle ,SYS ; System heap. - Bne.s @errRtn ; Get out if we couldnÕt get the space. - - Move.l A0,A5 ; Remember allocated handle, and prevent it - _HNoPurge ; from being removed. - - Move.l A4,A0 ; Get address of driver code. - Move.l (A5),A1 ; Get address of allocated space. - Move.l D3,D0 ; Get size. - _BlockMove ; Move driver into allocated space. - - Move.l A3,A0 ; Restore spBlockPtr. - Move.l A5,spResult(A0) ; Return driver handle in spResult. - - Moveq #0,D0 ; Return noErr. - Bra.s @done - -@errRtn Move.l #smsGetDrvrErr,D0 ; CouldnÕt load driver error. -@done Unlk A6 ; Restore stack frame. - Movem.l (Sp)+,@saveRegs ; Restore registers. - Rts - -;____________________________________________________________________________ -; -; GetDevIndex -; -; Entry: A0 -- points to spBlock. -; -; Exit: D0 -- contains index (0..n-1) or error value (<0). -; -; Purpose: The purpose of GetDevIndex is to cycle through a table of -; card/device identifiers. If the card/device passed in -; is in the device table, itÕs entry is returned. Otherwise, -; a negative number (-1) is returned. This is a utility routine -; called by SlotGetDriverPatch and SlotPrimaryInitPatch. -; -; Note: This routine JsrÕs (Bsr.lÕs) to GetSlotDrvr directly due to -; the fact that we might be coming from our patched out version -; of GetSlotDrvr! We need to do this so that we can compare -; the version of the driver on the card with the one we know -; about. This is so that we donÕt patch out newer (and -; presumably compatible) versions of the PrimaryInit and Driver. -; -;____________________________________________________________________________ - - Macro ; Macro for jumping directly int - _GetSlotDriver ; GetSlotDrvr (acting like trap dispatcher). - Movem.l A1/D1-D2,-(Sp) ; Save registers (A0 i/o, D0 is result). - Bsr.l OrigGetSlotDrvr ; Make call. - Tst.w D0 ; Act like Slot Manager for result. - Movem.l (Sp)+,A1/D1-D2 ; Restore registers. - EndMacro ; - - With DevTblRec,spBlock,seBlock - Export GetDevIndex -GetDevIndex - -@saveRegs Reg A3-A5/D3-D4 ; Define registers for work/saving, and - Movem.l @saveRegs,-(Sp) ; store them on the stack. - Link A6,#-spBlockSize ; Get a stack frame. - - Move.l A0,A3 ; Save current spBlock to simulate sExec. - Move.l Sp,A0 ; Point to stack spBlock. - - Lea DevTbl,A4 ; Point to table of device identifiers. - Moveq #0,D3 ; Set entry index to 0. - -@repeat Move.b spSlot(A3),spSlot(A0) ; Reset spSlot to the one we want. - Clr.w spID(A0) ; Start search from top, no external devices. <11> - Clr.b spTBMask(A0) ; No mask (i.e., specific search). - Move.w category(A4),spCategory(A0) ; Look for: Category, - Move.w cType(A4),spCType(A0) ; CType, - Move.w drvrSW(A4),spDrvrSW(A0) ; DrvrSW, - Move.w drvrHW(A4),spDrvrHW(A0) ; DrvrHW. - Clr.l spParamData(A0) ; Look only for enabled sRsrcs. <11> - Bset #foneslot,spParamData+3(A0) ; Limit search to this slot only by - _GetTypeSRsrc ; using the new & improved routine. - - Bne.s @until ; If this isnÕt the device were looking for, - ; then keep going. - - _GetSlotDriver ; Otherwise, attempt to load driver (for version #). - Bne.s @dontPatch ; If it couldnÕt be loaded, punt. - - Move.l spResult(A0),A5 ; Save driver handle (to dispose). - Move.l (A5),A0 ; Get driver pointer. - Lea drvrName(A0),A0 ; Get driver name. - - Clr.w D0 ; Clear D0.w (for use as index). - Move.b (A0),D0 ; Get the length of the driver name. - Addq #2,D0 ; Adjust offset to version field. - Bclr #0,D0 ; Adjust offset for word alignment. - Move.w (A0,D0.w),D4 ; Save the version number. - Move.l A5,A0 ; Get driver handle, and - _DisposHandle ; dispose of it. - - Cmp.w drvrVers(A4),D4 ; If the cardÕs version ­ to ours, <11> - Bne.s @until ; then keep going. <11>
- - Move.l D3,D0 ; Otherwise, copy the index into D0, - Bra.s @done ; and return. - -@until Adda #DTEntrySize,A4 ; Point to next entry in table, and - Addq #1,D3 ; increment entry index. - Tst.w (A4) ; If this isnÕt the final entry, then - Bne.s @repeat ; keep checking. - -@dontPatch Moveq #-1,D0 ; Flag that we donÕt want to patch. -@done Unlk A6 ; Put stack frame back. - Movem.l (Sp)+,@saveRegs ; Restore registers. - Rts - - EndWith - - -;____________________________________________________________________________ -; -; Tables for PrimaryInit & GetDriver patches. -; -; Note: Keep these here and donÕt export these labels! -;____________________________________________________________________________ - - Import TFBDrvr,TFBDrvrSize - Import JMFBDrvr,JMFBDrvrSize - - Import TFBPrimaryInit - Import JMFBPrimaryInit - - Export JsrTbl - -DevTbl Dc.w CatDisplay,TypVideo,DrSwApple,DrHwTFB,0 ; TFB Entry <11> - Dc.w CatDisplay,TypVideo,DrSwApple,DrHwJMFB,0 ; JMFB Entry <11> - Dc.w 0 - - Align 4 - -LoadTbl Dc.l TFBDrvr-LoadTbl ; Start of TFB driver code. - Dc.l TFBDrvrSize-LoadTbl ; Length. - Dc.b sRsrcDrvrDir ; TFBÕs have an sRsrcDrvrDir. - Dc.b 0 ; TFBÕs are singly deviced. - Dc.b 0,0 ; Padding. <11> - - Dc.l JMFBDrvr-LoadTbl ; Start of 4¥8/8¥24 driver code. - Dc.l JMFBDrvrSize-LoadTbl ; Length. - Dc.b sRsrcDrvrDir ; 4¥8/8¥24Õs have an sRsrcDrvrDir. - Dc.b 0 ; 4¥8/8¥24Õs are singly deviced. - Dc.b 0,0 ; Padding. - - Align 4 - -JsrTbl Dc.l TFBPrimaryInit-JsrTbl ; TFBPrimaryInit - Dc.l JMFBPrimaryInit-JsrTbl ; 4¥8/8¥24 PrimaryInit - - ;========================================================================================= ; slotinfo ;========================================================================================= @@ -1971,6 +1731,12 @@ PtrToSlot Proc Export MOVE.L spsPointer(A0),D1 ; D1 = sPointer BEQ.S @Done ; nil pointer - error + ROL.L #8,D1 + MOVE.B ROMBase,D2 + CMP.B D2,D1 + BEQ.S @skip_older + MOVE.L spsPointer(A0),D1 + ; Determine the slot clr.b d1 ; clear low byte of pointer <2.1> @@ -1984,10 +1750,11 @@ PtrToSlot Proc Export MOVE.B ROMBase,D2 ; D2 = high byte of ROMBase lsr.b #4,d2 ; shift high nib to low nibble <2.1> CMP.B D2,D1 ; same? - BHI.S @FoundSlot ; must be other super slot space + BNE.S @FoundSlot ; must be other super slot space ; Pointer is to ram or rom. Translate it to slot 0. +@skip_older MOVEQ #0,D1 ; access to host ROM - translate to slot 0 BRA.S @FoundSlot @@ -2553,13 +2320,9 @@ DeleteSRTRec ; Last SRT block is empty - free the block. Traverse SRT to end to nil the link ptr. -@Free MOVE.B mmu32Bit,-(SP) ; save current mmu state rb - MOVE.B #false32b,D0 ; rb - _SwapMMUMode ; switch to 24 bit mode rb +@Free MOVEA.L A2,A0 ; A0 = ptr to last SRT blk _DisposPtr ; free the block - MOVE.B (SP)+,D0 ; recover status rb - _SwapMMUMode ; restore mmu state rb MOVEA.L sRsrcTblPtr,A1 ; get ptr to beginning of SRT @Loop1 ADDA.W #srtBlkSize,A1 ; inc to end of blk CMPA.L srtNext(A1),A2 ; found end of link ? @@ -2697,6 +2460,7 @@ pNewSRTEntry MOVE.L spParamData(A0),D1 ; save enable/disable flags _sFindsInfoRecPtr ; get ptr to sinfo record + BNE.S @Done MOVEA.L spResult(A0),A1 ; A1 = ptr to sInfo record MOVE.L siDirPtr(A1),spsPointer(A0) ; set ptr to ROM directory _sFindStruct ; search the ROM directory @@ -3438,13 +3202,6 @@ shortvers ds.w 1 ; version and vector offset lsr.b #4,d0 ; look at high nibble cmp.b #$0B,d0 ; long bus exception frame ? bne.s @RealBusEx ; transfer to real bus exception handler - move.b DFAddr(sp),d0 ; get high byte of data fault cycle address - cmp.b #majorSpace,d0 ; in super slot space ($60-$E0) ? - blo.s @RealBusEx ; not in slot address space - cmp.b #$FF,d0 ; in minor slot space range ? - beq.s @RealBusEx ; not in minor slot space - cmp.b #$F0,d0 ; in minor slot space range ? - beq.s @RealBusEx ; not in minor space $F1 - $FE ; Have verified that a NuBus read data access caused the bus error. Need to modify the ; stack frame to return to the address in register a2. Accomplish this by creating a new @@ -3486,9 +3243,6 @@ shortvers ds.w 1 ; version and vector offset pInstallBus move.w sr,-(sp) ; Save current interrupt level. ori.w #HiIntMask,sr ; disable interrupts - moveq #True32B,d0 - _SwapMMUMode ; change to 32 bit mode - move.b d0,([sInfoPtr],entryMMUMode) ; save old mmu state move.l BusErrVct,([sInfoPtr],sysBusExcptn) ; save system bus vector in globals move.l ([SDMJmpTblPtr],BusException*4),BusErrVct ; replace with slot mgr vector move.w (SP)+,SR ; restore interrupt state @@ -3514,8 +3268,6 @@ pRestoreBus move.l d0,-(sp) ; save reg move.w sr,-(sp) ; Save current interrupt level. ori.w #HiIntMask,sr ; disable interrupts - move.b ([sInfoPtr],entryMMUMode),d0 ; get saved mmu mode - _SwapMMUMode ; restore mmu mode move.l ([sInfoPtr],sysBusExcptn),BusErrVct ; restore system exception vector move.w (sp)+,sr ; restore interrupt state move.l (sp)+,d0 ; restore reg @@ -3804,9 +3556,10 @@ RemoveCard with spBlock,sInfoRecord CheckSlot -@regs reg d1-d3/a1-a4 +@regs reg d1-d4/a1-a4 movem.l @regs,-(sp) moveq.l #0,d3 ; set d3 = change status flag + moveq.l #0,d4 ; get ptr to slot's sInfoRecord so we can check its previous state @@ -3822,6 +3575,12 @@ CheckSlot cmp.w #smReservedSlot, \ ; check for reserved slot siInitStatusA(a4) beq @Return ; reserved slots not valid + cmp.w #smEmptySlot, \ ; check for empty slot + siInitStatusA(a4) + bne.s @notbad ; empty slots not valid + + moveq.l #-1,d4 +@notbad moveq.l #0,d1 ; zero reg move.b spSlot(a0),d1 ; d1 = slot number @@ -3859,12 +3618,15 @@ CheckSlot ; Verify the format header - a0 = ptr to spblock, a1 = ptr to sInfoRecord @Verify - bsr.l VerifySlot ; verify the config rom format + bsr VerifySlot ; verify the config rom format tst.w siInitStatusA(a1) ; is the slot status ok? bne.s @CheckError ; bad or empty slot - check previous status ; Config ROM verifies ok - walk through all the sResources looking for the board sResource + tst.l d4 + bne.s @Changed + bsr GetBoardID ; find the board sRsrc and board id beq.s @Changed ; no board id - a bad card diff --git a/OS/SlotMgr/SlotMgr.make b/OS/SlotMgr/SlotMgr.make index b68a544..fbb4032 100644 --- a/OS/SlotMgr/SlotMgr.make +++ b/OS/SlotMgr/SlotMgr.make @@ -16,8 +16,8 @@ SlotMgrObjs = "{ObjDir}SlotInterrupts.a.o" "{ObjDir}SlotMgrInit.a.o" ¶ "{ObjDir}SlotMgr.a.o" -# "{LibDir}SlotMgr.lib" Ä {SlotMgrObjs} -# Lib {StdLibOpts} -o "{Targ}" {SlotMgrObjs} +"{LibDir}SlotMgr.lib" Ä {SlotMgrObjs} + Lib {StdLibOpts} -o "{Targ}" {SlotMgrObjs} diff --git a/OS/SlotMgr/SlotMgrInit.a b/OS/SlotMgr/SlotMgrInit.a index 904b0cc..ffbde26 100644 --- a/OS/SlotMgr/SlotMgrInit.a +++ b/OS/SlotMgr/SlotMgrInit.a @@ -414,10 +414,6 @@ StartSDeclMgr bsr InitsPram ; initial a slot's PRAM dbra d1,@Loop -; Initialize the Docking Manager so built-in video and docking cards can use its facilities - - BSR.L InitDocking ; initialize the Docking Manager

- ; Set up the warm/cold start flag for later. Moveq.l #0,D2 ; D2 = flag for cold start. @@ -1074,9 +1070,11 @@ InitsPRAM tst.w siInitStatusA(a2) ; is the slot status ok? beq.s @readPRAM ; slot ok - read board id from pram cmp.w #smDisabledSlot,siInitStatusA(a2) ; is slot disabled? - beq.s @Done ; don't touch disabled slot's pram + beq @Done ; don't touch disabled slot's pram cmp.w #smReservedSlot,siInitStatusA(a2) ; is slot reserved? - beq.s @Done ; reserved is the same as disabled + beq @Done ; reserved is the same as disabled + cmp.w #smEmptySlot,siInitStatusA(a2) ; is slot empty? + beq @Done ; empty is the same as disabled bra.s @writePRAM ; slot status is bad - zero pram ; Read PRAM to get the current board id. @@ -1215,16 +1213,6 @@ doPrimaryInit _sFindStruct bne.s @Done ; no primary init record - done - IF NOT LC930 THEN - -; Identify Apple Cards whose PrimaryInit code is faulty, and execute fixed -; versions from the CPU ROM. - Bsr.s PatchPrimaryInit ; If PatchPrimaryInit returns a - Tst.b D0 ; result >= 0, donÕt execute - Bpl.s @cleanup ; normal PrimaryInit. - - ENDIF - ; Load the code and execute the primary init record. ; Move.l A3,spsPointer(A0) ; Restore ptr to board sRsrc. @@ -1241,66 +1229,6 @@ doPrimaryInit @done Rts -;____________________________________________________________________________ -; -; PatchPrimaryInit and support (called from doPrimaryInit). -; -; Entry: A0 -- points to spBlock. -; A1 -- points to sInfoRecord. -; A2 -- (after restore from BigJump) points to sExec param blk. -; A3 -- points to board sResource. -; -; D1 -- contains spSlot (we use spBlock.spSlot here, though). -; -; Exit: A0-A3 -- preserved. -; D1 -- preserved. -; -; Purpose: The purpose of SlotPrimaryInitPatch is to identify Apple -; Cards whose PrimaryInit code is faulty, and execute fixed -; versions from the CPU ROM. -; -; SlotPrimaryInitPatch is executed from the (non-exported) -; routine doPrimayInit in SlotInfo.a. -;____________________________________________________________________________ - - IF NOT LC930 THEN - - With seBlock,spBlock - Import GetDevIndex,JsrTbl - -PatchPrimaryInit - -@saveRegs Reg A0-A3/D1/D3 ; Define some work and scratch registers, - Movem.l @saveRegs,-(Sp) ; and save them on the stack. - - Move.l A0,A3 ; Save the spBlockPtr for later. - - Bsr GetDevIndex ; Get the device/card index into D0. - Move.l D0,D3 ; If the device index is negative, then - Bmi.s @done ; PrimaryInit doesnÕt need patching. - - Lea JsrTbl,A1 ; Point to base of JsrTbl. - Lsl.l #2,D3 ; Adjust index. - - Move.l A1,A0 ; Copy base address. - Add.l D3,A0 ; Point to proper entry. - Add.l (A0),A1 ; Load A1 with effective address of PrimaryInit. - - Move.l A3,A0 ; Restore spBlockPtr. - Move.b spSlot(A0),seSlot(A2) ; Set the right slot number. - Move.b spFlags(A0),seFlags(A2) ; Set the flags. - Move.l A2,A0 ; Set A0 to sExecBlkPtr for fake sExec call. - Jsr (A1) ; Execute the PrimaryInit. - - Move.l D3,D0 ; Return result code. - -@done Movem.l (Sp)+,@saveRegs - Rts - - Endwith - - ENDIF - ;_______________________________________________________________________________________
djw ; StubCheckSlot - check if a slot status has changed ; @@ -1363,48 +1291,6 @@ StubRemoveCard ; spBlock : -> spSlot slot number ; -> spFlags fWarmStart - if set then a warm start (may be used by primary EnableBlockXfer - Testfor BARTExists ; are we on a ColdFusion or PDM - bne.s @goodMach - Testfor MUNIExists ; do we have MUNI Nubus Controller? - Beq @exit ; no, leave - -@goodMach MoveM.l A0/D0-D2, -(SP) - Clr.b spID(A0) ; Begin search with ID 0. - Clr.b spExtDev(A0) ; No external device(s). - Clr.b spHwDev(A0) ; No hardware device(s). - Clr.b spTBMask(A0) ; No mask in search. - Move.w #catBoard,spCategory(A0) ; Look for: Board sRsrc - Clr.w spCType(A0) - Clr.w spDrvrSW(A0) - Clr.w spDrvrHW(A0) - Move.l #(1<