home *** CD-ROM | disk | FTP | other *** search
- ;*DDK*************************************************************************/
- ;
- ; COPYRIGHT (C) Microsoft Corporation, 1989
- ; COPYRIGHT Copyright (C) 1995 IBM Corporation
- ;
- ; The following IBM OS/2 WARP source code is provided to you solely for
- ; the purpose of assisting you in your development of OS/2 WARP device
- ; drivers. You may use this code in accordance with the IBM License
- ; Agreement provided in the IBM Device Driver Source Kit for OS/2. This
- ; Copyright statement may not be removed.;
- ;*****************************************************************************/
- ; CCSID = @(#)svgarout.asm 6.1 90/11/17
-
- ; ****************************************************************************
- ; * *
- ; * *
- ; * *
- ; ****************************************************************************
- PAGE 58,132
- TITLE Screen Device Driver - (svgarout.Asm)
- .386p
-
- ;/***********************************************************************/
- ;/* */
- ;/* SOURCE FILE NAME: svgarout.Asm STATUS: Version 1.1 */
- ;/* */
- ;/* DESCRIPTIVE NAME: Base Video Subsystem Screen Device Driver */
- ;/* */
- ;/* FUNCTION: Provide SVGA routines, called by category 80H, */
- ;/* SVGA_IOCTL listed below */
- ;/* GetSVGABank */
- ;/* SetSVGABank */
- ;/* GetSVGATrapIOList */
- ;/* SetSVGATrapIOList */
- ;/* GetSVGALockUnlock */
- ;/* SetSVGALockUnlock */
- ;/* GetSVGACleanup */
- ;/* SetSVGACleanup */
- ;/* GetSVGAInfo */
- ;/* */
- ;/* */
- ;/* NOTES: Executes on Level 0 */
- ;/* */
- ;/* ENTRY POINT: Screen_Strategy */
- ;/* LINKAGE: Far Call */
- ;/* */
- ;/* INPUT: ES:BX = request packet address */
- ;/* DS = BIODATA */
- ;/* */
- ;/* EXIT-NORMAL: */
- ;/* AX = Status to return to OS */
- ;/* */
- ;/* Error Code Cause */
- ;/* ------------------------------------------ */
- ;/* ERROR_I24_BAD_PARAMETER Invalid Parameter */
- ;/* */
- ;/* EFFECTS: None */
- ;/* */
- ;/* ROUTINES: Device_Help */
- ;/* Device_Help (DevHlp_PhysToUVirt) */
- ;/* */
- ;/************************ END OF SPECIFICATIONS ************************/
-
- .xlist
- INCLUDE basemaca.inc ;;;;;; 2.0 unique (dosmac replacement)
- INCLUDE devhlp.inc ; Define DevHlp functions
- INCLUDE devsym.inc ; Define DOS equates
- INCLUDE error.inc ; Define Error Messages
- INCLUDE struc.inc ; Define STRUC macros
- include iodelay.inc
- include bsedev.inc ;@senja
- include svgadefs.inc ; ;
- include pci.inc ;@senja
- .list
-
- ;
- ; Structure definitions
- ;
- FAR_POINTER STRUC
- _OFF DW (?) ; OFFSET OF FAR POINTER
- _SEG DW (?) ; SEGMENT OF FAR POINTER
- FAR_POINTER ENDS
-
- ;VVID_IDC argument structure. Return address is 8 bytes and save bp takes 2 bytes
- ;Pascal calling convention function.
- ulFunc EQU [bp+18]
- ulParam1 EQU [bp+14]
- ulParam2 EQU [bp+10]
-
- Flat_Pointer struc
- fp_offlo DW ?
- fp_offhi DW ?
- fp_sel DW ?
- Flat_Pointer ends
- IDC_SUCCESS EQU 1
-
- IDC_CMD_REGISTER_STACK_PROC EQU 0 ; stack based IDC VDD-PDD EP.
- IDC_CMD_REGISTER_EPREGISTER EQU 1 ; register based IDC VDD-PDD EP.
- ;@senja defined in the bsedev.inc
- ;GetLinear_Packet STRUC
- ; PacketLength DD 0H ; total size of data packet
- ; PhysicalAddress DD 0H ; Physical address of aperture
- ; ApertureSize DD 0H ; Size of aperture
- ; LinearAddress DD 0H ; Linear address of aperture (returned)
- ; LinearFlags DD 0H ; Linear address flags (optional)
- ;GetLinear_Packet ENDS
-
- GetLinear_Packet_Size EQU SIZE GETLINIOCTLDATA ;//@senja
- GetGlobal_Packet_Size EQU SIZE GlobalPktLength ;//@senja
-
- BANK_PARAM_PACKET_SIZE EQU SIZE BANKINFO ;//@senja
- VIDEO_SIZE EQU SIZE OEMSVGAINFO ;//@senja
- SVGA_OEM_PACKET_SIZE EQU SIZE OEMINFO ;//@senja
-
- ;
- ; SVGA BANK ROUTINES
- ; SCREENDD knows how to set or get current bank for all supported chipsets
- ; Routine depends on the current video mode and direction.
- ;
- ;SCREENDD_GETCURRENTBANK EQU 0h define in bsedev.h
- ;SCREENDD_SETCURRENTBANK EQU 1h
-
- ; parameter packet format is of _BANKINFO.
- ; SCREENDD_GETCURRENTBANK returns current Bank in the param packet Bank field.
- ; Minimum length of the packet is 8. Functions fail if less.
-
- ;
- ; SVGA TRAP_IO_REGISTERS ROUTINES
- ; SCREENDD doesn't understand the format of the list and serves as a
- ; communicator only. It can not perform any operation on the list.
- ;
- SVGA_GET_TRAPIO_LIST EQU 2h ; if passed size of data insufficient,
- ; error returned and ReturnDataPacketSize set!
- SVGA_SET_TRAPIO_LIST EQU 3h
-
- ; parameter packet format is SvgaGenericPacket
-
- ; data packet format: pointer to array of bytes of DataPacketSize.
- ; Only first ReturnDataPacketSize valid
-
- ;
- ; SVGA LOCK/UNLOCK COMMAND SECTION ROUTINES
- ; SCREENDD doesn't understand the format of the lock/unlock and serves as a
- ; communicator only. It can not perform any operation on the command list.
- ;
- SVGA_GET_LOCK_UNLOCK EQU 4h ; if passed size of data insufficient,
- ; error returned and ReturnDataPacketSize set!
-
- SVGA_SET_LOCK_UNLOCK EQU 5h
-
- ; parameter packet format SvgaGenericPacket
-
- ; data packet format: pointer to array of bytes of DataPacketSize.
- ; Only first ReturnDataPacketSize valid
-
- LOCK_COMMANDS EQU 0H
- UNLOCK_COMMANDS EQU 1H
- ;
- ; SVGA CLEANUP COMMAND SECTION ROUTINES
- ; SCREENDD doesn't understand the format of the cleanup and serves as a
- ; communicator only. It can not perform any operation on the command list.
- ;
- SVGA_GET_CLEANUP_SECT EQU 6h ; if passed size of data insufficient,
- ; error returned and ReturnDataPacketSize set!
- SVGA_SET_CLEANUP_SECT EQU 7h
-
- ; parameter packet format SvgaGenericPacket
-
- ; data packet format: pointer to array of bytes of DataPacketSize.
- ; Only first ReturnDataPacketSize valid
-
- ;
- ; SVGA_GET_INFO
- ;
- SCREENDD_SVGA_ID EQU 8h
-
- ;
- ; SVGA_GET_MANUFACTURER
- ;
- SCREENDD_SVGA_OEM EQU 9h ;
- ;no parameter packet
-
- DELIMITER EQU '('
- PERIOD EQU '.'
-
- ;
- ; SCREENDD_UPDATE_MEMORY
- ;
- SCREENDD_UPDATE_MEMORY EQU 0Ah ;
- ;no data packet
- ;parameter packet is a pointer to ULONG containing new SVGAMemory.
-
- ; end of SVGA support
-
- EXTRN NOPSetBank : WORD ; all bank routines in SVGABANK.ASM
- EXTRN ATISetBank : WORD
- EXTRN CirrusSetBank: WORD
- EXTRN IBMSetBank : WORD
- EXTRN S3SetBank : WORD ; ;
- EXTRN TridentSetBank:WORD
- EXTRN TsengSetBank : WORD
- EXTRN Video7SetBank: WORD
- EXTRN WDSetBank : WORD
- EXTRN WeitekSetBank: WORD ;/* */
-
- EXTRN NOPGetBank : WORD
- EXTRN ATIGetBank : WORD
- EXTRN CirrusGetBank: WORD
- EXTRN IBMGetBank : WORD
- EXTRN S3GetBank : WORD ; ;
- EXTRN TridentGetBank:WORD
- EXTRN TsengGetBank : WORD
- EXTRN Video7GetBank: WORD
- EXTRN WDGetBank : WORD
- EXTRN WeitekGetBank: WORD ;/* */
-
- EXTRN DevHelp: DWORD
- IFDEF FAMILY2 ;
- EXTRN LID : WORD
- ENDIF
-
-
- DGROUP GROUP BioData
-
- BioData SEGMENT WORD PUBLIC 'DATA' USE16
- ASSUME DS:BioData
-
- PUBLIC _sSVGA ; /* */
- PUBLIC _XGAInstance ; /* */
-
- EXTRN SvgaOEMInfo : WORD ; /* */
- EXTRN SvgaBaseAddr : WORD ; /* */
- EXTRN DATA_END : WORD ; /* */
-
- PUBLIC SVGA_SET_BANK_TABLE
- PUBLIC SVGA_GET_BANK_TABLE
- PUBLIC PmiInfo
-
- DiamondWDSig DB 'SPEEDSTAR 24X' ;
- DiamondETSig DB 'SPEEDSTAR 24' ;
- DiamondS324Sig DB 'STEALTH 24' ; ;
- DiamondS3PROSig DB 'STEALTH PRO' ;
- Number9S3Sig DB 10111101b,00110011b ;
- ArtistS3Sig DB 'WINSPRINT 900' ;
- MIROCRYSTALSig DB 'MIROCRYSTAL' ;
-
- align 2
- SVGA_FUNCTION_TABLE LABEL WORD ; SVGA category IOCTL functions
- DW GetSVGABank ;00h return current bank
- DW SetSVGABank ;01h set current bank
- DW FutureSVGAFunc ;02h return TRAP IO list for current chipset
- DW FutureSVGAFunc ;03h save TRAP IO list for current chipset
- DW FutureSVGAFunc ;04h return (un)lock section for current chipset
- DW FutureSVGAFunc ;05h save (un)lock section for current chipset
- DW FutureSVGAFunc ;06h return cleanup section for current chipset
- DW FutureSVGAFunc ;07h save cleanup section for current chipset
- DW GetSVGAInfo ;08h return chipset and vram size information
- DW GetOEMInfo ;09h return chipset and vram size information
- DW UpdateMemoryInfo ;0Ah return chipset and vram size information
- DW GetLinearAccess ;0Bh return linear address mapped to given physical
- DW GetGlobalAccess ;0Ch return global address converted from current process
- DW FreeGlobalAccess ;0Dh free global addresses converted from current process
- DW RegisterRing0Caller ;0Eh
- DW WaitOnRing0Caller ;0Fh
- SVGA_FUNCTION_TABLE_SIZE EQU ($-OFFSET SVGA_FUNCTION_TABLE)/2
-
- SVGA_SET_BANK_TABLE LABEL WORD
- DW NOPSetBank
- DW Video7SetBank
- DW TridentSetBank
- DW TsengSetBank
- DW WDSetBank
- DW ATISetBank
- DW IBMSetBank
- DW CirrusSetBank
- DW S3SetBank ; ;
- DW NOPSetBank ;For Chips & Tech /* */
- DW WeitekSetBank ;For Weitek /* */
-
- SVGA_GET_BANK_TABLE LABEL WORD
- DW NOPGetBank
- DW Video7GetBank
- DW TridentGetBank
- DW TsengGetBank
- DW WDGetBank
- DW ATIGetBank
- DW IBMGetBank
- DW CirrusGetBank
- DW S3GetBank ; ;
- DW NOPGetBank ;For Chips & Tech /* */
- DW WeitekGetBank ;For Weitek /* */
-
- ScreenDDName DB "SCREEN$",0 ;
- OemName DB "OEMHLP$ ",0 ; must be 8 chars.
- IDC_ENTRY STRUC
- RealEntry DD ? ; DD Real Mode Entry Pt (Seg:Offset)
- RealDS DW ? ; DD Real Mode Data Segment
- ProtEntry DD ? ; DD Protect Mode Entry Pt (Sel:Offset)
- ProtDS DW ? ; DD Protect Mode Data Selector
- IDC_ENTRY ENDS
- OemDDEntry IDC_ENTRY <> ;
- OemDDRequest Packet <> ;
- pciFindClassP PciFindClassCode_P <> ;@senja
- pciFindClassD PciFindClassCode_D <> ;@senja
- pciReadConfigP pciReadConfig_P <> ;@senja
- pciReadConfigD pciReadConfig_D <> ;@senja
- FlatPointer DD 0 ; Used for GetLinearAccess
- FlatPtrOffset DD 0 ; Used for GetLinearAccess
- PUBLIC PCI_DeviceTbl
- PUBLIC PCI_Num
- PCI_DeviceTbl DD 8 dup (?) ;upto 8 PCI adapters
- PCI_Num DW 0 ;number of PCI adapters found
- Class_Index DB 0 ;Index within the same class@TSU
- JUNK DB 0 ;@TSU
- ; This is the class list for video. Unfortunatelly, there is no PCI subc.
- ; guidance which class should SVGA devices use.
- ; The only possible video class I've excluded is the XGA controller.
- ; This list is not really built as a table, since the code will keep probing in
- ; a specific order, in order to avoid setting up indirect addressing to walk the table.
- currentClass EQU 00000101h ; class 0, vga compatible sub-class
- VGAClass EQU 00000100h ; class 0,
- SVGAClass EQU 00030000h ; class 3, VGA compatible sub-class
- XGAClass EQU 00030100h ; class 3, XGA Controller @TSU
- lastClass EQU 00038000h ; class 3, other display
- PCI_SUCCESSFUL EQU 0 ;@senja
- _sSVGA OEMSVGAINFO <0,0,0100000H> ; /* */
- PUBLIC _XGAInstance
- _XGAInstance DW 0 ;Speedway XGA instance /* */
- ADAPTER_TYPE DW 0 ; Adapters found /* */
- PmiInfo DD _sSVGA ;This location will be used as the block key
-
- BioData ends
-
- BiosSeg SEGMENT WORD Public 'CODE' USE16
- ASSUME CS:BiosSeg
-
- PUBLIC GetSVGABank
- PUBLIC SetSVGABank
-
- PUBLIC SVGA_SET_BANK_TABLE ; /* */
- PUBLIC SVGA_GET_BANK_TABLE ; /* */
-
- IF 0
- PUBLIC GetSVGATrapIOList
- PUBLIC SetSVGATrapIOList
- PUBLIC GetSVGALockUnlock
- PUBLIC SetSVGALockUnlock
- PUBLIC GetSVGACleanup
- PUBLIC SetSVGACleanup
- ENDIF
- PUBLIC GetSVGAInfo
- PUBLIC GetOEMInfo
- PUBLIC UpdateMemoryInfo
- PUBLIC SVGA_IOCTL
- PUBLIC GetLinearAccess
- PUBLIC GetGlobalAccess
- PUBLIC FreeGlobalAccess
- PUBLIC RegisterRing0Caller
- PUBLIC WaitOnRing0Caller
-
- PUBLIC AttachOEM ;
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: SVGA_IOCTL
- ;
- ; DESCRIPTIVE NAME: SVGA IOCTL Routine
- ;
- ; FUNCTION: Performs SVGA specific function requests
- ;
- ; ENTRY POINT: SVGA_IOCTL
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ; GetSVGABank
- ; SetSVGABank
- ; GetSVGATrapIOList
- ; SetSVGATrapIOList
- ; GetSVGALockUnlock
- ; SetSVGALockUnlock
- ; GetSVGACleanup
- ; SetSVGACleanup
- ; GetSVGAInfo
- ; GetOEMInfo
- ; UpdateMemoryInfo
- ;
- ;
- ;
- ; CALLED BY ROUTINES:
- ; SCREEN_STRATEGY
- ;
-
- SVGA_IOCTL PROC NEAR
-
- ASSUME DS:BioData , ES:NOTHING, SS:NOTHING
-
- ;
- ; Get packet function and use appropriate table
- ;
- mov al, es:[bx].giofunction ; command code
- .if <al ae <svga_function_table_size>> ; if command is supported
- ; else
- mov ax,STERR + ERROR_I24_BAD_COMMAND; unknown cmd err + error bit
- .else
- svga_function:
- mov si, offset SVGA_FUNCTION_TABLE ; use standard routines
- cbw ; make command code a word
- shl ax, 1 ; make command code a table offset
- add si, ax ; si = command table offset
- call [si] ; go do request
- .endif
- ;
- ; exit
- ;
- endif_svga:
- ret ; return to caller.
-
- SVGA_IOCTL ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: VerifyDataPacket
- ;
- ; DESCRIPTIVE NAME: Verify data packet pointer.
- ;
- ; FUNCTION: Verify data packet.
- ;
- ; ENTRY POINT: VerifyDataPacket
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; CX = length to verify
- ;
- ; OUTPUT:
- ; AX = STERR + ERROR_I24_INVALID_PARAMETER /* */
- ;
- ; EXIT-NORMAL:
- ; NC.
- ;
- ; EXIT-ERROR:
- ; CY
- ;
- ; EFFECTS:
- ; AX, DI, DL
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; Various.
- ;
- VerifyDataPacket PROC NEAR
-
- mov ax,es:[bx].GIODataPack._SEG ; Make sure data packet
- mov di,es:[bx].GIODataPack._OFF ; selector is valid.
- ; Drop thru to:
-
- ;* /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: VerifyPacket
- ;
- ; DESCRIPTIVE NAME: Verify data packet pointer.
- ;
- ; FUNCTION: Verify data packet.
- ;
- ; ENTRY POINT: VerifyPacket
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; AX:DI = request packet address
- ; CX = length to verify
- ;
- ; OUTPUT:
- ; AX = STERR + ERROR_I24_INVALID_PARAMETER /* */
- ;
- ; EXIT-NORMAL:
- ; NC.
- ;
- ; EXIT-ERROR:
- ; CY
- ;
- ; EFFECTS:
- ; AX, DL
- ;
- ; USES ROUTINES:
- ;* VerifyPacket /* */
- ;
- ; CALLED BY ROUTINES:
- ; Various.
- ;
- VerifyPacket PROC NEAR
-
- mov dh, 1 ;read/write access
- mov dl,DevHlp_VerifyAccess
- call DevHelp
- mov ax,STERR + ERROR_I24_INVALID_PARAMETER ; /* */
- ret
-
- VerifyPacket ENDP
-
- VerifyDataPacket ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: VerifyParaPacket
- ;
- ; DESCRIPTIVE NAME: Verify parameter packet pointer.
- ;
- ; FUNCTION: Verify parameter packet.
- ;
- ; ENTRY POINT: VerifyParaPacket
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; CX = length to verify
- ;
- ; OUTPUT:
- ; AX = STERR + ERROR_I24_INVALID_PARAMETER /* */
- ;
- ; EXIT-NORMAL:
- ; NC
- ;
- ; EXIT-ERROR:
- ; CY
- ;
- ; EFFECTS:
- ; AX, DI, DL
- ;
- ; USES ROUTINES:
- ;* VerifyPacket /* */
- ;
- ; CALLED BY ROUTINES:
- ; Various.
- ;
- VerifyParaPacket PROC NEAR
-
- mov ax,es:[bx].GIOParaPack._SEG ; Make sure parameter packet
- mov di,es:[bx].GIOParaPack._OFF ; selector is valid.
- call VerifyPacket
- ret
-
- VerifyParaPacket ENDP
-
- ;* /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: VerifyVariablePacket
- ;
- ; DESCRIPTIVE NAME: Verify parameter packet pointer.
- ;
- ; FUNCTION: Verify parameter packet.
- ;
- ; ENTRY POINT: VerifyVariablePacket
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; CX = minimum length to verify
- ;
- ; OUTPUT:
- ; FS:SI = ES:[BX.GIOParaPack]
- ;
- ; EXIT-NORMAL:
- ; NC
- ;
- ; EXIT-ERROR:
- ; AX = STERR + ERROR_I24_INVALID_PARAMETER /* */
- ; CY
- ;
- ; EFFECTS:
- ; AX, DI, DL
- ;
- ; USES ROUTINES:
- ;* VerifyParaPacket /* */
- ;
- ; CALLED BY ROUTINES:
- ; Various.
- ;
- VerifyVariablePacket PROC NEAR
-
- call VerifyParaPacket ;
- .if <nc>
- lfs si, es:[bx].GIOParaPack ; verify the whole packet.
- mov ax, word ptr fs:[si].ulBankLength ;
- .if <cx b ax>
- mov cx, ax
- call VerifyParaPacket; function requires es:bx=req.p.
- ; and ds local data segment
- .endif
- .endif
- ret
-
- VerifyVariablePacket ENDP
-
- ;* /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: VerifyBank
- ;
- ; DESCRIPTIVE NAME: Verify data packet bank info.
- ;
- ; FUNCTION: Verify data packet bank info.
- ;
- ; ENTRY POINT: VerifyBank
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; FS:SI = request packet GIOParaPack
- ;
- ; OUTPUT:
- ; AX = STERR + ERROR_I24_INVALID_PARAMETER /* */
- ; DX = Direction
- ; DI = Mode
- ;
- ; EXIT-NORMAL:
- ; BE (all within range)
- ;
- ; EXIT-ERROR:
- ; A (something beyond range)
- ;
- ; EFFECTS:
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; GetSVGABank
- ; SetSVGABank
- ;
- VerifyBank PROC NEAR
-
- mov bx, si ;fs:bx points to the BankPacket
- mov dx, fs:[bx].usReadWriteMode ;read/write
- .if <dx be WRITE_BANK>
- mov di, fs:[bx].usVideoModeType
- cmp di, MODE_LINEAR
- .endif
- mov ax,STERR + ERROR_I24_INVALID_PARAMETER ; /* */
- ret
-
- VerifyBank ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetLinearAccess
- ;
- ; DESCRIPTIVE NAME: Return linear address mapped to given physical
- ;
- ; FUNCTION: Returns a linear address to a physical region of memory
- ; of given size.
- ;
- ; ENTRY POINT: GetLinearAccess
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
-
- GetLinearAccess PROC NEAR
-
- mov cx,offset LinearFlags ;Get packet min size /* */
- call VerifyVariablePacket ;Verify at least cx byte/* */
- .if <nc> ;
- les bx,es:[bx].GIOParaPack ;
- mov edi,es:[bx].PhysicalAddress ;
- or edi,edi ; /* */
- stc ;Error if edi is zero /* */
- .if <nz> ; /* */
- mov FlatPointer,edi ;
- mov eax,FlatPtrOffset ;
- .if <zero eax> ;
- mov ax,ds ;Convert selector:offset
- mov esi,OFFSET FlatPointer ;
- mov dl,DevHlp_VirtToLin ;
- call DevHelp ;
- .endif
- .endif
- .endif ;Endif packet size OK /* */
- .if <nc> ;If linear addr OK: /* */
- mov FlatPtrOffset,eax ;
- mov edi,eax ;
- mov eax,00410h ;Map phys to linear (shared) by def
- .if <es:[bx].PacketLength ae GetLinear_Packet_Size> ;If flags:
- mov eax,es:[bx].LinearFlags ;Get caller flags.
- .endif ; /* */
- mov ecx,es:[bx].ApertureSize; Size in bytes
- test eax,080000000h ;Top bit set? /* */
- .if <z> ;If not: /* */
- mov dl,DevHlp_VMAlloc ;
- call DevHelp ;
- .else ;Else set! Attach /* */
- mov di,bx ;save pointer to packet /* */
- mov eax,010h ;VDHGP_ATTACH to process/* */
- mov ebx,es:[di].LinearAddress ;Existing linear address
- mov ecx,es:[di].ApertureSize ;Size in bytes
- mov dl,DevHlp_VMGlobalToProcess ; /* */
- call DevHelp ; /* */
- mov bx,di ;Restore ptr to packet /* */
- .endif ;Endif attach /* */
- .endif ;Endif linear addr OK /* */
- .if <nc> ;If linear addr OK:
- mov es:[bx].LinearAddress,eax ;
- xor eax,eax ;return - no error
- .else
- GetLinError:
- mov ax,STERR + ERROR_I24_INVALID_PARAMETER ; /* */
- .endif ;return - error code set
- ret
-
- GetLinearAccess ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetGlobalAccess
- ;
- ; DESCRIPTIVE NAME: Return linear global address for per-process address
- ;
- ; FUNCTION:
- ;
- ; ENTRY POINT: GetGlobalAccess
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
-
- GetGlobalAccess PROC NEAR
- mov cx,GetGlobal_Packet_Size;Get packet min size /* */
- call VerifyVariablePacket ;Verify at least cx byte/* */
- jc short GetGlobalError ;
-
- les di,es:[bx].GIOParaPack ;ES:DI -> packet /* */
- mov esi,es:[di].GlobalPktLength ;check how many entries
- sub esi,GetGlobal_Packet_Size ;
- cmp esi,SIZE GLOBALIOCTLDATA
- jb short GetGlobalError ;
- mov eax,esi ;
- mov cl,SIZE GLOBALIOCTLDATA ;
- idiv cl ;
- or ah,ah ;
- jnz short GetGlobalError ;must be exact size
- movzx esi,al ;no of addresses to go global
- add edi,GetGlobal_Packet_Size ;
-
- GetGlobalNext:
- mov ebx,es:[di].ProcessAddress ;EBX = Process linear address
- or ebx,ebx ;
- jz short @F ;
- test ebx,0FFFH ;
- jnz GetGlobalError ;must be page aligned
- mov ecx,es:[di].AddressLength ;ECX = Length in bytes
- or ecx,ecx ;
- jz short @F ;
- shr ecx,4 ;round up to para boundary
- inc ecx ;
- shl ecx,4 ;
- mov eax,1 ;Create writable mapping
- mov dl,DevHlp_VMProcessToGlobal ;
- call DevHelp ;
- jc short GetGlobalError ;
- mov es:[di].GlobalAddress,eax ;
-
- @@: add di,SIZE GLOBALIOCTLDATA ;
- dec esi ;
- jnz short GetGlobalNext ;
-
- xor eax,eax ;
- ret ; return - no error
-
- GetGlobalError:
- mov ax,STERR + ERROR_I24_INVALID_PARAMETER
- ret ; return - error code set
- GetGlobalAccess ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: FreeGlobalAccess
- ;
- ; DESCRIPTIVE NAME: Free linear global addresses
- ;
- ; FUNCTION:
- ;
- ; ENTRY POINT: FreeGlobalAccess
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
-
- FreeGlobalAccess PROC NEAR
- mov cx,GetGlobal_Packet_Size;Get packet min size /* */
- call VerifyVariablePacket ;Verify at least cx byte/* */
- jc short FreeGlobalError ;
-
- les di,es:[bx].GIOParaPack ;ES:DI -> packet /* */
- mov esi,es:[di].GlobalPktLength ;check how many entries
- sub esi,GetGlobal_Packet_Size ;@senja
- cmp esi,SIZE GLOBALIOCTLDATA ;
- jb short FreeGlobalError ;
- mov eax,esi ;
- mov cl,SIZE GLOBALIOCTLDATA ;
- idiv cl ;
- or ah,ah ;
- jnz short FreeGlobalError ;must be exact size
- movzx esi,al ;no of addresses to go global
- add edi,GetGlobal_Packet_Size ;@senja
-
- FreeGlobalNext:
- mov eax,es:[di].GlobalAddress ;EAX = Global address
- or eax,eax ;
- jz short @F ;
- mov dl,DevHlp_VMFree ;
- call DevHelp ;
- jc short FreeGlobalError ;
-
- @@: add di,SIZE GLOBALIOCTLDATA ;
- dec esi ;
- jnz short FreeGlobalNext ;
-
- xor eax,eax ;
- ret ; return - no error
-
- FreeGlobalError:
- mov ax,STERR + ERROR_I24_INVALID_PARAMETER
- ret ; return - error code set
- FreeGlobalAccess ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetSVGAInfo
- ;
- ; DESCRIPTIVE NAME: Return SVGA chip and its VRAM size information.
- ;
- ; FUNCTION: Fill data packet with SVGA chip information.
- ;
- ; ENTRY POINT: GetSVGAInfo
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- GetSVGAInfo PROC NEAR
- ASSUME DS:BioData
-
- ; cmp es:[bx].GIOFunction, SCREENDD_SVGA_ID ; /* */
- ; jne short @F ; /* */
- mov cx, VIDEO_SIZE ; //@senja
- mov si, offset _sSVGA ; /* */
- ;Drop thru to:
-
- ; /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetDataPacket
- ;
- ; DESCRIPTIVE NAME: Return saved data packet
- ;
- ; FUNCTION: Fill data packet with saved info.
- ;
- ; ENTRY POINT: GetDataPacket
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; CX = data packet length
- ; SI = offset saved info offset.
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; GetSVGAInfo
- ;
- GetDataPacket PROC NEAR
- ASSUME DS:BioData
-
- call VerifyDataPacket ;
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER ; /* */
- .if <nc> ;If no exit with error:
- ; mov al,es:[bx].GIOFunction ; /* */
- les di,es:[bx].GIODataPack
- ; mov si, offset _sSVGA ; /* */
- rep movsb ; /* */
- ; movsw ; SVGAAdapterType /* */
- ; movsw ; SVGAChipType /* */
- ; movsw ; SVGAMemory (LSW) /* */
- ; movsw ; SVGAMemory (MSW) /* */
- xor ax,ax ; Indicate success /* */
- ; jmp short END_SVGA ; /* */
- ;@@: mov ax,STERR + ERROR_I24_BAD_COMMAND /* */
- .endif
- END_SVGA:
- ret
-
- GetDataPacket ENDP
-
- GetSVGAInfo ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetOEMInfo
- ;
- ; DESCRIPTIVE NAME: Return SVGA manufacturer and BIOS revision.
- ;
- ; FUNCTION: Fill data packet with OEM information.
- ;
- ; ENTRY POINT: GetSVGAInfo
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- GetOEMInfo PROC NEAR
- ASSUME DS:BioData
-
- ; cmp es:[bx].GIOFunction, SCREENDD_SVGA_OEM;/* */
- ; jne short @F ; /* */
- mov cx, dword ;verify length first. /* */
- call VerifyDataPacket ;
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER /* */
- .if <nc> ;If no exit with error:
- ;!! What about using FS:SI?
- push es ;read first dword to get total length.
- les di, es:[bx].GIODataPack
- mov cx, word ptr es:[di];verify entire packet
- pop es
- call VerifyDataPacket ;
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER /* */
- .endif
- .if <nc> ;If no exit with error:
- les di, es:[bx].GIODataPack ;ptr to OEM info /* */
- mov cx, word ptr es:[di];verify entire packet /* */
- mov ax, word ptr [SvgaOEMInfo.OEMLength] ; /* */
- ;Get space needed /* */
- .if <cx a ax> ;More space than we need/* */
- mov cx, ax ;Use minimum size /* */
- .endif /*@V2.1MNH13*/
- lea si, [SvgaOEMInfo] ;Point to premade info /* */
- rep movsb ;Copy predetermined info/* */
- xor ax,ax ;Indicate success
- ; jmp short END_OEM /* */
- ;@@: mov ax,STERR + ERROR _I24_BAD_COMMAND /* */
- .endif
- END_OEM:
- ret
- GetOEMInfo ENDP
- ;* /* */
- ;* Moved Process OEM to initialization section /* */
- ;* /* */
- ;
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: UpdateMemoryInfo
- ;
- ; DESCRIPTIVE NAME: Set SVGA memory to the value passed.
- ;
- ; FUNCTION:
- ;
- ; ENTRY POINT: UpdateMemoryInfo
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- UpdateMemoryInfo PROC NEAR
- ASSUME DS:BioData
-
- ; mov ax,STERR + ERROR_I24_BAD_COMMAND; /* */
- ; cmp es:[bx].GIOFunction, SCREENDD_UPDATE_MEMORY ; /* */
- ; jne short @F ; /* */
- mov cx, dword ; /* */
- call VerifyParaPacket ;
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER ; /* */
- .if <nc> ;If no exit with error:
- les bx, es:[bx].GIOParaPack ;
- mov eax, es:[bx] ;
- mov [_sSVGA.Memory], eax ; /* */
- xor eax, eax ;
- .endif
- @@:
- ret
- UpdateMemoryInfo ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: GetSVGABank
- ;
- ; DESCRIPTIVE NAME: Return current chipset bank.
- ;
- ; FUNCTION: Parameter packet contains direction and video mode.
- ; Return bank thru data packet. All chipset routines expect
- ; current video mode in DI and direction in DX. Bank returned
- ; in AX. No error handling by the routines.
- ;
- ; ENTRY POINT: GetSVGABank
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- GetSVGABank PROC NEAR
-
- mov cx,BANK_PARAM_PACKET_SIZE ; minimum length which should be valid.
- call VerifyVariablePacket ; /* */
- .if <nc> ; /* */
- call VerifyBank ; /* */
- .if <be> ; /* */
- mov si, [_sSVGA.AdapterType] ; /* */
- shl si, 1 ; Make adapter type a table offset
- call [SVGA_GET_BANK_TABLE][si] ; go do request
- ; AX = current bank
- mov word ptr fs:[bx].usBank, ax;
- xor ax,ax ; Indicate success
- ; ret ; /* */
- .endif
- .endif
- ERROR_BANK_EXIT:
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER /* */
- ret
- GetSVGABank ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: SetSVGABank
- ;
- ; DESCRIPTIVE NAME: Return current chipset bank.
- ;
- ; FUNCTION: Parameter packet contains length, bank, direction and video mode.
- ; All chipset routines expect current video mode in DI,
- ; direction in DX and bank in CX.
- ; No error handling by the called routines.
- ;
- ; ENTRY POINT: SetSVGABank
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- SetSVGABank PROC NEAR
-
- mov cx,BANK_PARAM_PACKET_SIZE ; mimimum size which should be valid.
- call VerifyVariablePacket ; /* */
- .if <nc> ; /* */
- call VerifyBank ; /* */
- .if <be> ; /* */
- mov cx, fs:[bx].usBank ; Bank
- mov si, [_sSVGA.AdapterType] ; /* */
- shl si, 1 ; Make adapter type a table offset
- call [SVGA_SET_BANK_TABLE][si] ; go do request
- xor ax,ax ; Indicate success
- ; ret ; /* */
- .endif
- .endif
- ERROR_BANK:
- ; mov ax,STERR + ERROR_I24_INVALID_PARAMETER /* */
- ret
-
- SetSVGABank ENDP
-
- ; Future SVGA functions 2-7. Still undefined.
- ;GetSVGATrapIOList
- ;SetSVGATrapIOList
- ;GetSVGALockUnlock
- ;SetSVGALockUnlock
- ;GetSVGACleanup
- ;SetSVGACleanup
- FutureSVGAFunc PROC NEAR ;
- mov ax,STERR + ERROR_I24_BAD_COMMAND
- ret
- FutureSVGAFunc ENDP
-
- ; /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: RegisterRing0Caller
- ;
- ; DESCRIPTIVE NAME: Register the ring 0 caller.
- ;
- ; FUNCTION: RegisterRing0Caller and WaitOnRing0Caller represent a
- ; communication interface for the svgapmi/vvid. WaitOnRing0Caller
- ; (svgapmi) will be blocked until ring0 caller (Vvid)
- ; registers.
- ; PMIInfo global data represents the block event key.
- ;
- ;
- ; ENTRY POINT: RegisterRing0Caller
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- RegisterRing0Caller PROC NEAR
- ASSUME DS:BioData
-
- ; release the WaitOnRing0 caller's thread.
- mov ax, ds ; setup event ID
- mov bx, offset PmiInfo ;
- mov dl,DevHlp_ProcRun ;
- call DevHelp
- xor ax,ax ;Indicate success
- ret ;
- RegisterRing0Caller ENDP
-
- ; /* */
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: WaitOnRing0Caller
- ;
- ; DESCRIPTIVE NAME: Set Ring0 Pmi Info data structure
- ;
- ; FUNCTION: RegisterRing0Caller and WaitOnRing0Caller represent a
- ; communication interface for the svgapmi/vvid. WaitOnRing0Caller
- ; (svgapmi) will be blocked until ring0 caller (Vvid)
- ; registers.
- ; PMIInfo global data represents the block event key.
- ;
- ; ENTRY POINT: WaitOnRing0Caller
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; AX = Status to return to OS
- ;
- ; EXIT-ERROR:
- ; None
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; SVGA_IOCTL
- ;
- WaitOnRing0Caller PROC NEAR
- ASSUME DS:BioData
- ; block until ring0 caller registers. No time-out, noninterruptable
- mov ax, ds ; setup event ID
- mov bx, offset PmiInfo
- mov di, 0ffffh
- mov cx, 0ffffh
- mov dh, 1
- mov dl,DevHlp_ProcBlock
- call DevHelp
- ; run again here, ring0 caller registered.
- ; return.
- xor ax,ax ;Indicate success
- ret
-
- WaitOnRing0Caller ENDP
-
- PUBLIC VVID_IDC
- ;/****************************************************************************
- ;*
- ;* FUNCTION NAME = VVID_IDC
- ;*
- ;* DESCRIPTION = IDC Interface to VVID. This function is
- ;* registered at INIT time by calling DevHlp_RegisterPDD.
- ;* It is using a stack parameter interface and it is used
- ;* only to open and obtain the register entry point bank
- ;* IDC interface function VVID_BANK_REGISTER_ENTRY, which is
- ;* much faster/
- ;* Parameters:
- ;* [sp+8] = ulFunc DD 0 for open, 1 for obtain register entry point
- ;* [sp+12] = ul1 DD 16:16 Pointer to input structure:
- ;* [sp+16] = ul2 DD 16:16 Pointer to output structure: 16:16
- ;* area for the register entry point address to be returned.
- ;* This function depends on parameter pointers
- ;* being in the sel:offset format. VVID must convert its linear pointers
- ;* prior to calling this entry point.
- ;*
- ;* INPUT = see Parameters above.
- ;* OUTPUT = NONE
- ;*
- ;* RETURN-NORMAL = 1 as success
- ;* RETURN-ERROR = 0 as failure.
- ;*
- ;****************************************************************************/
-
- VVID_IDC PROC FAR
- push bp
- mov bp,sp
- push ds
- push es
- push bx
- push di
- push si
- mov ax, BioData
- mov ds, ax
- ASSUME DS:BioData
-
- mov cx, word ptr [ulFunc] ; higher word ignored
- .if <cx e IDC_CMD_REGISTER_STACK_PROC>
- mov ax, IDC_SUCCESS
- .else
- .if <cx e IDC_CMD_REGISTER_EPREGISTER>
- mov es,[ulParam1]._SEG ; get pointer 1 selector
- mov di,[ulParam1]._OFF ; get pointer 1 offset
- mov es:[di].fp_sel,cs ; set the far pointer selector
- mov es:[di].fp_offhi,0 ; set the far pointer high offset
- lea ax,cs:VVID_BANK_REGISTER_ENTRY ; get the far pointer low offset
- mov es:[di].fp_offlo,ax ; set the far pointer low offset
- mov ax, IDC_SUCCESS
- .else
- xor ax, ax
- .endif
- .endif
- pop si
- pop di
- pop bx
- pop es
- pop ds
-
- mov sp, bp
- pop bp
- ; RETURN (32 bit)
- db 66h
- ret 12
- VVID_IDC ENDP
-
- ;/****************************************************************************
- ;*
- ;* FUNCTION NAME = VVID_BANK_REGISTER_ENTRY
- ;*
- ;* DESCRIPTION = Register based IDC Interface to VVID. This function
- ;* called with parameters passed thru the stack:
- ;* BX = Function
- ;* SCREENDD_GETCURRENTBANK (0h),
- ;* SCREENDD_SETCURRENTBANK (1h)
- ;* For SetBank it calls appropriate routine with args:
- ;* CX Bank, DX Direction and DI video mode
- ;* For GetBank it calls appropriate routine with args:
- ;* DX Direction and DI video mode.
- ;* Bank returned in AX.
- ;* INPUT = see Parameters above.
- ;* OUTPUT = NONE
- ;*
- ;* LINKAGE: Far 16:32
- ;*
- ;* RETURN-NORMAL = See above
- ;* RETURN-ERROR =
- ;*
- ;****************************************************************************/
- VVID_BANK_REGISTER_ENTRY PROC FAR
- push ds
- push es
- mov ax, BioData
- mov ds, ax
- ASSUME DS:BioData
- mov ax, [_sSVGA.AdapterType] ; /* */
- .if <bx e SCREENDD_SETCURRENTBANK>
- mov si,offset SVGA_SET_BANK_TABLE ;
- .else
- .if <bx e SCREENDD_GETCURRENTBANK>
- mov si,offset SVGA_GET_BANK_TABLE ;
- .else ; unsupported function.
- pop es
- pop ds
- ret
- .endif
- .endif
- ; cbw ;Make adapter type a word/* */
- shl ax,1 ;Make adapter type a table offset
- add si,ax ;SI = get bank table offset
- call [si] ;go do request
- pop es
- pop ds
- ret
- VVID_BANK_REGISTER_ENTRY ENDP
- ;
- ; The following label defines the end of the Screen resident code.
- ;
- DEVICE_END LABEL BYTE
-
- BiosSeg ends ; /* */
-
- BiosSeg SEGMENT WORD Public 'CODE' USE16; /* */
- ASSUME CS:BiosSeg ; /* */
- ASSUME DS:BioData ; /* */
-
- EXTRN SVGAPhysToVirt : NEAR ; /* */
- EXTRN SVGAUnPhysToVirt : NEAR ; /* */
- EXTRN SVGAPhysToUVirt : NEAR ; /* */
- EXTRN SVGAUnPhysToUVirt : NEAR ; /* */
- EXTRN FindString : NEAR ; /* */
- EXTRN FindStringExpansion : NEAR ; /* */
- EXTRN GetCrtcBase : NEAR ; /* */
-
- EXTRN _IdentifySVGA : FAR ; /* */
-
- ;* /* */
- ;* Moved Process OEM to initialization section /* */
- ;* /* */
-
- IFDEF FAMILY2
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: QueryMCSlot
- ;
- ; DESCRIPTIVE NAME: If an adapter with a matching MC-ID found,
- ; return the slot.
- ;
- ; FUNCTION: Return adapter MC slot number in AX.
- ;
- ; ENTRY POINT: QueryMCSlot
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; AX = MC ID
- ;
- ;* RETURN-NORMAL = ZR if found.
- ;* RETURN-ERROR = NZ if not found.
- ;
- ; EFFECTS:
- ; AX
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; ProcessMC_OEM
- ;
- ; OUTPUT: AX = Adapter's slot number
- ;
-
- QueryMCSlot PROC Near
-
- push di ;
- mov di, ax ; ID we are searching for
- in al, 96h ; Read card slot setting
- mov bl, al ; Save current card slot setting
- mov cx, 08h ; Start with card slot 0 (bit 0-3)
- .repeat ; Search up to 8 card slots
- mov al, cl ;
- out 96h, al ; Put card slot into setup mode
- mov dx, 100h
- in ax, dx ; Get POS ID from slot (IOdelay)
- in ax, dx ; Get POS ID from slot
- cmp ax, di ; found
- .if <z> ;
- mov ax, cx ; Set SLOT number
- .else
- sub ax, ax ; not found
- .endif ;
- .until <nonzero ax> or ; found
- inc cx ; Next slot
- .until <cx a 0Fh> ; Search all 8 slots?
- mov cx, ax
- and ax, 7h ; set the result slot to 0-7
- push ax
- cmp cx, 0 ; set the result: z if not found, nz found.
- mov al, bl ;
- out 96h, al ; Restore card slot setting
- pop ax
- pop di
- ret
-
- QueryMCSlot ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: ProcessMC_OEM
- ;
- ; DESCRIPTIVE NAME: Identify MC SVGA manufacturer.
- ;
- ; FUNCTION: Return manufacturer info in DATA packet.
- ;
- ; ENTRY POINT: ProcessMC_OEM
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; DS = BIODATA
- ; OUTPUT: NONE
- ;
- ; EXIT-NORMAL: NONE
- ; EXIT-ERROR: NONE
- ;
- ; EFFECTS:
- ; NONE
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; INIT
- ;
- ; OUTPUT: Is in adapter specific format. For example:
- ; Orchid Pro MC: returns slot in Manufacturer Data.
- ;
-
- ProcessMC_OEM PROC Near
-
- pusha ; /* */
- ; ;if not ET4000, exit without
- .if <[_sSVGA.AdapterType] e TSENG_ADAPTER> ;3 /* */
- ; push es ; /* */
- ; push si ;Preserve target addr /* */
- mov ax, ORCHID_MC_ID ; load MC id for Orchid
- call QueryMCSlot ; if z failed, nz AX contains the slot
- ; pop si ; /* */
- ; pop es ; /* */
- .if <nz> /*@V2.1MNH13*/
- mov word ptr [SvgaOEMInfo.OEMLength], dword*2
- mov [SvgaOEMInfo.Manufacturer], ORCHID_MC_ADAPTER
- mov word ptr [SvgaOEMInfo.ManufacturerData], AX
- .endif
- .endif
- ExitMC_OEM:
- popa ; /* */
- ret
- ProcessMC_OEM ENDP
-
- ELSE ;/* Not FAMILY2 */ /* */
-
- IsItaNumber PROC Near
-
- xor ax, ax
- mov al, byte ptr ds:[si]
- cmp al,'9'
- jg NotaNumber
- sub al, '0' ; /* */
- jl NotaNumber
- cmp ax, ax ;Always zero! /* */
- ret
- NotaNumber:
- and si, si ;Should never be zero! /* */
- ret
-
- IsItaNumber ENDP
-
- FindNumber PROC Near
-
- SearchForNumber:
- .repeat ; /* */
- call IsItANumber
- .leave < z > ;Exit if number found. /* */
- inc si ;Pass the character /* */
- dec dx ;Decrement count left /* */
- .until < z > ;Exit when no more /* */
- ExitFound:
- mov bx, ax ;Use first digit as value.
- ret
-
- FindNumber ENDP
-
- CollectNumber PROC Near
-
- .repeat ; /* */
- inc si ;Pass the character /* */
- dec dx ;Decrement count left /* */
- .leave < z > ;Don't overdo the search/* */
- call IsItaNumber ;z if a number, ax value/* */
- .leave < nz > /*@V2.1MNH13*/
- AddNumberAndSearchLoop: ;If a number keep collecting
- imul bx, 10
- add bx, ax
- .until ;Continue collecting /* */
- ret
-
- CollectNumber ENDP
-
- ;
- ;*** GetBiosRev
- ;
- ; Entry: AX = ROM address (high)
- ; BX = ROM address (low)
- ; CX = length of the area to search
- ;
- ; Look for Vers. string at BIOS location.
- ; Return major and minor.
- ;
- ; NOTE: This routine makes very few assumptions about the
- ; BIOS signature format. The assumption is that the BIOS
- ; revision must have at least 1 digit major, followed by a period
- ; and at least 1 digit in the minor. If the major and minor are out-
- ; side of the expected range, the caller can call us again with the ROM
- ; address in AX which is original plus the returned CX and we will
- ; search for another string of this format.
- ; There are no delimiters assumed, and the routine
- ; keeps the search within the bounds of what was converted into virtual.
- ; Returns NZ if the above format not found or
- ; AX= major, BX= minor, CX=how far into the area did we search.
- ;
- GetBiosRev PROC Near
- push es ;
- push si ; /* */
- push dx ; used as a counter
- push ds ; /* */
- push cx ; save our original length
- push ds ;
- pop es ;
- call SVGAPhysToVirt ; will load DS:SI with BIOS address
- mov dx, cx ; load length of the string
- FindBIOS:
- .repeat
- .repeat
- call FindNumber ;bx contains value /* */
- SearchLoop:
- .leave <zero dx> ;Don't overdo the search/* */
- call CollectNumber ;Get full value in bx /* */
- .leave < z > ;Don't overdo the search/* */
- .until <<byte ptr ds:[si]> e PERIOD> ;Period now? /* */
- .leave <zero dx> ;Don't overdo the search/* */
- inc si ;Pass the PERIOD /* */
- dec dx ;Decrement count left /* */
- .leave < z > ;Don't overdo the search/* */
- FoundMajor: ; have a major in bx
- mov di, bx ; preserve the major
- xor bx, bx
- call IsItaNumber ; /* */
- .until < z > ;Until minor found! /* */
- .if <nonzero dx> ;If format found: /* */
- CollectMinor:
- call CollectNumber ;Get full value in bx /* */
- Processed: ; di has major, bx minor.
- mov ax, di ; set the major
- cmp ax, ax ;Always zero! /* */
- .else ;Format not OK: /* */
- RevNotFound:
- or ax, 0ffffh ;Set major to non-zero! /* */
- mov bx, ax ;Set minor to non-zero! /* */
- .endif
- GetBiosRevExit:
- pop cx ; used as a counter
- pop ds
- pushf
- sub cx, dx ; return how far did we get.
- call SVGAUnPhysToVirt
- popf
- pop dx
- pop si ; /* */
- pop es
- ret
-
- GetBiosRev ENDP
-
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: ProcessOEM
- ;
- ; DESCRIPTIVE NAME: Identify SVGA manufacturer.
- ;
- ; FUNCTION: Return manufacturer info in DATA packet.
- ;
- ; ENTRY POINT: ProcessOEM
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; DS = BIODATA
- ; OUTPUT: NONE
- ;
- ; EXIT-NORMAL: NONE
- ; EXIT-ERROR: NONE
- ;
- ; EFFECTS:
- ; NONE
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; INIT
- ;
- ; OUTPUT: Is in adapter specific format. For example:
- ; Diamond Speedstar: returns SvgaOEMPacket structure
- ;
- ProcessOEM PROC Near
-
- pusha ; /* */
- ; push es ; /* */
- ; push si ;Save target addr /* */
- ; mov ax, 0000ch ;BIOS address /* */
- ; ;is it WD? /* */
- .if <[_sSVGA.AdapterType] e WESTERNDIG_ADAPTER> ;4 /* */
- mov di, OFFSET BioData:DiamondWDSig
- mov bx, 02E4h ; this is the offset where we expect it.
- mov cx, 13 ; length of the string
- call FindStringExpansion ; /* */
- mov bx, 02F1h ; this is the offset where we should start looking.
- .endif ; /* */
- .if < nz > ;If not found yet: /* */
- ET4000:
- ; ;if not ET4000, exit /* */
- .if <[_sSVGA.AdapterType] e TSENG_ADAPTER> ;3 /* */
- ; ; ;
- mov di, OFFSET BioData:DiamondETSig
- mov bx, 0A71h ; this is the offset where we expect it.
- mov cx, 12 ; length of the string
- call FindStringExpansion ; /* */
- mov bx, 0A85h ; this is the offset where we should start looking.
- .endif ; /* */
- .endif ; /* */
- .if < nz > ;If not found yet: /* */
- S3: ;
- ; ;if not S3, exit /* */
- .if <[_sSVGA.AdapterType] e S3_ADAPTER> ;8 /* */
- mov di, OFFSET BioData:DiamondS324Sig
- mov bx, 046h ; this is the offset where we expect it.
- mov cx, 0Ah ; length of the string
- call FindStringExpansion ; /* */
- mov bx, 056h ; this is the offset where we should start looking.
- .if < nz > ;If not found yet: /* */
- S3PRO: ;
- mov di, OFFSET BioData:DiamondS3PROSig
- ; mov ax, 0000ch ;BIOS address /* */
- mov bx, 046h ; this is the offset where we expect it.
- mov cx, 0Bh ; length of the string
- call FindStringExpansion ; /* */
- mov bx, 058h ; this is the offset where we should start looking.
- .endif ; /* */
- .endif ; /* */
- .endif ; /* */
- .if < z > ;If Diamond card found /* */
- mov cx, DIAMOND_MANUFACTURER ; ;
- DetermineBIOSRev:
- push cx
- mov ax, 0000ch ;BIOS address /* */
- mov cx, 00100h ;Get a lot
- call GetBiosRev ;NZ fails or ax=major, bx=minor
- pop cx
- .if < z > ; /* */
- ; pop si ; /* */
- ; pop es ; /* */
- mov word ptr [SvgaOEMInfo.ManufacturerData][0*word], ax ;/* */
- mov word ptr [SvgaOEMInfo.ManufacturerData][1*word], bx ;/* */
- .endif ; /* */
- .else ;Diamond card not found:/* */
- ; ;if not S3, exit /* */
- .if <[_sSVGA.AdapterType] e S3_ADAPTER> ;8 /* */
- Number9: ; ;
- mov di, OFFSET BioData:Number9S3Sig
- ; mov ax, 0000ch ;BIOS address /* */
- mov bx, 160h ;This is the offset where we expect it.
- mov cx, 02h ;Length of the string
- call FindStringExpansion ; /* */
- mov cx, NUMBER9_MANUFACTURER ; /* */
- .if < nz > ;If not found yet: /* */
- mov di, OFFSET BioData:ArtistS3Sig
- ; mov ax, 0000ch ;BIOS address /* */
- mov bx, 12Ch ;This is the offset where we expect it.
- mov cx, 0dh ;Length of the string
- call FindStringExpansion ; /* */
- mov cx, ARTIST_MANUFACTURER ; /* */
- .endif ; /* */
- .if < nz > ;If not found yet: /* */
- mov di, OFFSET BioData:MIROCRYSTALSig ;/* */
- ; mov ax, 0000ch ;BIOS address /* */
- mov bx, 0e6h ;This is the offset where we expect it.
- mov cx, 0bh ;Length of the string /* */
- call FindStringExpansion ; /* */
- mov cx, MIROCRYSTAL_MANUFACTURER ; /* */
- .endif ; /* */
- .else /*@V3.0YEE01*/
- ; Looking for Thinkpad system @V3.0YEE01
- .if <[_sSVGA.AdapterType] e WESTERNDIG_ADAPTER> ;4
- cli ;don't let system interrupt test
- mov dx, 070h ;query CMOS to see if
- mov al, 07ch ;SMAPI installed.
- out dx, al ;SMAPI unique to Thinkpads
- inc dx ;
- in al, dx ;
- .if <al e 'I'> ;
- dec dx ;
- mov al, 07dh ;
- out dx, al ;
- inc dx ;
- in al, dx ;
- cmp al, 'S' ;Tbird Enhanced or later
- je @F ;
- cmp al, 06h ;Tbird or Flamingo
- jne NotThinkPad ;
- @@: mov cx, THINKPAD_MANUFACTURER ;yep, found one!!
- NotThinkPad:
- .endif ;end Thinkpad search @V3.0YEE01
- sti ;re-enable interrupts @V3.0YEE01
- .endif ;end WD search again /*@V3.0YEE01*/
- .endif ; /* */
- .endif ; /* */
- .if < z > ;If card found: /* */
- ; pop si ; /* */
- ; pop es ; /* */
- mov [SvgaOEMInfo.Manufacturer], cx
- .endif ; /* */
- ; ret ; /* */
- ExitOEM:
- ; pop si ; /* */
- ; pop es ; /* */
- popa ; /* */
- ret
-
- ProcessOEM ENDP
-
- ENDIF ;/* FAMILY2 */ /* */
-
- ; start
- ;--------------------------------------------------------------------------
- ; SUBROUTINE NAME: AttachOEM
- ;
- ; DESCRIPTIVE NAME: Attach to OEMHLP PDD and retrieve ADAPTER TYPE.
- ;
- ; FUNCTION: Call OEMHLP IOCTL 7 to obtain Adapter type.
- ;
- ; ENTRY POINT: AttachOEM
- ; LINKAGE: Call Near
- ;
- ; INPUT:
- ; ES:BX = request packet address
- ; DS = BIODATA
- ;
- ; EXIT-NORMAL:
- ; VOID function.
- ;
- ; EXIT-ERROR:
- ; VOID function.
- ;
- ; EFFECTS:
- ; All preserved.
- ;
- ; USES ROUTINES:
- ;
- ; CALLED BY ROUTINES:
- ; INIT
- ;
- AttachOEM PROC NEAR
- push es
- push bx
- ;
- ; Attach to OEMHLP and obtain the entry point into its IDC which
- ; represent the strategy routine entry point as well.
- ;
- mov bx, offset OemName
- mov di, offset OemDDEntry
- mov dl, DevHlp_AttachDD
- call DevHelp
- jc AttachExit
- ; Build a request packet suitable for function 7, category 80
- mov OemDDRequest.PktLen, 25
- mov OemDDRequest.PktCmd, CMDGenIOCtl
- mov OemDDRequest.PktUnit, 0
- mov OemDDRequest.PktStatus, 0
- mov OemDDRequest.PktFlag, 0
- mov OemDDRequest.GIOCategory, 80H
- mov OemDDRequest.GIOFunction, 7
- mov dword ptr OemDDRequest.GIOParaPack, 0
- mov ax, offset ADAPTER_TYPE
- mov word ptr OemDDRequest.GIODataPack, ax
- mov ax, ds
- mov word ptr OemDDRequest.GIODataPack + 2, ax
-
- ; Execute IOCTL which will fill out our local ADAPTER_TYPE.
- ; save our DS, load DS with OEMHLP and load es:bx with Packet
- mov es, ax
- mov bx, offset OemDDRequest ; es:bx request packet.
- push ds
- mov ax, es:OemDDEntry.ProtDS
- mov ds, ax
- call dword ptr es:OemDDEntry.ProtEntry
- pop ds
- xor cx, cx ;index
- mov byte ptr Class_Index, 0 ;@TSU
- ; int 3 ; ========================================
- mov OEMDDEntry.ReqStat, 0
- mov dword ptr pciFindClassP.pfcc_ulClassCode, currentClass ; there are multiple classes that could work
- align 2
- QueryNextPCIConfiguration: ;@senja start
- ; CAll OEMHLP to execute a PCI BIOS find (video) class and read configuration
- ; space. PCI_video structure (8 entries) will contain the Vendor ID and device ID
- ; for upto 8 video devices found.
- mov OemDDRequest.PktLen, 25
- mov OemDDRequest.PktCmd, CMDGenIOCtl
- mov OemDDRequest.PktUnit, 0
- mov OemDDRequest.PktStatus, 0
- mov OemDDRequest.PktFlag, 0
- mov OemDDRequest.GIOCategory, 00H
- mov OemDDRequest.GIOFunction, 0bh ;PCI_FUNC
- mov pciFindClassP.pfcc_bPCIFunc, OEM_PCI_FIND_CLASS_CODE
-
- ; mov pciFindClassP.pfcc_bIndex, cl ; current index
- mov al, Class_Index ; @TSU
- mov pciFindClassP.pfcc_bIndex, al ; current index @TSU
- inc al ; @TSU
- mov byte ptr Class_Index, al ; @TSU
- mov word ptr OemDDRequest.GIOParaPack, offset pciFindClassP
- mov ax, ds
- mov word ptr OemDDRequest.GIOParaPack + 2, ax
- mov ax, ds
- ; setup the data packet
- mov word ptr OemDDRequest.GIODataPack, offset pciFindClassD
- mov word ptr OemDDRequest.GIODataPack + 2, ax
- ; Execute IOCTL which will fill out our local pciFindClassD.
- ; save our DS, load DS with OEMHLP and load es:bx with Packet
- mov es, ax
- mov bx, offset OemDDRequest ; es:bx request packet.
- push cx
- push ds
- mov ax, es:OemDDEntry.ProtDS
- mov ds, ax
- call dword ptr es:OemDDEntry.ProtEntry
- pop ds
- pop cx
- ; if the IOCTL returned success and a device of our class was found
- ; issue ReadConfiguration call to obtain the vendor ID
- cmp OEMDDEntry.ReqStat, 0
- jnz AttachExit
- ; cmp pciFindClassD.pfcc_bReturn, PCI_SUCCESSFUL
- test ax, 08000h ; bit 15 is the generic error
- ; bit for IOCTL calls @TSU
- jz short @F ; found the class, get the info
- ; failed to find a device of current class
- cmp dword ptr pciFindClassP.pfcc_ulClassCode, lastClass ;
- jz AttachExit ; failed to find any video class.
- cmp dword ptr pciFindClassP.pfcc_ulClassCode, SVGAClass ; see comment on the class list.
- jz TryXGAClass ;@TSU
- ; jz TryLastClass ;@TSU
- cmp dword ptr pciFindClassP.pfcc_ulClassCode, XGAClass ;@TSU ; see comment on the class list.
- jz TryLastClass ;@TSU
- cmp dword ptr pciFindClassP.pfcc_ulClassCode, VGAClass ;
- jz TrySVGAClass ;
- mov dword ptr pciFindClassP.pfcc_ulClassCode, VGAClass ;
- mov byte ptr Class_Index, 0 ;
- jmp QueryNextPCIConfiguration ;
- TrySVGAClass: ;
- mov dword ptr pciFindClassP.pfcc_ulClassCode, SVGAClass
- mov byte ptr Class_Index, 0 ;@TSU
- jmp QueryNextPCIConfiguration
- TryXGAClass: ;@TSU
- mov dword ptr pciFindClassP.pfcc_ulClassCode, XGAClass ;@TSU
- mov byte ptr Class_Index, 0 ;@TSU
- jmp QueryNextPCIConfiguration ;@TSU
- TryLastClass:
- mov dword ptr pciFindClassP.pfcc_ulClassCode, lastClass
- mov byte ptr Class_Index, 0 ;@TSU
- jmp QueryNextPCIConfiguration
- @@:
- ;
- ; Setup the request packet to issue the read configuration caal
- ;
- mov OEMDDEntry.ReqStat, 0
- mov byte ptr PciReadConfigP.prc_bPCIFunc, OEM_PCI_READ_CONFIG
- mov al, byte ptr pciFindClassD.pfcc_bDevFunc
- mov ah, byte ptr pciFindClassD.pfcc_bBusNum
- mov byte ptr PciReadConfigP.prc_bDevFunc,al
- mov byte ptr PciReadConfigP.prc_bBusNum, ah
- mov byte ptr PciReadConfigP.prc_bConfigReg, 0 ;get Vendor ID and Device ID
- mov byte ptr PciReadConfigP.prc_bSize, 4
- ; for future:
- ; perform another IOCTl to get configuration data from byte offset 4,
- ; 2 bytes to read the command register. If bits 0,1 are non0, the
- ; device has been enabled.If multiple devices enabled, get base
- ; addresses for io and memory ports as well.
- ; Also, get subsystem ID which identifies the adapter maker.
- mov word ptr OemDDRequest.GIOParaPack, offset pciReadConfigP
- mov ax, ds
- mov word ptr OemDDRequest.GIOParaPack + 2, ax
- mov ax, ds
- ; setup the data packet
- mov word ptr OemDDRequest.GIODataPack, offset pciReadConfigD
- mov word ptr OemDDRequest.GIODataPack + 2, ax
- mov OEMDDEntry.ReqStat, 0
- ; Execute IOCTL which will fill out our local pciReadConfigD.
- ; save our DS, load DS with OEMHLP and load es:bx with Packet
- mov es, ax
- mov bx, offset OemDDRequest ; es:bx request packet.
- push cx
- push ds
- mov ax, es:OemDDEntry.ProtDS
- mov ds, ax
- call dword ptr es:OemDDEntry.ProtEntry
- pop ds
- pop cx
- ; if the IOCTL returned success and a PCI function returned success
- ; stash the ID.
- ; keep going until the FindClass function fails
- cmp OEMDDEntry.ReqStat, 0
- jnz @F
- cmp pciReadConfigD.prc_bReturn, PCI_SUCCESSFUL
- jnz @F
- mov si, offset PCI_DeviceTbl ;ulong hw: Vendor ID, lw Device ID
- mov ax, cx
- shl ax, 2
- add si, ax
- mov ax, word ptr pciReadConfigD.prc_ulData
- mov word ptr ds:[si], ax; stash the value
- mov ax, word ptr pciReadConfigD.prc_ulData[2]
- mov word ptr ds:[si+2], ax; stash the value
- ;
- ;
- ;
- ; Setup the request packet to issue the read configuration to
- ; read command register and status register
- ;
- mov OEMDDEntry.ReqStat, 0
- mov byte ptr PciReadConfigP.prc_bPCIFunc, OEM_PCI_READ_CONFIG
- mov al, byte ptr pciFindClassD.pfcc_bDevFunc
- mov ah, byte ptr pciFindClassD.pfcc_bBusNum
- mov byte ptr PciReadConfigP.prc_bDevFunc,al
- mov byte ptr PciReadConfigP.prc_bBusNum, ah
- mov byte ptr PciReadConfigP.prc_bConfigReg, 4 ; get command register and status register
- mov byte ptr PciReadConfigP.prc_bSize, 4
- mov word ptr OemDDRequest.GIOParaPack, offset pciReadConfigP
- mov ax, ds
- mov word ptr OemDDRequest.GIOParaPack + 2, ax
- mov ax, ds
- ; setup the data packet
- mov word ptr OemDDRequest.GIODataPack, offset pciReadConfigD
- mov word ptr OemDDRequest.GIODataPack + 2, ax
- mov OEMDDEntry.ReqStat, 0
- ; Execute IOCTL which will fill out our local pciReadConfigD.
- ; save our DS, load DS with OEMHLP and load es:bx with Packet
- mov es, ax
- mov bx, offset OemDDRequest ; es:bx request packet.
- push cx
- push ds
- mov ax, es:OemDDEntry.ProtDS
- mov ds, ax
- call dword ptr es:OemDDEntry.ProtEntry
- pop ds
- pop cx
- ; if the IOCTL returned success and a PCI function returned success
- ; stash the ID.
- ; keep going until the FindClass function fails
- cmp OEMDDEntry.ReqStat, 0
- jnz @F
- cmp pciReadConfigD.prc_bReturn, PCI_SUCCESSFUL
- jnz @F
- ; Test command register
- mov ax, word ptr pciReadConfigD.prc_ulData
- and ax, 03h ; I/O access and memory access enabled
- jz @F ;this video is disabled
- inc cx ; this video is enabled, add it to PCI_DeviceTbl
- @@:
- cmp cx, 8
- jae AttachExit
- jmp QueryNextPCIConfiguration
- AttachExit: ;//@senja end
- mov word ptr PCI_Num, cx ;remeber how many PCI devices were found.
- pop bx
- pop es
- ret
- AttachOEM ENDP
- ; end
-
- ;*****************************************************************************
-
- ;** INIT - Device Driver Initialization routine
- ;
- ; ENTRY
- ; ES:BX = Request Packet
- ; DS = ?
- ; EXIT
- ; Terminating Code Address Set
- ; Terminating Data Address Set
- ; BIOS palette save area initialized ;@@2
- ; Status = OK
- ; DevHelp Address Saved
- ;
-
- PUBLIC Init
- Init PROC NEAR
-
- ; Save DevHelp Function Router Address
-
- mov ax,word ptr ES:[bx.InitpEnd]
- mov word ptr DevHelp,ax
- mov ax,word ptr ES:[bx.InitpEnd+2]
- mov word ptr DevHelp+2,ax
-
- ;
- ; Attach to OEMHLP to determine adapter type
- ;
- call AttachOEM ;
- ;
- ; Determine Super VGA adapter type
- ;
- test [ADAPTER_TYPE], EGA_BIT ; /* */
- jnz @F ; /* */
- call _IdentifySVGA ; /* */
- @@: ; /* */
-
- IFDEF FAMILY2 ; /* */
- call ProcessMC_OEM ;
- ELSE
- call ProcessOEM
- ENDIF ; /* */
-
- push es
- ;
- ; Register with VDM manager for communication with VVID.
- ;
- mov ax, SEG ScreenDDName
- mov ds, ax
- ASSUME DS:BioData
- lea si, ScreenDDName
- mov di, cs
- mov es, di ; DS:SI = Pointer to name of PDD
- lea di, VVID_IDC ; ES:DI = Pointer to IDC
- mov dl,DevHlp_RegisterPDD
- call DevHelp ; if the function fails, system halp occures.
- pop es
- mov word ptr es:[bx.InitpEnd],offset DEVICE_END-1 ;@@4
- mov word ptr es:[bx.InitpEnd+2],offset DATA_END-1 ;@@4
- IFDEF FAMILY2
- mov al,3 ; Video Device Id ???
- mov bl,0 ; First available LID
- mov dh,0 ; Device State = 0 (Reserved)
- mov dl,DevHlp_GetLIDEntry
- Call DevHelp
- sti
- .if nc
- mov LID,ax ; Save the LID number
- .endif
- ENDIF
- sub ax,ax ; DCR0226
- ret
- Init ENDP
-
- BiosSeg ends
-
- end
- ; 12/28/92 Senja SVGA support. File created.
- ; 01/20/93 Senja Enhanced WD detection.
- ; 01/21/93 Senja XGA doesn't boot because Aperture Index gets trashed.
- ; 02/10/93 Senja Manufacturer info IOCTL.
- ; 02/18/93 Senja UpdateMemoryInfo IOCTL.
- ; 03/05/93 Senja Do not identify XGA as Speedway.
- ; 03/10/93 Senja Identification of MC Orchid.
- ; 03/12/93 Senja Changed BANK packet interface to be more consistent.
- ; 03/16/93 Senja Making SCREENDD more consistent.
- ; 03/23/93 Senja Fixing bank packet validation.
- ; 04/03/93 Senja Attach to OEMHLP.
- ; 04/14/92 Senja If XGA detected, do not proceed with the detection.
- ; 05/02/93 Improve Speedway checks, defect 68723.
- ; 06/03/93 Lock the extended sequencer before exit, defect 69461
- ; 06/03/93 ACER M3125 SVGA fix, defect 63910
- ; 06/04/93 F69306 Add support for S3
- ; 08/12/93 72760 Enhance S3 chip detection
- ; 08/30/93 73465 Only need 1 manufacturer value for Diamond
- ; 08/31/93 Recognize Cirrus Logic GD5428 chip
- ; 10/06/93 72687 Support Number Nine adapters with S3
- ; 10/13/93 74175 Fix SVGA conflict on Gateway VLB
- ; 11/01/93 D75458 Merge r206v, r205, r206, r207 S3 code
- ; 12/15/93 76685 Recognize Winsprint adapter by Artist Graphics
- ; 03/01/94 D79562 Recognize additional WD chipsets
- ; 03/15/94 D80921 Fix WD DOS started in background
- ; 05/13/94 F74819 ATI Mach8/32 check in files
- ; 09/21/94 D99280 PCI detection conflict
- ;---NOT RELEASED:---
- ; 02/22/94 PMIRing0 communication interface.
- ; 09/12/94 97689 Recognize miroCRYSTAL adapter
- ;@V3.0YEE01 02/24/95 113003 Recognize Thinkpad systems
-