Power-Programmierung/CD1.mdf/pascal/library/dos/ezdpmi/ezdpmi.pas

Pascal/Delphi Source File | 1993-08-10 | 21.7 KB | 638 lines

{==EZDPMI=============================================================

A protected mode DPMI access unit. Provides an easy-to-use interface
to the common application-oriented requirements for DPMI: the ability
to interface real-mode drivers and TSRs from protected mode using DOS
memory.

EZDPMI is Copyright (c) 1993 by  Julian M. Bucknall

VERSION HISTORY
10Aug93 JMB 1.01 fixed GetMappedDPMIPtr
                 (thanx to Garr Updegraff for spotting this bug)
21Mar93 JMB 1.00 initial release
======================================================================}

{=====================================================================

From numerous threads in the BPASCAL forum of CompuServe, I felt that
there was a real need for a simple unit to access the main features of
DPMI that would be required for a middling to difficult application
program. Having played around with DPMI in both Windows and now in the
new protected mode Borland Pascal, I had a bunch of routines under my
belt that I'd used in real programs, and even written about in the
British programming magazine .EXE in November 1992.

My chief consideration in writing these routines was to make things
simple for myself: for example I didn't want to use the DPMI register
structure, I wanted to use the more familiar Registers type (or
TRegisters if you use the WinDOS unit); I wanted to mimic the calling
conventions of the units supplied with Borland Pascal; I wanted an
easy life!

The world of protected mode programming brings many benefits (mainly
the very large heap!), but makes other activities much harder (making
sure you have valid pointers is a good one - the number of times
Run-Time error 216 occurs these days!). One of the main problems with
writing programs in protected mode (Windows or no) is interfacing with
real mode DOS, real mode BIOS and real mode DOS drivers/TSRs. The DPMI
manager translates various calls to these interrupts, and others it
leaves well alone (otherwise it would be at least as large as all of
them put together).

As an aside, when you call some real-mode interrupt via the Intr
procedure various things happen. Firstly you perform a protected mode
interrupt, not a real mode interrupt (the DPMI manager keeps two
tables of interrupt tables, one for real mode and one for protected
mode). If the interrupt gets handled by a protected mode process that
is not the DPMI manager itself then the latter does nothing - the
protected mode process does it all. If the interrupt points into the
DPMI manager itself then it must make a decision: can it handle the
interrupt, or must it pass the interrupt one into real mode? For the
majority of DOS functions for example, the DPMI manager will handle
the interrupt itself (obviously as a program will make many of them
and it would be more efficient that way). If the DPMI manager doesn't
know about the interrupt, it switches the machine into real mode,
calls the real mode interrupt handler, and on return, switches back
into protected mode and returns to your program. There is one other
action that occurs, and that is the DPMI manager ensures that on
return from real mode the segment registers contain valid selector
values.

OK. Now imagine you have a Whizzo-matic Digital Scanner and Coffee
Maker attached to your PC, and that the API for the driver for this
box of tricks states that interrupt $68 subfunction $01 (in AX) will
fill a buffer you supply (address in ES:DI) with its current state.
In a real mode program you'd write something along the lines of

  procedure GetWhizzoState(var State : TWhizzoState);
    var
      R : Registers;
    begin
      R.ax := $01;
      R.es := Seg(State);
      R.di := Ofs(State);
      Intr($68, R);
    end;

No sweat. In protected mode, you have a problem in that the buffer
StateBuffer is going to be in a part of memory unreachable from real
mode, and indeed the value of ES is going to be a selector value not
a segment value. What you'd ideally need is a chunk of memory that
could be addressed from both real mode and protected mode _at the
same time_.

Enter the two complementary functions GetDOSMem and FreeDOSMem. Like
GetMem and FreeMem they allocate and deallocate memory via pointers,
but unlike these two, they make sure that it is in DOS real mode
memory. GetDOSMem allocates Size bytes of DOS memory and returns both
a real mode pointer and a protected mode pointer to that same block
of memory. FreeDOSMem takes the protected mode pointer to some
previously allocated DOS memory, and frees it and the selector to it.
Be aware that in Windows at least the amount of DOS memory is small
and so you shouldn't hang on to it for longer than you need (other
processes are also desirous of some of it).

