; ; File: PwrControlsPatches.a ; ; Contains: Patches for new features dealing with PowerControls. ; ; Written by: Helder J. Ramalho ; ; Copyright: © 1990-1993 by Apple Computer, Inc. All rights reserved. ; ; This file is used in these builds: ROM ; ; Change History (most recent first): ; ; 12/13/93 PN Roll in KAOs and Horror changes to support Malcom and AJ ; machines. ; 9/1/93 SKH Rolled into SuperMario for the first time. After Kaos stops changing ; this will be rolled into PowerMgr.a ; ; 6/24/93 RLE ensure charger turned on as part of pmgrinit ; 5/31/93 RLE change setMachineID command to setMachineAttr ; 05-12-93 jmp For reanimator builds, quit whacking the SCC. ; 5/7/93 RLE disable dynamic speed switching for Escher's ROM ; 5/4/93 SWC Calculate full/reduced speed timing constants (TimeDBRA, etc.) ; for machines that support dynamic speed changes. ; 4/30/93 RLE update MSC initialization to configure 33MHz Escher correctly ; 4/20/93 SWC Fixed a bug that was causing us to hang. It looks like this one ; has been around for awhile, too. ; 4/19/93 SWC Modified CheckEconoMode to look for the pointer to the Power ; Manager primitives directly in a box's ProductInfo, instead of ; using the PmgrPrimLookUp table (which is now gone). ; 3/29/93 RLE include new patch for InitPmgrVars since it's grown too big to ; fit in the original file ; 3/19/93 RLE fix a narly problem with PortableCheck using uninitialized ram ; 3/3/93 RLE toss in preparation for doing the LCD screen save/restore ; in the driver instead of in the power manager ; 2/25/93 RLE modify PmgrPrimLookUp calls to support multiple table entries ; for a given memory decoder ; 8/21/92 SWC Added a nasty hack to fix an SCC initialization problem on ; Gemini and DeskBar. This will eventually be fixed in their ; hardware, but we need this to be working correctly now. ; 8/10/92 SWC Disable PG&E modem interrupts so we don't get hit before the ; Power Manager gets set up. ; 7/27/92 SWC Blank the GSC-based LCD screen on DBLite as well as Niagra. ; 7/21/92 ag Change the GSC initialization values, the screen should not ; blank with active pixels, this will highlight bad pixels. The ; new values will blank with inactive pixels avoiding this ; problem. ; 7/15/92 ag Changed the initial setting for GSC to blank the screen. ; 7/15/92 ag Moved a7 to a5 for storage before testing for bus error. The ; bus error handler will move a5 to a7. Set the condition codes ; in bus error check. Set the condition codes before returning in ; the spi timeout code. ; 7/14/92 ag Fixed trashed register problem in gsc blank routine. ; 7/14/92 ag Added timeouts to the spi code to avoid infinite loops. ; 7/14/92 ag Added initialization and blanking of the display for niagra. the ; timing spec would be violated if initialization is done later. ; Changed the spin wait loop constant for economode to reduce ; possible extended delay. ; 7/10/92 ag fixed dart exception processing for $5x commands, $50 should ; still go to the power manager. ; 6/18/92 SWC Modified the Dart SPI routines to use the vectors for the ; command send/receive count tables to make patching easier. ; 6/12/92 ag Changing the spi receive protocal. on receive, data should be ; read on the RISING edge of ack. this protocal sucks! ; 6/10/92 HJR Fixed some bugs to allow Econo-Mode to work. ; 5/19/92 SWC Moved InitWallyWorld to CheckEconoMode from USTStartup.a since ; we read PRAM and thus need the PMGR initialized. ; 5/12/92 ag Set the condition codes before leaving the exception handling ; routine. This tells the code down stream that the exception ; handler handled the call. ; 5/7/92 ag Added Dartanian SPI code. ; 5/7/92 SWC Preserve the RAM size info when configuring the MSC. Also, leave ; the MSC25MHz bit set when running in econo-mode regardless of ; the maximum CPU speed so the state machines will be better ; optimized. ; 4/24/92 HJR Provided Econo-Mode support for Niagra. ; 4/3/92 SWC Moved all the ADB and DebugUtil routines to ADBPrimitives.a. ; Moved EnableSCSIIntsPatch to InterruptHandlers.a (where it ; should go). ; 3/19/92 HJR for GMR - Fixed bug in below change on TIM- moved fDBExpActive ; check earlier in StartRequestPMGR rtn. ; 3/19/92 HJR for GMR - Added fDBExpActive flag in StartReqPMGR,ReqDonePMGR to ; prevent the same explicit command from going out twice if ; autopoll data came in at the same time. ; 3/16/92 SWC Added support for 33MHz MSC systems to CheckEconoMode. ; 2/21/92 HJR Modified check sleep to use new ram locations instead of ; obsolete VRam space. ; 2/10/92 HJR Fix a bug where we are returning from a BSR6 without setting the ; return address in A6. ; 2/7/92 SWC Modified the CheckEconoMode code to lookup the correct base ; Power Manager PRAM address from the primitives tables. ;
1/24/92 SWC In CheckEconoMode, do both econo-mode setup and chip ; configuration for the MSC case. ;
1/9/92 SWC Rolled in changes for final chips: removed special case checks ; for PMGR interrupts on CA2 (now on CB1). Re-wrote CheckEconoMode ; as part of adding support for DB-Lite and to simplify it. ;

