762 lines
21 KiB
Plaintext
762 lines
21 KiB
Plaintext
UNIT NWintr;
|
|
|
|
{ DPMI Protected mode calls: Hubert Plattfaut of 2:2447/203.4
|
|
Windows Protected Mode calls:
|
|
-Based on EZDPMI by Julian M. Bucknall [1993: 100116.1572@Compuserve.Com]
|
|
-Based on the NetCalls and WinDPMI units by Siebrand Dijkstra [1995: 2:512/250.595]
|
|
-Corrections by Berend de Boer [1995: berend@beard.nest.nl or 2:281/527.23]
|
|
|
|
NwTP Version 0.6, 950301, Copyright 1993,1995 R. Spronk
|
|
}
|
|
|
|
INTERFACE
|
|
|
|
{$B-,F+,O-,R-,S-,X+}
|
|
|
|
{$DEFINE ProtMode}
|
|
{$IFDEF MSDOS}
|
|
{$DEFINE RealMode}
|
|
{$UNDEF ProtMode}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
{$IFDEF RealMode} Dos
|
|
{$ENDIF}
|
|
{$IFDEF DPMI} Dos,WinApi { we need the GlobalDosAlloc-Function}
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS} WinTypes,WinProcs
|
|
{$ENDIF};
|
|
|
|
CONST VLM_ID_UNKNOWN = $0000; { non-VLM application }
|
|
VLM_ID_VLM = $0001;
|
|
VLM_ID_CONN = $0010;
|
|
VLM_ID_TRAN = $0020;
|
|
VLM_ID_IPX = $0021;
|
|
VLM_ID_TCP = $0022;
|
|
VLM_ID_NWP = $0030;
|
|
VLM_ID_BIND = $0031;
|
|
VLM_ID_NDS = $0032;
|
|
VLM_ID_PNW = $0033;
|
|
VLM_ID_RSA = $0034;
|
|
VLM_ID_REDIR = $0040;
|
|
VLM_ID_FIO = $0041;
|
|
VLM_ID_PRINT = $0042;
|
|
VLM_ID_GENR = $0043;
|
|
VLM_ID_NETX = $0050;
|
|
VLM_ID_AUTO = $0060;
|
|
VLM_ID_SECURITY = $0061;
|
|
VLM_ID_NMR = $0100;
|
|
VLM_ID_DRVPRN = $09F2;
|
|
VLM_ID_SAA = $09F5; { SAA Client API for NetWare }
|
|
VLM_ID_IPXMIB = $09F6;
|
|
VLM_ID_PNWMIB = $09F7;
|
|
VLM_ID_PNTRAP = $09F8;
|
|
VLM_ID_MIB2PROT = $09F9;
|
|
VLM_ID_MIB2IF = $09FA;
|
|
VLM_ID_NVT = $09FB;
|
|
VLM_ID_TRAP = $09FC;
|
|
VLM_ID_REG = $09FD;
|
|
VLM_ID_ASN1 = $09FE;
|
|
VLM_ID_SNMP = $09FF;
|
|
|
|
Type
|
|
{$ifdef ProtMode}
|
|
|
|
TTregisters= Record {This is the data-structure for the}
|
|
Case Byte Of {real-mode-interrupts in DPMI-mode}
|
|
0: {32 bit registers}
|
|
(EDI,ESI,EBP,Reserved,EBX,EDX,
|
|
ECX,EAX:LongInt);
|
|
1: {16 bit registers}
|
|
(DI,DIHigh,SI,SIHigh,
|
|
BP,BPHigh,ReservedLow,ReservedHigh,
|
|
BX,BXHigh,DX,DXHigh,
|
|
CX,CXHigh,AX,AXHigh,
|
|
Flags,ES,DS,FS,GS,IP,
|
|
CS,SP,SS:Word);
|
|
2: {8 bit registers}
|
|
(DILowLow,DILowHigh,DIHighLow,DIHighHigh,
|
|
SILowLow,SILowHigh,SIHighLow,SIHighHigh,
|
|
BPLowLow,BPLowHigh,BPHighLow,BPHighHigh,
|
|
ReservedLowLow,ReservedLowHigh,ReservedHighLow,ReservedHighHigh,
|
|
BL,BH,BXHighLow,BXHighHigh,
|
|
DL,DH,DXHighLow,DXHighHigh,
|
|
CL,CH,CXHighLow,CXHighHigh,
|
|
AL,AH,AXHighLow,AXHighHigh:Byte)
|
|
End;
|
|
|
|
{$else} {RealMode}
|
|
|
|
TTregisters= Record
|
|
case Integer of
|
|
0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
|
|
1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
|
|
end;
|
|
{$endif}
|
|
|
|
TPtrRec=record Ofs,Seg:word end;
|
|
|
|
TintrBuffer=array[1..576] of byte;
|
|
TPintrBuffer=^TintrBuffer;
|
|
|
|
TVLMheader=record
|
|
unknown1 :array[1..4] of byte;
|
|
ptr1ofs,ptr1seg, { pointers to 'procedures' }
|
|
ptr2ofs,ptr2seg,
|
|
ptr3ofs,ptr3seg,
|
|
ptr4ofs,ptr4seg :word;
|
|
unknown2 :array[1..4] of byte; { 00 00 00 00 }
|
|
HeaderLen :byte; { 1.11-> 4E; 1.20-> 4E}
|
|
MultiplexIDstring :array[1..3] of char; { 56 4C 4D 'VLM' }
|
|
unknown3 :array[1..4] of byte; { 01 00 80 00 }
|
|
|
|
TransientSwitchCount :word;
|
|
CallCount :word;
|
|
ControlBlockOfs :word; { in same segment as this header }
|
|
CurrentVLMID :word;
|
|
MemoryType :byte; { 04 = XMS }
|
|
ModulesLoaded :byte;
|
|
BlockId :word;
|
|
TransientBlock :word;
|
|
GlobalSegment :word;
|
|
AsyncQueue :array[1..3] of record { head, tail, s }
|
|
pqofs,pqseg:word;
|
|
end;
|
|
BusyQueue :array[1..3] of record { head, tail, s }
|
|
pqofs,pqseg:word;
|
|
end;
|
|
ReEntranceLevel :word;
|
|
FullMapCount :word;
|
|
unknown5 :word; { 00 00 }
|
|
end;
|
|
|
|
TVLMcontrolBlockEntry=record
|
|
Flag :word;
|
|
ID :word;
|
|
Func :word;
|
|
Maps :word;
|
|
TimesCalled :word;
|
|
unknown1 :word; { SSeg ? }
|
|
TransientSeg,GlobalSeg :word;
|
|
AddressLow,AddressHi :word;
|
|
TsegSize,GSegSize,SSegSize:word; { in 16 byte paragraphs }
|
|
VLMname :array[1..9] of char;
|
|
{ null terminated string }
|
|
end;
|
|
|
|
Var GlobalReqBuf,GlobalReplyBuf:TPintrBuffer;
|
|
|
|
{ real-mode only, DPMI: all flags are set to false }
|
|
VLM_EXE_loaded :Boolean;
|
|
NETX_VLM_loaded:Boolean; { if true, then VLM_EXE_loaded must also be true. }
|
|
NETX_EXE_loaded:Boolean;
|
|
|
|
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
|
|
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
|
|
Procedure nwMsDos(VAR R:ttregisters);
|
|
Function InRealMode:Boolean;
|
|
|
|
Function MapRealmodeSegment(RSeg:Word):Word;
|
|
Function nwPtr(s,o:word):Pointer;
|
|
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
|
|
|
|
{$IFDEF RealMode}
|
|
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
|
|
Function GetVLMControlBlock(Entry:Byte;
|
|
Var ControlBlock:TVLMControlBlockEntry):Boolean;
|
|
{ entry: 0 .. VLMheader.ModulesLoaded }
|
|
{$ENDIF}
|
|
|
|
IMPLEMENTATION {===========================================================}
|
|
|
|
Var GlobalRegisters:TTregisters; { all Modes ! }
|
|
|
|
VLMCall:Procedure;
|
|
|
|
{$IFDEF RealMode}
|
|
|
|
Var VLMtransientSeg:word;
|
|
|
|
{ ---------- Real mode procedures ------------------------------------}
|
|
|
|
{$F+}
|
|
|
|
Var RequesterProc:Procedure(Var regs:Registers);
|
|
{ VLMCall:Procedure; }
|
|
|
|
Procedure VlmSystemCall(Var regs:registers); assembler;
|
|
asm
|
|
push ds
|
|
|
|
{ check if VLMCall known. If not, return error $FF in fake AL }
|
|
xor ah,ah
|
|
mov al,$FF
|
|
les di,VLMCall
|
|
mov bx,es
|
|
cmp bx,$0000
|
|
je @1
|
|
{ move fake regs registers to 'real' registers }
|
|
{ AX, CX, DX, DS, SI, DI, ES only. }
|
|
les di,regs
|
|
mov ax,es:[di+16]
|
|
push ax { push new es }
|
|
mov ax,es:[di+12]
|
|
push ax { push new di }
|
|
mov ds,es:[di+14]
|
|
mov ax,es:[di]
|
|
mov cx,es:[di+4]
|
|
mov dx,es:[di+6]
|
|
mov si,es:[di+10]
|
|
pop di
|
|
pop es
|
|
{ farr call to VLM handler }
|
|
push bp
|
|
CALL VLMCall
|
|
pop bp
|
|
@1: { move 'real' registers to fake regs registers }
|
|
|
|
{push es
|
|
push di}
|
|
les di,regs
|
|
mov es:[di],ax
|
|
{mov es:[di+4],cx
|
|
mov es:[di+6],dx
|
|
mov es:[di+10],si
|
|
pop ax ax:= 'di'
|
|
mov es:[di+12],ax
|
|
pop ax ax:= 'es'
|
|
mov es:[di+16],ax }
|
|
|
|
pop ds
|
|
end;
|
|
|
|
Procedure VLMcheck;
|
|
CONST DOS_MULTIPLEX =$2F;
|
|
Var regs:registers;
|
|
ccode:byte;
|
|
Function getBinderyAccessLevel:boolean; { to be replaced by a non-bindery call }
|
|
Type Treq=record
|
|
len :word;
|
|
subF :byte;
|
|
end;
|
|
Trep=record
|
|
accLeveL:byte;
|
|
_objId:longInt;
|
|
fill:array[1..20] of byte;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
Var result:word;
|
|
BEGIN
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subF:=$46;
|
|
len:=sizeOf(Treq)-2;
|
|
end;
|
|
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
|
|
GetBinderyAccessLevel:=(result=0);
|
|
end;
|
|
|
|
Var phdr:^TVLMHeader;
|
|
pVLMcbl:^TVLMcontrolBlockEntry;
|
|
t:word;
|
|
|
|
begin
|
|
VLM_EXE_Loaded:=false;
|
|
Regs.AX:=$7A20;
|
|
Regs.BX:=$0000;
|
|
Regs.CX:=$0000;
|
|
Intr($2F,Regs);
|
|
if regs.AX=$0000
|
|
then begin
|
|
{ OK. AX=0000. All seems well. But is it really the 2F VLM handler? }
|
|
phdr:=ptr(regs.es,$0000);
|
|
VLM_EXE_Loaded:=(phdr^.MultiplexIdString[1]='V')
|
|
and (phdr^.MultiplexIdString[2]='L')
|
|
and (phdr^.MultiplexIdString[3]='M');
|
|
|
|
IF VLM_EXE_Loaded
|
|
then begin
|
|
NETX_EXE_loaded:=False;
|
|
|
|
{ Determine whether netx.vlm is loaded }
|
|
NETX_VLM_Loaded:=False;
|
|
t:=0;
|
|
While t<phdr^.ModulesLoaded
|
|
do begin
|
|
pVLMcbl:=ptr(regs.es,phdr^.ControlBlockOfs+(t*SizeOf(TVLMControlBlockEntry)));
|
|
IF pVLMcbl^.ID=VLM_ID_NETX
|
|
then begin
|
|
t:=$0100; { end of iteration }
|
|
NETX_VLM_Loaded:=True;
|
|
end;
|
|
inc(t);
|
|
end;
|
|
|
|
{ Set requester proc to VLM entry point }
|
|
@VLMcall:=Ptr(Regs.es,Regs.bx);
|
|
VLMtransientSeg:=regs.es;
|
|
|
|
{ @requesterProc:=@VLMsystemCall; ---------- ERR ------}
|
|
@RequesterProc:=@dos.msdos;
|
|
|
|
end
|
|
end;
|
|
if NOT VLM_EXE_Loaded
|
|
then begin
|
|
NETX_VLM_loaded:=false;
|
|
@RequesterProc:=@dos.msdos;
|
|
NETX_EXE_loaded:=GetBinderyAccessLevel;
|
|
end;
|
|
end;
|
|
|
|
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
|
|
begin
|
|
Intr(intNo,registers(regs));
|
|
RealModeIntr:=true;
|
|
end;
|
|
|
|
|
|
|
|
Procedure nwMsDos(VAR R:ttregisters);
|
|
begin
|
|
msDos(registers(R));
|
|
end;
|
|
|
|
|
|
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
|
|
begin
|
|
With GlobalRegisters
|
|
do begin
|
|
CX := Req_size;
|
|
DX := rep_size;
|
|
AH := $f2;
|
|
AL := subf;
|
|
DS := Seg(GlobalReqBuf^); SI := Ofs(GlobalReqBuf^);
|
|
ES := Seg(GlobalReplyBuf^);DI := Ofs(GlobalReplyBuf^);
|
|
MSDOS(registers(GlobalRegisters));
|
|
Result:=al;
|
|
end;
|
|
end;
|
|
|
|
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
|
|
begin
|
|
Sreq := Seg(GlobalReqBuf^);
|
|
Oreq := Ofs(GlobalReqBuf^);
|
|
Srep := Seg(GlobalReplyBuf^);
|
|
Orep := Ofs(GlobalReplyBuf^);
|
|
end;
|
|
|
|
|
|
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
|
|
Var p:^TVLMHeader;
|
|
begin
|
|
if VLMtransientSeg<>$0000
|
|
then begin
|
|
p:=ptr(VLMtransientSeg,$0000);
|
|
move(p^,VLMheader,SizeOf(TVLMHeader));
|
|
end;
|
|
GetVLMHeader:=(VLMtransientSeg<>$0000);
|
|
end;
|
|
|
|
Function GetVLMControlBlock(Entry:Byte;
|
|
Var ControlBlock:TVLMControlBlockEntry):Boolean;
|
|
{ entry: 0 .. VLMheader.ModulesLoaded }
|
|
Var ph:^TVLMHeader;
|
|
pcb:^TVLMControlBlockEntry;
|
|
begin
|
|
if VLMtransientSeg<>$0000
|
|
then begin
|
|
ph:=ptr(VLMtransientSeg,$0000);
|
|
pcb:=ptr(VLMtransientSeg,ph^.ControlBlockOfs+entry*SizeOf(TVLMControlBlockEntry));
|
|
move(pcb^,ControlBlock,SizeOf(TVLMControlBlockEntry));
|
|
end;
|
|
GetVLMControlBlock:=(VLMtransientSeg<>$0000);
|
|
end;
|
|
|
|
Function nwPtr(s,o:word):Pointer;
|
|
begin
|
|
nwPtr:=Ptr(s,o);
|
|
end;
|
|
|
|
Function MapRealmodeSegment(RSeg:Word):Word;
|
|
begin
|
|
MapRealmodeSegment:=RSeg;
|
|
end;
|
|
|
|
{$ENDIF} {------------- end of real-mode procedures -------------------}
|
|
|
|
{$IFDEF ProtMode}
|
|
|
|
Type pRealSegItem=^tRealSegItem;
|
|
tRealSegItem=record {structure to store information}
|
|
Seg:word; {about allocated selectors}
|
|
Sel:Word;
|
|
prev,next:pRealSegItem;
|
|
end;
|
|
{we need to allocate selectors which map real-mode segments.}
|
|
{all these selectors are stored in an dynamic list}
|
|
{and are cleand up them at then end of the program}
|
|
|
|
Var GlobalRealReqSeg,
|
|
GlobalRealReplySeg:Word;
|
|
SelectorList:pRealSegItem;
|
|
|
|
Function RealModeIntr (IntNo:Byte;VAR Regs:ttregisters):Boolean;Assembler;
|
|
{Simulate a call to the spectified real mode interrupt. The registers passed
|
|
to the real mode code are held in RealModeRegisters. This structure contains
|
|
the register content upon termination of the real mode ISR.
|
|
Returns False if there was an error.}
|
|
|
|
ASM
|
|
push di
|
|
push es
|
|
|
|
mov bh,00 {For DOSX to reset the int controller and A20 line. Windows ingores it.}
|
|
mov bl,IntNo {Tell DPMI which interrupt to simulate}
|
|
xor cx,cx {0 bytes to copy to real mode stack}
|
|
les di,Regs {Get the real mode structure}
|
|
mov word ptr es:[di+$c],0 {reserved to 0}
|
|
mov word ptr es:[di+$c+2],0
|
|
mov word ptr es:[di+$26],0 {fs to 0}
|
|
mov word ptr es:[di+$28],0 {gs to 0}
|
|
mov word ptr es:[di+$2e],0 {sp to 0}
|
|
mov word ptr es:[di+$30],0 {ss to 0}
|
|
|
|
mov ax,$0300 {Function 0300h is simulate real mode interrupt}
|
|
int 31h
|
|
|
|
jc @Error {The carry flag was set, so there was an error}
|
|
mov ax,True {Return no error}
|
|
jmp @AllDone
|
|
|
|
@Error:
|
|
mov ax,False {Return false indicating an error}
|
|
|
|
@AllDone:
|
|
pop es
|
|
pop di
|
|
End;
|
|
|
|
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
|
|
begin
|
|
With GlobalRegisters
|
|
do begin
|
|
CX := Req_size;
|
|
DX := rep_size;
|
|
AH := $f2;
|
|
AL := subf;
|
|
DS := GlobalRealReqSeg; {Use then REAL-MODE segments}
|
|
ES := GlobalRealReplySeg; {of the global buffers}
|
|
DI := 0; {OFFSET always 0 for}
|
|
SI := 0; {'GlobalDosAlloc'ated memory}
|
|
if not RealModeIntr($21,GlobalRegisters)
|
|
then RUNERROR(217);
|
|
{DPMI-ERRORS, maybe we should stop the system with the new Errorcode 217}
|
|
Result:=al;
|
|
end;
|
|
end;
|
|
|
|
Procedure nwMsDos(VAR R:ttregisters);
|
|
begin
|
|
if not RealModeIntr($21,R)
|
|
then RUNERROR(217);
|
|
{DPMI-ERRORS, maybe we should stop then system with the new Errorcode 217}
|
|
end;
|
|
|
|
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
|
|
begin
|
|
Sreq := GlobalRealReqSeg; {Use the REAL-MODE segments}
|
|
Srep := GlobalRealReplySeg; {of the global buffers}
|
|
Oreq := 0; {OFFSET always 0 for}
|
|
Orep := 0; {'GlobalDosAlloc'ated memory}
|
|
end;
|
|
|
|
{----- Some low-level functions for DPMI -----------}
|
|
TYPE os = record
|
|
o, s : Word;
|
|
end; {for typecasts}
|
|
LDTStr = record {Structure of LDT-Elements}
|
|
limit : Word;
|
|
base : Word;
|
|
data : Array[0..1] of Word;
|
|
end;
|
|
|
|
Procedure Halt218; {runError 218: low-level DPMI-Errors}
|
|
begin
|
|
RunError(218);
|
|
end;
|
|
|
|
{DMPI-Function 0: Allocate LDT Descriptor}
|
|
function AllocLDTD(var NEWD : Word) : Word; Assembler;
|
|
asm
|
|
xor ax,ax
|
|
mov cx,1 {only 1 descriptor needed}
|
|
int 31h {Call DPMI}
|
|
jnc @@ok
|
|
Call Halt218 {Error on carry}
|
|
@@ok:
|
|
les di,NEWD {save descriptor to VAR NEWD}
|
|
mov es:[di],ax
|
|
xor ax,ax
|
|
end;
|
|
|
|
{DMPI-Function 1: Free LDT Descriptor}
|
|
function FreeLDTD(D : Word) : Word; Assembler;
|
|
asm
|
|
mov ax,0001h
|
|
mov bx,D
|
|
int 31h
|
|
jc @@Ex {carry: return Error in ax}
|
|
xor ax,ax
|
|
@@Ex:
|
|
end;
|
|
|
|
{DMPI-Function 7: Set Segment Base Address}
|
|
function SetSBA(S: Word; BA: LongInt) : Word; Assembler;
|
|
asm
|
|
mov ax,0007h
|
|
mov bx,S
|
|
mov cx,word ptr BA+2
|
|
mov dx,word ptr BA
|
|
int 31h
|
|
jc @@Ex {carry: return Error in ax}
|
|
xor ax,ax
|
|
@@Ex:
|
|
end;
|
|
|
|
{DMPI-Function 8: Set Segment Limit}
|
|
function SetSL(S: Word; L: LongInt) : Word; Assembler;
|
|
asm
|
|
mov ax,0008h
|
|
mov bx,S
|
|
mov dx,word ptr L
|
|
mov cx,word ptr L+2
|
|
int 31h
|
|
jc @@Ex {carry: return Error in ax}
|
|
xor ax,ax
|
|
@@Ex:
|
|
end;
|
|
|
|
{DMPI-Function 9: Set Descriptor Access Rights}
|
|
function SetDAS(S: Word; R: Word) : Word; Assembler;
|
|
asm
|
|
mov ax,0009h
|
|
mov bx,S
|
|
mov cx,R
|
|
int 31h
|
|
jc @@Ex {carry: return Error in ax}
|
|
xor ax,ax
|
|
@@Ex:
|
|
end;
|
|
|
|
{DMPI-Function 11: Get Descriptor}
|
|
function GetD(S: Word; var D : LDTStr) : Word; Assembler;
|
|
asm
|
|
mov ax,000Bh
|
|
mov bx,S
|
|
les di,D
|
|
int 31h
|
|
jc @@Ex {carry: return Error in ax}
|
|
xor ax,ax
|
|
@@Ex:
|
|
end;
|
|
|
|
|
|
{Set then Length of the Descriptor-Segment}
|
|
function SetLimit(Sele: Word; L: LongInt) : Word;
|
|
var St,R: Word;
|
|
Des : LDTStr;
|
|
begin
|
|
St:= GetD(Sele, Des); {get the Descriptor-Entry from LDT}
|
|
if St <> 0
|
|
then begin
|
|
SetLimit:= St; {not in LDT, return Error}
|
|
Exit;
|
|
end;
|
|
with Des
|
|
do R := (Data[0] shr 8) or ((Data[1] and $00F0) shl 8);
|
|
{form then rights for the DPMI-9-Call, register cl}
|
|
if L > $FFFFF
|
|
then begin {> 1MB: Page aligned}
|
|
if L and $FFF <> $FFF
|
|
then begin {Limit=Length-1!}
|
|
SetLimit := $8021; {return Error: not page aligned}
|
|
Exit;
|
|
end;
|
|
R:= R or $8000; {set Page granularity}
|
|
end
|
|
else R:= R and $7FFF; {set Byte granularity}
|
|
St := SetSL(Sele, 0); {fist set limit to 0}
|
|
if St = 0 then St := SetDAS(Sele, R); {ok, set the new rights}
|
|
if St = 0 then St:= SetSL(Sele, L); {ok, set then limit}
|
|
SetLimit := St; {return errorcode}
|
|
end;
|
|
|
|
|
|
{get a Selector for a part of then real-mode memory}
|
|
function RealMemSel(RealP : Pointer; Limit : LongInt; var Sele : Word) : Word;
|
|
function NP(P : Pointer) : LongInt;
|
|
VAR TC:OS absolute P;
|
|
begin
|
|
NP := (LongInt(TC.S) shl 4)+LongInt(TC.O);
|
|
end;
|
|
var St : Word;
|
|
begin
|
|
St := AllocLDTD(Sele); {get a new Selector}
|
|
if St = 0
|
|
then begin
|
|
St := SetSBA(Sele, NP(RealP)); {set base addresse to the linear}
|
|
if St = 0
|
|
then begin {address of the Real-Segment}
|
|
St := SetLimit(Sele, Limit); {set the selector-limit}
|
|
if St <> 0
|
|
then if FreeLDTD(Sele)<>0 then; {on error: free selector}
|
|
end
|
|
else if FreeLDTD(Sele)<>0 then; {on error: free selector}
|
|
end;
|
|
RealMemSel := St; {return errorcode}
|
|
end;
|
|
|
|
{check if the required selector is already allocated}
|
|
Function InSelectorList(S:Word):pRealSegItem;
|
|
VAR li:pRealSegItem;
|
|
begin
|
|
li:=SelectorList;
|
|
while li<>NIL
|
|
do begin
|
|
if li^.Seg=S
|
|
then begin
|
|
InSelectorList:=Li;
|
|
exit;
|
|
end;
|
|
li:=li^.Next;
|
|
end;
|
|
InSelectorList:=NIL;
|
|
end;
|
|
|
|
{insert a new SelectorItem at start of the list}
|
|
Procedure AddToSelectorlist(Segment,Selector:Word);
|
|
VAR li:pRealSegItem;
|
|
begin
|
|
new(li);
|
|
with li^
|
|
do begin
|
|
Seg:=segment;
|
|
Sel:=Selector;
|
|
next:=Selectorlist;
|
|
prev:=NIL;
|
|
end;
|
|
Selectorlist^.prev:=li;
|
|
Selectorlist:=li;
|
|
end;
|
|
|
|
{clean up}
|
|
Procedure FreeSelectorList;
|
|
VAR li:pRealSegItem;
|
|
begin
|
|
while Selectorlist<>NIL
|
|
do begin
|
|
li:=selectorlist;
|
|
selectorlist:=li^.next;
|
|
if li^.sel<>0
|
|
then FreeLDTD(li^.Sel);
|
|
dispose(li);
|
|
end;
|
|
end;
|
|
|
|
Function MapRealmodeSegment(RSeg:Word):Word;
|
|
VAR sel:Word;
|
|
li:pRealSegItem;
|
|
begin
|
|
li:=InSelectorList(RSeg);
|
|
if li=NIL
|
|
then begin
|
|
if RealMemSel(Ptr(RSeg,0),$ffff,Sel)<>0
|
|
then RUNERROR(217); {something's wrong: Errorcode 217}
|
|
MapRealModeSegment:=Sel;
|
|
AddToSelectorList(Rseg,Sel);
|
|
end
|
|
else MapRealModeSegment:=li^.Sel;
|
|
end;
|
|
|
|
|
|
Function nwPtr(s,o:word):Pointer;
|
|
begin
|
|
nwPtr:=Ptr(MapRealModeSegment(s),o);
|
|
end;
|
|
|
|
|
|
{$ENDIF} {----------------- end of protected mode procedures -------------}
|
|
|
|
Var OldExitProc:pointer;
|
|
|
|
Function InRealMode:Boolean;
|
|
begin
|
|
{$IFDEF Windows}
|
|
InRealMode:=(GetWinFlags and wf_PMode)=0;
|
|
{$ELSE}
|
|
{$IFDEF ProtMode}
|
|
InRealMode:=False;
|
|
{$ELSE}
|
|
InRealMode:=True;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{$F+}
|
|
Procedure IntrExit;
|
|
begin
|
|
ExitProc:=OldExitProc;
|
|
{$IFDEF ProtMode}
|
|
if GlobalDosFree(Seg(GlobalReqBuf^))<>0 then; {ignore Errors}
|
|
if GlobalDosFree(Seg(GlobalReplyBuf^))<>0 then;
|
|
FreeSelectorList;
|
|
{$ELSE} {RealMode}
|
|
FreeMem(GlobalReqBuf,SizeOf(TintrBuffer));
|
|
Freemem(GlobalReplyBuf,Sizeof(TintrBuffer));
|
|
{$ENDIF}
|
|
end;
|
|
{$F-}
|
|
|
|
|
|
{$IFDEF ProtMode}
|
|
VAR w1:Longint absolute GlobalRegisters;
|
|
{ we only need w1 during the initialisation, so we use the static
|
|
var GlobalRegisters to save 4 bytes of memory :-) }
|
|
{$ENDIF}
|
|
|
|
begin
|
|
VLM_EXE_Loaded:=false;
|
|
NETX_EXE_loaded:=false;
|
|
NETX_VLM_loaded:=false;
|
|
{$IFDEF ProtMode}
|
|
new(SelectorList);
|
|
fillchar(Selectorlist^,Sizeof(Selectorlist^),0);
|
|
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REQ-Buffer}
|
|
if w1=0
|
|
then runerror(217); {DPMI-ERROR, no free Memory}
|
|
GlobalReqBuf:=Ptr(loWord(w1),0); {buffer-address for protected Mode}
|
|
GlobalRealReqSeg:=hiWord(w1); {REAL-Mode-Segment of the buffer-address}
|
|
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REPLY-Buffer}
|
|
if w1=0
|
|
then runerror(217);
|
|
GlobalReplyBuf:=Ptr(loWord(w1),0);
|
|
GlobalRealReplySeg:=hiWord(w1);
|
|
{$else} {RealMode}
|
|
new(GlobalReqBuf);
|
|
if GlobalReqBuf=NIL
|
|
then RunError(203); {where has all the memory gone?? /Heap-Overflow}
|
|
new(GlobalReplyBuf);
|
|
if GlobalReplyBuf=NIL
|
|
then RunError(203);
|
|
VLMtransientSeg:=$0000;
|
|
VLMcheck;
|
|
{$endif}
|
|
OldExitProc:=ExitProc;
|
|
ExitProc:=@IntrExit;
|
|
end.
|
|
|
|
|