Our code snippet in protected mode would become:

  procedure GetWhizzoState(var State : TWhizzoState);
    type
      PWhizzoState : ^TWhizzoState;
      PtrRec = record Ofs, Seg : word; end;
    var
      R : TRegisters;
      RealState,                (* Realmode pointer to buffer *)
      ProtState : PWhizzoState; (* ...and Protected mode pointer *)
    begin
      if GetDOSMem(RealState, ProtState, sizeof(TWhizzoState)) then
        begin
          FillChar(R, sizeof(R), 0);
          R.ax := $01;
          R.es := PtrRec(RealState).Seg;
          R.di := PtrRec(RealState).Ofs;
          Intr($68, R);
          Move(ProtState^, State, sizeof(TWhizzoState));
          if not FreeDOSMem(ProtState) then (* nothing *) ;
        end;
    end;

Note that we have to get the Whizzo state into our own buffer first
and then copy that into the program's own buffer. Note also that we
free up the DOS memory immediately. Remember that as the interrupt
expects a real mode buffer we pass the real mode address of our buffer
to the interrupt, but we in our program use the protected mode pointer
to access the memory.

However there is still a bug in this routine. It will cause a GPF
within the Intr procedure because we are passing a real mode segment
value in a protected mode segment (ie selector) register. We need to
_directly_ call the real mode interrupt ourselves, which Intr doesn't
do for us.

Enter the RealIntr procedure. It takes the same parameters as Intr but
calls the real mode interrupt directly. Our routine now becomes:

  procedure GetWhizzoState(var State : TWhizzoState);
    type
      PWhizzoState : ^TWhizzoState;
      PtrRec = record Ofs, Seg : word; end;
    var
      R : TRegisters;
      RealState,                (* Realmode pointer to buffer *)
      ProtState : PWhizzoState; (* ...and Protected mode pointer *)
    begin
      if GetDOSMem(RealState, ProtState, sizeof(TWhizzoState)) then
        begin
          FillChar(R, sizeof(R), 0);
          R.ax := $01;
          R.es := PtrRec(RealState).Seg;
          R.di := PtrRec(RealState).Ofs;
          RealIntr($68, R);
          Move(ProtState^, State, sizeof(TWhizzoState));
          if not FreeDOSMem(ProtState) then (* nothing *) ;
        end;
    end;

Not too bad, huh.

Now suppose instead that the Whizzo-matic driver returned the address
of its state buffer directly in ES:DI (we don't have to provide a
buffer for it at all). Our real mode routine might look like

  procedure GetWhizzoState(var State : TWhizzoState);
    type
      PWhizzoState : ^TWhizzoState;
    var
      R : TRegisters;
      RealState : PWhizzoState;
    begin
      R.ax := $01;
      Intr($68, R);
      RealState := Ptr(R.es, R.di);
      Move(RealState^, State, sizeof(TWhizzoState));
    end;

Our first stab in protected mode would be to replace the Intr call
with a RealIntr call, but the routine would fail later on the Move,
because the interrupt would have returned a real mode address, _not_
a protected mode one. We need a way of mapping a protected mode
pointer onto a given real mode pointer. Recall that the Seg0040
selector defines a protected mode selector to the $0040 BIOS data
segment (and similarly SegB000, SegB800, etc) - we need something
similar.

Enter the GetMappedDPMIPtr function. Given a real mode pointer to a
memory block of Size bytes, it will create a (read/write) protected
mode pointer to that same memory block. The FreeMappedDPMIPtr will
free up the protected mode pointer so created (recall that in
protected mode there are a limited number of selectors - we need to
conserve this resource in our programs). So our better stab in
protected mode would be

  procedure GetWhizzoState(var State : TWhizzoState);
    type
      PWhizzoState : ^TWhizzoState;
    var
      R : TRegisters;
      RealState,                (* Realmode pointer to buffer *)
      ProtState : PWhizzoState; (* ...and Protected mode pointer *)
    begin
      FillChar(R, sizeof(R), 0);
      R.ax := $01;
      RealIntr($68, R);
      RealState := Ptr(R.es, R.di);
      if GetMappedDPMIPtr(ProtState, RealState, sizeof(TWhizzoState)) then
        begin
          Move(ProtState^, State, sizeof(TWhizzoState));
          if not FreeMappedDPMIPtr(ProtState) then (* nothing *) ;
        end;
    end;