10/29/91 SWC Added the signature to the shutdown command in PMgrPowerOffPatch ; so the PMGR will actually turn us off (I don't know why it ; wasn't there before, cuz it's specifically required). ;

10/22/91 SWC PortableCheck: changed references to NoVRAMVidRam to point to ; the end of the record since the offsets are negative. ;

8/8/91 SWC Added import of USTPMGRSendCommand and modified the econo mode ; code to use it instead of sending the bytes discretely. ; Universalized the ADB code so that it supports interrupts on CA2 ; and PMGR auto-polling for DB-Lite. Fixed PortableCheck so it ; handles the case when VRAM doesn't retain power across sleep ; (state saved in PMgrGlobals). Added EnableSCSIIntsPatch so we ; won't enable SCSI interrupts on DB-Lite. ; ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Pre-HORROR ROM comments begin here. ; ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; <17> 7/9/91 HJR Added more overpatch space ; <16> 6/24/91 HJR Sleepq and pmCommand are now record, so the appropriate With ; statements were added. ; <15> 5/23/91 HJR Added include for PowerPrivEqu.a. ; <14> 5/10/91 HJR Removed NMIExcpPatch for a much cleaner implementation in ; PowerMgr.a. Removed BigBSR5 macros since it is now in private.a. ; <13> 4/29/91 HJR Added NMIExcpPatch in order to hit NMI while power-cycling and ; modified checkwakeup to use physical video location from ; universal instead of using hard-coded addresses. ; <12> 4/22/91 ag added check and code for economode. ; <11> 3/5/91 ag added install code for backlight driver. ; <10> 3/5/91 HJR Removed TaskDonePatch since IdleMind is now called from ; SynIdlePatch. ; <9> 2/26/91 HJR Added PmgrPowerOffPatch: an overpatch of the PowerOff trap in ; InterruptHandlers.a. ; <8> 2/22/91 HJR Fix bug in CheckWakeUp to prevent BusErr on non JAWSDecoder ; machines. ; <7> 1/24/91 HJR Moved IdleMind and powercycling code to PowerMgr.a. ; <6> 1/15/91 HJR Changed IdleMind so that it uses SleepTime off of PwrMgrVar ; instead of hardcoded constant. ; <5> 12/18/90 HJR Added DeskMgr.a overpatch, i.e. TaskDonePatch and IdleMind. ; <4> 12/11/90 HJR Fix bug. ; <3> 12/11/90 HJR Added Overpatching from StartInit.a, InterruptHandles.a and ; KbdADB.a. ; <2> 11/15/90 HJR Fixing comments. ; <1> 11/15/90 HJR first checked in ; PRINT OFF LOAD 'StandardEqu.d' INCLUDE 'HardwarePrivateEqu.a' INCLUDE 'UniversalEqu.a' INCLUDE 'PowerPrivEqu.a' INCLUDE 'PowerMgrDispatchEqu.a' INCLUDE 'IopEqu.a' INCLUDE 'EgretEqu.a' INCLUDE 'AppleDeskBusPriv.a' INCLUDE 'MMUEqu.a' INCLUDE 'Appletalk.a' INCLUDE 'LAPEqu.a' PRINT ON BLANKS ON STRING ASIS MACHINE MC68030 IMPORT GetHardwareInfo IMPORT RdXByte IMPORT USTPMGRSendCommand ;

IMPORT USTPMgrSendByte IMPORT InitWallyWorld ; IMPORT SetupTimeK ; PwrCntrlPatch PROC beok EQU 27 ;a BusError is expected and is OK ;¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ ; PATCHES TO StartInit.a ;-------------------------------------------------------------------------------- IF hasPwrControls THEN ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: PortableCheck ; ; Input: D2 - Bits 31..16, hwCfgFlags info (possibly unknown) ; D2 - Bits 7..0, Address Decoder Kind (zero if unknown) ; A1 - Productinfo ; ; Destroys: A0 ; ; Called by: BSR6 from StartInit. ; ; Function: Since we've just called JumpIntoROM, D2 has the decoder kind. ; We check to see if the wakeup flag is set. If it is, take wakeup ; code path, otherwise, continue with the bootup process. ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ WITH DecoderInfo,DecoderKinds,ProductInfo, ProductInfo, VideoInfo, PmgrRec, pmCommandRec PortableCheck CheckWakeUp IF isUniversal THEN TestFor hwCbPwrMgr BEQ.W NonPwrMgr ; NOPE. Branch... ENDIF MOVEA.L A6,A5 ; save return addr LEA @NoRAM,A6 ; load return addr in case of bus error MOVE.L PmgrBase,A2 ; get the addr of PMgrVars CMP.L #SleepConst,SleepSaveFlag(A2) ; are we waking from sleep? BNE.S @noRAM ; branch if not CLR.L SleepSaveFlag(A2) ; clear the sleep flag MOVE.L WakeVector(A2),A0 ; Go restore ourself JMP (A0) ; . NOP ; keep everything aligned @NoRAM MOVEA.L A5,A6 ; restore return addr IF 0 THEN ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: CheckEconoMode ; ; Input: D2 - Bits 31..16, hwCfgFlags info (possibly unknown) ; D2 - Bits 7..0, Address Decoder Kind (zero if unknown) ; ; Destroys: A0-A7,D0-D6 ; ; Called by: BSR6 from StartInit. ; ; Function: checks to see if a portable needs to be switched into econo-mode ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ CheckEconoMode MOVEA.L A6,A7 ; save the return address BigBSR6 InitWallyWorld,A1 ; download code into the PMGR, if necessary MOVEQ #0,D2 ; BigBSR6 GetHardwareInfo,A0 ; figure out what we're running on MOVE.L D2,D4 ; save the decoder type around the PRAM calls MOVEQ #$10,D1 ; read the PRAM validation byte MOVEA.L DecoderInfo.VIA1Addr(A0),A2 ; point to base of VIA1 BigBSR6 RdXByte,A0 ; MOVEQ #$A8-256,D0 ; compare what was read against expected value SUB.B D1,D0 ; MOVEQ #0,D1 ; (assume PRAM's invalid) TST.B D0 ; is PRAM OK? BNE.S @BadPRAM ; -> no, run at full speed for now MOVEQ #PmgrPramBase+PmgrPramRec.PmgrOtherFlags,D1 ; default to standard PRAM location MOVE.L PowerManagerPtr(A1),D0 ; does this box have a PMgr primitives table? BEQ.S @UseDefPRAM ; -> no, use the default location MOVEA.L A1,A2 ; ADDA.L D0,A2 ; point to the primitives table for this box ADDA.L PmgrPrimsRec.PrimInfoPtr(A2),A2 ; and then to the primitives info table MOVE.B PrimInfoTbleRec.PrimPRAMBase(A2),D1 ; get the base Power Manager PRAM byte ADDQ.B #PmgrPramRec.PmgrOtherFlags,D1 ; and adjust for the byte we want @UseDefPRAM MOVEA.L A1,A0 ; point back to the DecoderInfo table ADDA.L DecoderInfoPtr(A0),A0 ; MOVEA.L DecoderInfo.VIA1Addr(A0),A2 ; point to the base of VIA1 BigBSR6 RdXByte,A0 ; read the desired econo-mode setting from PRAM ANDI.B #(1< ADDA.L DecoderInfoPtr(A0),A0 ; one last time ; at this point: ; A0 - pointer to DecoderInfo table ; A1 - pointer to ProductInfo table ; D2 - decoder type IF hasMSC THEN ;¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ MSC ¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ IF isUniversal THEN CMPI.B #DecoderKinds.MSCDecoder,D2 ; do we have a MSC decoder? BNE NotMSC ; -> nope, bail ENDIF ORI.B #MSCDefConfig,D1 ; econo-mode + other default configuration
BTST #EconoBit,D1 ; are we in going to run in econo-mode? BNE.S @NotMSC33MHz ; -> yes, we'll be running at 16MHz regardless MOVEQ #7,D2 ; mask off the CPU ID AND.W CPUIDValue(A1),D2 ; CMP.W #5,D2 ; is it a 33MHz system (DB Lite)? BEQ.S @MSC33MHz ; -> yes, do setup CMP.W #2,D2 ; maybe it's a 33MHz Escher? BNE.S @NotMSC33MHz ; -> no, skip @MSC33MHz BCLR #MSC25MHz,D1 ; setup the state machines to run at 33MHz @NotMSC33MHz MOVEA.L DecoderInfo.RBVAddr(A0),A1 ; point to the base of the MSC decoder MOVEQ #(%11111000)-256,D2 ; mask off the RAM size information AND.B MSCConfig(A1),D2 ; OR.B D2,D1 ; and add it to the base configuration MOVE.B D1,MSCConfig(A1) ; stuff the configuration into the register
MOVE.L #(0<<16)|(1<<8)|(SetModemInts<<0),D3 ; BigBSR6 USTPmgrSendCommand,A2 ; turn off modem interrupts ;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× ; ; This is the nasty hack. When a Duo is docked to a DuoDockª or MiniDockª with an external SCSI ; hard disk connected and powered up, the SCC gets charged up a little bit and ends up in a weird ; state, usually generating level 4 interrupts. Normally we initialize the SCC later, but since ; the Docking Manager isn't initialized soon enough, as soon as interrupts are opened up, we get ; stuck in the level 4 interrupt handler (which is hopefully set up). This hack will talk to the ; DuoDock/MiniDock hardware directly and reset the external SCC. ROMSigAddr EQU $FEFFFFE4 ; where to find the ROM signature ROMSigLo EQU 'Russ' ; and what it is ROMSigHi EQU 'SWC!' vscClockPwr EQU $FEE00021 ; VSC power control register vscSCCclock EQU 1 ; 1=turn on SCC clock vscSCCAddr EQU $FEE08000 ; SCC base address If Not ForRomulator Then MOVEA.L SP,A5 ; save the return address BSET #beok,D7 ; allow bus errors BSR6 @WhackSCC ; go whack the SCC (bad SCC! bad SCC! blah blah) BCLR #beok,D7 ; disallow bus errors Endif BRA.S ExitEconoMode @InitBData DC.B 9,$C0 ; do a hard reset DC.B 9,$40 ; reset the channel DC.B 4,$4C ; set async mode (magic?) DC.B 2,$00 ; zero interrupt vector for dispatcher DC.B 3,$C0 ; DCD not an auto-enable DC.B 15,$00 ; no interrupts DC.B 0,$10 ; reset ext/sts interrupts twice DC.B 0,$10 DC.B 1,$00 ; no interrupts @InitAData DC.B 9,$80 ; reset the channel DC.B 4,$4C ; set async mode (magic?) DC.B 3,$C0 ; DCD not an auto-enable DC.B 15,$00 ; no interrupts DC.B 0,$10 ; reset ext/sts interrupts twice DC.B 0,$10 DC.B 1,$00 ; no interrupts @WhackSCC CMPI.L #ROMSigLo,ROMSigAddr ; is the signature in the config ROM? BNE.S @NotGemini ; -> no, not the ROM we're looking for CMPI.L #ROMSigHi,ROMSigAddr+4 ; ditto with the other part of the signature BNE.S @NotGemini ; -> no, not the ROM we're looking for BSET #vscSCCclock,vscClockPwr ; turn on clocks to the SCC LEA vscSCCAddr,A0 LEA @InitBData,A2 ; point to channel B init data MOVEQ #@InitAData-@InitBData,D1 LEA @ResumeB,A1 BRA.S @WriteSCC @ResumeB ADDQ.W #ACtl,A0 ; point to channel A MOVEQ #@WhackSCC-@InitAData,D1 LEA @ResumeA,A1 @WriteSCC MOVE.B (A0),D2 ; read to make sure the SCC is sync'ed up BRA.S @2 ; delay for timing, too @1 MOVE.L (SP),(SP) ; delay long for reset MOVE.L (SP),(SP) MOVE.B (A2)+,(A0) @2 DBRA D1,@1 JMP (A1) @ResumeA BCLR #vscSCCclock,vscClockPwr ; turn off clocks to the SCC @NotGemini RTS6 ;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× NotMSC ENDIF ExitEconoMode MOVEA.L A7,A6 ; restore the return address ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: InitAndBlankScreen | ; V ; Input: a6 - return address ; ; Destroys: A0-A7,D0-D6 ; ; Called by: BSR6 from StartInit. ; ; Function: initialize and blank the screen to meet timing requirements ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ InitAndBlankScreen IF hasNiagra | hasMSC THEN movea.l a6,a7 ; save original return address IF isUniversal THEN MOVEQ #0,D2 ; BigBSR6 GetHardwareInfo,A0 ; figure out what we're running on cmp.b #Decoderkinds.NiagraDecoder,D2 ; Do we have a Niagra decoder? beq.s @BlankNiagra ; -> yes cmpi.b #DecoderKinds.MSCDecoder,D2 ; do we have a MSC decoder? bne @ExitInitAndBlank ; -> no, continue ENDIF IF hasMSC THEN ; MOVEA.L DecoderInfo.RBVAddr(A0),A2 ; point to the base of the MSC BSET #MSCLCDReset,MSCClkCntl(A2) ; turn on clocks to the GSC so we can program it BRA.S @TestForGSC ; ENDIF ; IF hasNiagra THEN ; send command to power manager to blank the screen and delay before talking to the gsc ; D3- [data2] [data1] [length] [command] ; A0- pointer to DecoderInfo ; A6- return address @BlankNiagra MOVE.l #($E0<<0) | \ ; Write Pmgr Ram (03<<8) | \ ; count 3, 2 address + 1 data (00<<16) | \ ; addrH - $00xxH ($EA<<24),D3 ; addrL - $xxEA BigBSR6 USTPMGRSendCommand,A2 ; reset the system move.b #$0A,D3 ; port 4: d[2] = 0 (blank), d[0] = 1 adb inactive BigBSR5 USTPMgrSendByte,A4 ; and send it * bra.s @TestForGSC ; ENDIF ; test for gsc chip @TestForGSC MOVEA.L DecoderInfo.VDACAddr(A0),A0 ; point to base of gsc movea.l a7,a5 ; save return address in case of bus error bset.l #beok,d7 ; allow bus errors bsr6 @checkforGSC ; check for gsc chip bne @ExitInitAndBlank ; if not zero, buserror, no gsc, exit ; initialize GSC early to meet hardware timing spec @loadSetup moveq.l #7,D0 ; mask off the display ID And.b GSCPanelID(A0),D0 ; get the display id MULU #(GSCPanelSkew-GSCPanelSetup+1)+(GSCDiag2-GSCDiag0+1),D0 ; LEA @GSCInitTable,A2 ; point to the entry for this display ADDA.L D0,A2 ADDQ.W #GSCPanelSetup,A0 ; point to the first register to blast MOVE.L (A2)+,(A0)+ ; initialize the main display registers MOVE.L (A2)+,(A0)+ ; LEA GSCDiag0-GSCPanelSkew-1(A0),A0 ; point to the diagnostic registers MOVE.B (A2)+,(A0)+ ; and initialize them too MOVE.W (A2)+,(A0)+ ; bra.s @ExitInitAndBlank ; done @checkforGSC move.b GSCPanelID(A0),D0 ; try reading a register moveq #0,d0 ; set CC to Equal, buserr will return not Equal rts6 ; GSC initialization table. Each entry is based on the LCD panel ID. ; ; panel gray poly panel ACD refresh blank panel ; setup scale adjust adjust clock rate shade skew diag0 diag1 diag2 @GSCInitTable DC.B $10, $00, $64, $00, $80, $02, $00, $A0, $00, $00, $03 ; ID=0 TFT1Bit DC.B $12, $00, $64, $00, $80, $02, $00, $FF, $00, $00, $03 ; ID=1 TFT3Bit DC.B $10, $00, $64, $00, $80, $02, $00, $FF, $00, $00, $03 ; ID=2 TFT4Bit DC.B $10, $00, $64, $00, $80, $02, $00, $A0, $00, $00, $03 ; ID=3 NotAssignedTFT DC.B $10, $00, $64, $00, $80, $05, $00, $A0, $00, $00, $03 ; ID=4 NotAssignedSTN DC.B $10, $00, $64, $00, $80, $05, $00, $A0, $00, $00, $03 ; ID=5 TimSTN DC.B $10, $00, $63, $00, $80, $05, $00, $9C, $00, $00, $03 ; ID=6 DBLiteSTN DC.B $10, $00, $64, $00, $80, $05, $00, $A0, $00, $00, $03 ; ID=7 No Display @ExitInitAndBlank bclr.l #beok,d7 ; disallow bus errors movea.l a7,a6 ; restore original return address ENDIF ; {hasNiagra | hasMSC} ENDIF ; if 0 then ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: Exit ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ | ; V NonPwrMgr RTS6 ; return to start init ; All done ENDIF ; is hasPwrControls ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: BklightInstall ; Input: None ; ; Destroys: None ; ; Called by: BSR.L from StartInit. ; ; Function: Installs and opens ROM backlight driver ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ STRING PASCAL DriverID equ -16511 ; id of driver resource DriverType equ 'DRVR' ; resource type of driver StartEntry equ (48-1) ; this avoids appletalk area BacklightRegs reg A0-A3/D0-D3 EXPORT BacklightPatch BacklightPatch bsr.s BklightInstall move.l (sp)+,a0 SUBQ #4, SP ; save space for handle MOVE.L #'SERD', -(SP) ; push type jmp (a0) EXPORT BklightInstall BklightInstall ; movem.l BacklightRegs,-(sp) ; save the world IF isUniversal THEN ; TestFor hwCbPwrMgr beq.s @ExitInstallBacklight ENDIF @install move.l #DriverType,d1 ; load resource type in d1 move.w #DriverID,d2 ; load resource id in d2 bsr.s GetDetachRes ; get and detach resource (a1) beq.s @exit ; exit if no handle @findEntry move.l UTableBase,a0 ; point to utable array move.l #(StartEntry*4),d3 ; start at entry (48-1) @testEntry addq.l #4,d3 ; increment to next entry tst.l 0(a0,d3) ; test entry bne.s @testEntry ; if != 0, next entry @createDce move.l d3,d0 ; put offset into d0 lsr.l #2,d0 ; divide by 4 to get entry number addq.l #1,d0 ; add 1 (refnum is -(entry number + 1) neg.l d0 ; negate to get reference number _DrvrInstall ; create dce tst.l d0 ; test for error bne.s @releaseDrvr ; ... exit if error move.l (a0,d3),a3 ; get handle to dce in a3 move.l (a3),a3 ; get pointer to dce move.l a1,dCtlDriver(a3) ; load driver move.l (a1),a1 ; get pointer to driver move.w drvrFlags(a1),dCtlFlags(a3) ; copy data to dce move.w drvrDelay(a1),dCtlDelay(a3) move.w drvrEMask(a1),dCtlEMask(a3) move.w drvrMenu(a1),dCtlMenu(a3) bset.b #dNeedLock,dCtlFlags+1(a3) ; set the handle bit @openDrvr lea #'.Backlight',A1 ; load pointer to driver name bsr.s OpenDRVR @exit movem.l (sp)+,BacklightRegs ; restore the world rts @releaseDrvr move.l a1,a0 ; move handle to a0 _disposHandle ; release the memory @ExitInstallBacklight movem.l (sp)+,BacklightRegs ; restore the world rts ;------------------------------------------------------------------------------------------ ; ; GetDetachRes - Gets and detaches a resource. ; ; input ; d1 Resource Type ; d2 Resource ID ; ; output ; a1 Handle to resource ; ; usage ; d a1 - Handle to resource ; d d0 - Resource Type ; d1 - Resource Type ; d2 - Resource ID ; ;------------------------------------------------------------------------------------------ GetDetachRes SUBQ.L #4, SP ; For return address MOVE.L D1, -(SP) ; Resource type MOVE.W D2, -(SP) ; Resource ID _GetResource MOVE.L (SP), A1 ; Get resource handle to return _DetachResource MOVE.L A1,D0 ; Set result code RTS ;------------------------------------------------------------------------------------------ ; ; OpenDRVR - routine used to open a driver ; ; input ; a1 - pointer to driver name ; ; output ; none ; ; usage ; a0 - pointer to iopb ; a1 - pointer to driver name ; ;------------------------------------------------------------------------------------------ OpenRegs reg A0-A3/D1-D2 OpenDRVR MOVEM.L OpenRegs,-(SP) SUB.W #ioQElSize,SP ; Allocate IO stack frame MOVE.L SP,A0 ; set a0 to point to the pb MOVE.L A1,ioVNPtr(A0) ; load pointer to name MOVE.B #fsCurPerm,ioPermssn(A0) ; set permission (not used) _Open ADD.W #ioQElSize,SP ; Release stack frame MOVEM.L (SP)+,OpenRegs RTS ; Sucess returned in status ;¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ ; PATCHES TO InterruptHandlers.a ;-------------------------------------------------------------------------------- ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ <9> HJR ; Routine: PowerOffPatch ; ; Destroys: None ; ; Called by: PowerOff. from BSR ; ; Calls: _PmgrOp, _HideCursor, _Sleep ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ EXPORT PmgrPowerOffPatch IMPORT StartBoot WITH pmCommandRec PmgrPowerOffPatch IF hasPwrControls THEN IF isUniversal THEN TestFor hwCbPwrMgr beq.s PmgrOffDone ENDIF CLR.L -(SP) ; pmRBuffer = nil CLR.L -(SP) ; pmRBuffer = nil CLR.W -(SP) ; pmLength = 0 MOVE.W #PmgrADBoff,-(SP) ; pmCommand = turn ADB autopoll off MOVE.L SP,A0 ; point to the parameter block _PmgrOp LEA pmRBuffer+4(SP),SP ; clean up the stack _HideCursor CLR.L WarmStart ; be sure to do startup testing ; If we have the new PMGR then this command will work. If not then the call will ; fail and we will do it the old fashioned way. PEA 'MATT' ; shutdown signature

MOVE.L SP,-(SP) ; pmRBuffer (not used)

MOVE.L (SP),-(SP) ; pmSBuffer (the sleep signature)

MOVE.W #4,-(SP) ; pmLength = 4

MOVE.W #PmgrPWRoff,-(SP) ; pmCommand = power off

MOVE.L SP,A0 ; point to the parameter block

_PmgrOp ; power off using the PMGR

LEA pmRBuffer+4+4(SP),SP; clean up the stack

BNE.S @callSleep ; -> the call failed, so we have an old PMGR

BRA.S * ; Let the cyanide take affect @callsleep MOVE.W #SleepNow,D0 ; Set it to sleep _Sleep BigJSR StartBoot,A0 ; Reboot the guy. PmgrOffDone ENDIF ; RTS ; Get Out of Here <9> HJR ENDWITH ;¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ ; PATCHES TO PmgrOp ;-------------------------------------------------------------------------------- ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: DartModemCmds ; ; Input: A0 - points the pmgrop PB ; ; Destroys: d1 ; ; Called by: Bra from NewPmgrOp ; ; Function: filter the modem $5X commands, $50 should still go the power manager ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ EXPORT DartModemCmds DartModemCmds cmp.w #modemSet,pmCommand(A0) ; bne.s DartSPI ; Handle call through SPI moveq #1,d1 ; set CC to not handled here rts ; return ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: DartSPI ; ; Input: A0 - points the pmgrop PB ; ; Destroys: d1 ; ; Called by: Bra from NewPmgrOp ; ; Function: transfer data through new SPI port ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ EXPORT DartSPI DartSPI savedRegs REG D1-D4/A0-A3 ; ----- dynamic test for SPI ---- movea.l PMgrBase,a3 ; point to the Power Manager's variables btst.b #PmgrDartSPI,PmgrFlags1(a3) ; test if SPI modem installed bne.s @SPIStart ; Handle call through SPI moveq #1,d1 ; set CC to not handled here rts ; return @SPIStart movem.l savedRegs,-(sp) MOVEA.L UnivInfoPtr,a2 ; point to the ProductInfo table, ADDA.L DecoderInfoPtr(a2),a2 ; then to the DecoderInfo table, MOVEA.L JAWSAddr(a2),a2 ; then to the Niagra base address, ADDA.L #NiagraGUR,a2 ; point to the base of the GUR space ; ----- send command and count ---- move.w pmCommand(a0),d3 move.w d3,d1 bsr SendSPI ; send command byte bne.s @PMgrOpExit ; exit if error returned MOVEA.L PMgrBase,A1 ; point to the Power Manager's variables MOVEA.L vSendCountTbl(A1),A1 ; and get the send count table move.w pmLength(a0),d2 ; pop the count into d2 tst.b (a1,d3) bpl.s @noCount ; if positive, no count move.w d2,d1 bsr SendSPI ; send count byte bne.s @PMgrOpExit ; exit if error returned ; ----- send data ---- @noCount movea.l pmSBuffer(a0),a3 ; get the pointer to the command's data bytes moveq #0,d1 ; (set CCR for BEQ so DBNE below won't fall thru) bra.s @StartSend @SendData MOVE.B (a3)+,D1 ; get the next data byte BSR SendSPI ; and send it @StartSend DBNE d2,@SendData ; -> more bytes to send BNE.S @PMgrOpExit ; -> error ; ----- receive data ----- MOVEA.L PMgrBase,A1 ; point to the Power Manager's variables MOVEA.L vRecvCountTbl(A1),A1 ; and get the receive count table clr.l d4 ; clear count register move.b (a1,d3),d4 ; initialize to count bmi.s @readReplyCount ; (<0) cmp.b #1,d4 ; test against 1 ble.s @readData ; if ( =0 or =1 ) go to read subq #1,d4 ; (>1) correct count bra.s @readData ; if 0 or 1 go to read @readReplyCount bsr ReceiveSPI ; read first byte for receive count bne.s @PMgrOpExit ; exit if error returned move.w d1,d4 ; move count into d4 @readData ; d4 has receive byte count movea.l pmRBuffer(a0),a3 ; a3 new points move.w d4,pmLength(a0) ; bra.s @StartReceive ; start receiving data @ReceiveByte bsr.s ReceiveSPI ; read a byte into d1 bne.s @PMgrOpExit ; -> error move.b d1,(a3)+ ; move data byte into buffer @StartReceive dbra d4,@ReceiveByte ; -> more bytes to send @PMgrOpExit moveq #0,d1 ; indicate we handled call @exit movem.l (sp)+,savedRegs ; restore working registers rts ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: WaitSPIAckHi ; ; Input: a2.l - pointer to GUR space ; ; Destroys: d0 ; ; Returns d0.b - 0 = ok, non-zero = error ; ; Function: wait for SPI ack high ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ WaitSPIAckHi @workRegs reg D1-d2 movem.l @workRegs,-(sp) ; save working set move.w #32,d2 ; loop to max 32 msec @nextmsec move.w timedbra,d1 ; 1 msec count @waitAckhi btst.b #PontiSPIAck,PontiSPIMdmCtl(a2) ; test ack dbne d1,@waitAckhi ; loop for upto 1 msec dbne d2,@nextmsec ; loop for d2 msec seq d0 ; set result (d0 <> 0 = error), bit lo tst.b d0 ; set the condition codes movem.l (sp)+,@workRegs rts ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: WaitSPIAckLo ; ; Input: a2 - pointer to GUR space ; ; Destroys: d0 ; ; Returns d0 - 0 = ok, non-zero = error ; ; Function: wait for SPI ack lo ; ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ WaitSPIAckLo @workRegs reg D1-d2 movem.l @workRegs,-(sp) ; save working set move.w #32,d2 ; loop to max 32 msec @nextmsec move.w timedbra,d1 ; 1 msec count @waitAckhi btst.b #PontiSPIAck,PontiSPIMdmCtl(a2) ; test ack dbeq d1,@waitAckhi ; loop for upto 1 msec dbeq d2,@nextmsec ; loop for d2 msec sne d0 ; set result (d0 <> 0 = error), bit hi tst.b d0 ; set the condition codes movem.l (sp)+,@workRegs rts ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: SendSPI ; ; Input: a2.l - pointer to GUR space ; d1.b - byte to send ; ; Destroys: d0 ; ; Returns d0.w - 0 = ok, non-zero = error ; ; Function: send a byte thru the SPI ; ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ SendSPI bsr.s WaitSPIAckHi ; (1) wait for pmgr idle bne.s @error ; if bit low, error ;begin transaction bset.b #PontiLmpSPIDir,PontiLmpSftCtl(a2) ; (2) set direction to output move.b d1,PontiSPISftReg(a2) ; (3) write data bclr.b #PontiSPIReq,PontiSPIMdmCtl(a2) ; (4) assert data valid bsr.s WaitSPIAckLo ; (5) --> modem shift data ; (6) wait for data accepted bne.s @error ; if bit low, error bset.b #PontiSPIReq,PontiSPIMdmCtl(a2) ; (7) clear data valid MOVE.W #noErr,D0 ; report no error rts @error ; MOVE.W #pmSendStartErr,D0 ; report send error rts ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ; Routine: ReceiveSPI ; ; Input: a2.l - pointer to GUR space ; d1.b - byte to send ; ; Destroys: d0 ; ; Returns d0.w - 0 = ok, non-zero = error ; ; Function: read a byte from the spi ; ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ ReceiveSPI bsr.s WaitSPIAckHi ; (1) wait for pmgr idle bne.s @error ; if bit low, error ;begin transaction bclr.b #PontiLmpSPIDir,PontiLmpSftCtl(a2) ; (2) set direction to input bclr.b #PontiSPIReq,PontiSPIMdmCtl(a2) ; (3) (RFD) ready for data bsr.s WaitSPIAckLo ; (4) acknowledge req ; (5) <-- modem shifting bne.s @error ; if bit low, error bset.b #PontiSPIReq,PontiSPIMdmCtl(a2) ; (6) acknowledge ack bsr.s WaitSPIAckHi ; (7) wait (DAV) bne.s @error ; if bit low, error move.b PontiSPISftReg(a2),d1 ; (8) read data MOVE.W #noErr,D0 ; report no error rts @error MOVE.W #pmRecvStartErr,D0 ; mark as recieve error rts ; ;¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ ; That's all folks. ;-------------------------------------------------------------------------------- END