The other routines in the EZDPMI unit came out of other
considerations. The RealCall function calls a real mode routine
directly given its address. I needed it for the DOS uppercase function
- recall that interrupt $21 subfunction $38 returns a bunch of
country-specific data (eg how dates are displayed, what the currency
character is and where it appears when used with an amount, and so
on). One of the items returned is the address of a routine that will
uppercase a character in AL (we're talking characters with accents,
umlauts, cedillas here - characters above #127). Well it so happens
that this is a real mode routine, and has to be called in real mode.
RealCall takes the roughly the same parameters as RealIntr (and Intr)
- the first parameter is however the real mode address of a routine -
and calls the routine in real mode.

The example above gets coded as follows:

  var
    DOSUpCaseRoutine : RealProc;

  procedure SetDOSUpCaseRoutine;
    var
      R : TRegisters;
      Buf : array [0..63] of word;
    begin
      FillChar(R, sizeof(R), 0);
      R.ax := $3800;
      R.ds := Seg(Buf);
      R.dx := Ofs(Buf);
      Intr($21, R);
      DOSUpCaseRoutine := Ptr(Buf[10], Buf[9]);
    end;

  function DOSUpperCase(Ch : char) : char;
    var
      R : TRegisters;
    begin
      FillChar(R, sizeof(R), 0);
      R.al := ord(Ch);
      RealCall(DOSUpCaseRoutine, R);
      DOSUpperCase := char(R.al);
    end;

And the Seg0040 value? Well, BPW doesn't define it, and I needed it...

The legal bit now. I am releasing this unit as freeware. In other
words you don't have to pay me for using it in a compiled executable
application program, but I retain all copyright in it and in the
source code within. You cannot distribute the EZDPMI source with source
of your own (as part of a programming library for example) without
including my copyright notice and without paying money to the charity
of my choice for the pleasure of doing so.

Enjoy. If you have any problems, you can get in touch with me via
CompuServe on [100116,1572]. Similarly, if you'd like some extensions
to it get in touch and I'll see what I can do.

                             Julian M. Bucknall, London UK, March 1993


EZDPMI Copyright (c) 1993 Julian M. Bucknall
======================================================================}

unit EzDPMI;

{------Common compiler switches---------------------------------------}
{$A+   Word align variables }
{$B-   Short-circuit boolean expressions }
{$F+   Force Far calls }
{$I-   No I/O checking }
{$N+   Allow coprocessor instructions }
{$P+   Open parameters enabled }
{$Q-   No integer overflow checking }
{$R-   No range checking }
{$S-   No stack checking }
{$T-   @ operator is NOT typed }
{$V-   Disable var string checking }
{$X+   Enable extended syntax }
{$IFDEF DEBUG}
{$D+,L+,Y+  Enable debug information }
{$ENDIF}
{---------------------------------------------------------------------}

{------Real mode compiler switches------------------------------------}
{$IFDEF MSDOS}
{$E+   Enable coprocessor emulation }
{$G-   8086 type instructions }
{$O-   Do NOT allow overlays }
{$DEFINE RealMode}
{$UNDEF  ProtMode}
{$ENDIF}
{---------------------------------------------------------------------}

{------Protected mode compiler switches-------------------------------}
{$IFDEF DPMI}
{$E+   Enable coprocessor emulation }
{$G+   80286+ type instructions }
{$UNDEF  RealMode}
{$DEFINE ProtMode}
{$ENDIF}
{---------------------------------------------------------------------}

{------Windows compiler switches--------------------------------------}
{$IFDEF WINDOWS}
{$G+   80286+ type instructions }
{$K+   Use smart callbacks
{$W-   No Windows realmode stack frame }
{$UNDEF  RealMode}
{$DEFINE ProtMode}
{$ENDIF}
{---------------------------------------------------------------------}

{$IFDEF MSDOS} Error - protected mode only {$ENDIF}

INTERFACE

uses WinDOS,
{$IFDEF Windows}
     WinProcs
{$ELSE}
     WinAPI
{$ENDIF}
     ;

{$IFDEF Windows}
var
  Seg0040 : word;     { To access the BIOS data area in Windows }
{$ENDIF}

type
  RealProc = procedure;

{=DOSGetMem===========================================================
Allocates and returns the real and protected mode pointers to a DOS
memory block of Size bytes in the first 1Mb. Returns true if
successful, false otherwise.
21Mar93 JMB
======================================================================}
function DOSGetMem(var RealPtr, ProtPtr; Size : word) : boolean;

{=DOSFreeMem==========================================================
Deallocates a DOS memory block allocated with DOSGetMem. Returns true
if successful, false otherwise.
21Mar93 JMB
======================================================================}
function DOSFreeMem(ProtPtr : pointer) : boolean;

{=RealIntr============================================================
Calls the real mode interrupt IntNo. Unlike Intr this guarantees a
real mode interrupt. Intr performs a protected mode interrupt first,
which the DPMI server may pass thru to the real mode interrupt.
Returns true if successful, false otherwise.
21Mar93 JMB
======================================================================}
function RealIntr(IntNo : byte; var Regs : TRegisters) : boolean;

{=RealCall============================================================
Calls the real mode Routine procedure (must be a far procedure and
return with RETF). No stack is transferred, the routine is assumed to
accept its parameters from the registers.
Returns true if successful, false otherwise.
21Mar93 JMB
======================================================================}
function RealCall(Routine : RealProc; var Regs : TRegisters) : boolean;

{=GetMappedDPMIPtr====================================================
Given a real mode pointer to a DOS memory block, returns a protected
mode pointer mapped to the same block.
Returns true if successful, false otherwise.
21Mar93 JMB
======================================================================}
function GetMappedDPMIPtr(var ProtPtr; RealPtr : pointer; Size : word)
           : boolean;

{=FreeMappedDPMIPtr===================================================
Frees a protected mode pointer (ie selector) that was allocated by
GetMappedDPMIPtr.
Returns true if successful, false otherwise.
21Mar93 JMB
======================================================================}
function FreeMappedDPMIPtr(ProtPtr : pointer) : boolean;

IMPLEMENTATION

var
  ExitSave : pointer;

function DOSGetMem(var RealPtr, ProtPtr; Size : word) : boolean;
  type
    LI = record LoWord, HiWord : word; end;
  var
    RealMode : pointer absolute RealPtr;
    ProtMode : pointer absolute ProtPtr;
    Result : longint;
  begin
    Result := GlobalDOSAlloc(Size);
    if (Result <> 0) then
      begin
        RealMode := Ptr(LI(Result).HiWord, 0);
        ProtMode := Ptr(LI(Result).LoWord, 0);
        DOSGetMem := true;
      end
    else DOSGetMem := false;
  end;

function DOSFreeMem(ProtPtr : pointer) : boolean;
  type
    SO = record O, S : word; end;
  begin
    DOSFreeMem := GlobalDOSFree(SO(ProtPtr).S) = 0;
  end;

function RealIntr(IntNo : byte; var Regs : TRegisters) : boolean;
assembler;
  type
    TDPMIRegisters = record
      EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX  : longint;
      Flags, ES, DS, FS, GS, IP, CS, SP, SS   : word;
    end;
  var
    DPMIregs : TDPMIRegisters;
  asm
    push ds
    lds si, Regs
    mov ax, ss;  mov es, ax;  lea di, DPMIregs
    cld
    xor ax, ax
    add si, 12         { EDI }
    movsw;  stosw
    sub si, 4          { ESI }
    movsw;  stosw
    sub si, 4          { EBP }
    movsw;  stosw
    stosw;  stosw      { Res }
    sub si, 8          { EBX }
    movsw;  stosw
    add si, 2          { EDX }
    movsw;  stosw
    sub si, 4          { ECX }
    movsw;  stosw
    sub si, 6          { EAX }
    movsw;  stosw
    add si, 16         { Flags }
    movsw;
    sub si, 4          { ES }
    movsw;
    sub si, 4          { DS }
    movsw;
    mov cx, 6          { FS, GS, IP, CS, SP, SS }
    rep stosw
    lea di, DPMIregs
    mov ax, 0300h      { DPMI code to simulate intr }
    xor bx, bx         { Set BH to zero (and BL) }
    mov bl, IntNo      { Save interrupt number }
    xor cx, cx         { No stack words to copy }
    int 31h            { DPMI Services }
    mov ax, 0
    jc @@ExitPoint     { Error? - yes }
    les di, Regs
    mov ax, ss;  mov ds, ax;  lea si, DPMIregs
    cld
    add si, 28; movsw  { AX }
    sub si, 14; movsw  { BX }
    add si, 6;  movsw  { CX }
    sub si, 6;  movsw  { DX }
    sub si, 14; movsw  { BP }
    sub si, 6;  movsw  { SI }
    sub si, 6;  movsw  { DI }
    add si, 34; movsw  { DS }
    sub si, 4;  movsw  { ES }
    sub si, 4;  movsw  { Flags }
    mov ax, 1
  @@ExitPoint:
    pop ds
  end;

function RealCall(Routine : RealProc; var Regs : TRegisters) : boolean;
assembler;
  type
    TDPMIRegisters = record
      EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX  : longint;
      Flags, ES, DS, FS, GS, IP, CS, SP, SS   : word;
    end;
  var
    DPMIregs : TDPMIRegisters;
  asm
    push ds
    lds si, Regs
    mov ax, ss;  mov es, ax;  lea di, DPMIregs
    cld
    xor ax, ax
    add si, 12         { EDI }
    movsw;  stosw
    sub si, 4          { ESI }
    movsw;  stosw
    sub si, 4          { EBP }
    movsw;  stosw
    stosw;  stosw      { Res }
    sub si, 8          { EBX }
    movsw;  stosw
    add si, 2          { EDX }
    movsw;  stosw
    sub si, 4          { ECX }
    movsw;  stosw
    sub si, 6          { EAX }
    movsw;  stosw
    add si, 16         { Flags }
    movsw;
    sub si, 4          { ES }
    movsw;
    sub si, 4          { DS }
    movsw;
    mov cx, 6          { FS, GS, IP, CS, SP, SS }
    rep stosw
    sub di, 8
    mov ax, Routine.Word[0]  { Routine's real IP }
    stosw
    mov ax, Routine.Word[2]  { Routine's real CS }
    stosw
    lea di, DPMIregs
    mov ax, 0301h      { DPMI code to simulate call }
    xor bx, bx         { Set BH to zero (and BL) }
    xor cx, cx         { No stack words to copy }
    int 31h            { DPMI Services }
    mov ax, 0
    jc @@ExitPoint     { Error? - yes }
    les di, Regs
    mov ax, ss;  mov ds, ax;  lea si, DPMIregs
    cld
    add si, 28; movsw  { AX }
    sub si, 14; movsw  { BX }
    add si, 6;  movsw  { CX }
    sub si, 6;  movsw  { DX }
    sub si, 14; movsw  { BP }
    sub si, 6;  movsw  { SI }
    sub si, 6;  movsw  { DI }
    add si, 34; movsw  { DS }
    sub si, 4;  movsw  { ES }
    sub si, 4;  movsw  { Flags }
    mov ax, 1
  @@ExitPoint:
    pop ds
  end;

function GetMappedDPMIPtr(var ProtPtr; RealPtr : pointer; Size : word)
           : boolean;
assembler;
  asm
    xor ax, ax               { Get an LDT descriptor & selector for it }
    mov cx, 1
    int 31h
    jc @@Error
    xchg ax, bx
    xor ax, ax               { Set descriptor to real address }
    mov dx, RealPtr.Word[2]
    mov al, dh
    mov cl, 4
    shr ax, cl
    shl dx, cl
    xchg ax, cx
    mov ax, 7
    int 31h
    jc @@Error
    mov ax, 8                { Set descriptor to limit Size bytes }
    xor cx, cx
    mov dx, Size             {!!.01} {orig used cx instead of dx}
    add dx, RealPtr.Word[0]  {!!.01}
    jnc @@1
    xor dx, dx               {!!.01}
    dec dx                   {!!.01}
  @@1:
    int 31h
    jc @@Error
    cld                      { Save selector:offset in ProtPtr }
    les di, ProtPtr
    mov ax, RealPtr.Word[0]
    stosw
    xchg ax, bx
    stosw
    mov ax, 1
    jmp @@Exit
  @@Error:
    xor ax, ax
  @@Exit:
  end;


function FreeMappedDPMIPtr(ProtPtr : pointer) : boolean;
assembler;
  asm
    mov ax, 1
    mov bx, ProtPtr.Word[2]
    int 31h
    mov ax, 0
    jc @@Error
    inc ax
  @@Error:
  end;

{$IFDEF Windows}
{=CleanupDPMI=========================================================
Removes the Seg0040 selector for Windows.
21Mar93 JMB
======================================================================}
procedure CleanupDPMI; far;
  var
    PP : pointer;
  begin
    ExitProc := ExitSave;
    PP := Ptr(Seg0040, 0);
    FreeMappedDPMIPtr(PP);
  end;

{=Initialisation======================================================
Sets up the Seg0040 selector for Windows.
21Mar93 JMB
======================================================================}
type
  SO = record O, S : word; end;
var
  PP : pointer;
begin
  GetMappedDPMIPtr(PP, Ptr($40, 0), $400); {1024 byte limit}
  Seg0040 := SO(PP).S;
  ExitSave := ExitProc;
  ExitProc := @CleanupDPMI;
{$ENDIF}
end.