unit xms;{ THIS UNIT IS COPYRIGHT 1995,96 BY PATRICK LEVIN.  IT'S FREE FOR USE AS LONG AS IT ISN'T COMMERCIAL.}interfaceconst      ERR_NOERR          = $00;                          { kein Fehler }      ERR_NOTIMPLEMENTED = $80;    { angegebene Funktion nicht bekannt }      ERR_VDISKFOUND     = $81;               { VDISK-RAMDISK entdeckt }      ERR_A20            = $82;         { Fehler auf Adressleitung A20 }      ERR_GENERAL        = $8E;            { allgemeiner Treiberfehler }      ERR_UNRECOVERABLE  = $8F;              { nicht-behebbarer Fehler }      ERR_HMANOTEXIST    = $90;                  { keine HMA vorhanden }      ERR_HMAINUSE       = $91;                 { HMA bereits vergeben }      ERR_HMAMINSIZE     = $92;                { zu wenig Platz in HMA }      ERR_HMANOTALLOCED  = $93;                  { HMA nicht allokiert }      ERR_A20STILLON     = $94;            { Adressleitung A20 noch an }      ERR_OUTOMEMORY     = $A0;       { kein extended Memory mehr frei }      ERR_OUTOHANDLES    = $A1;              { alle XMS-Handles belegt }      ERR_INVALIDHANDLE  = $A2;                    { ungltiges Handle }      ERR_SHINVALID      = $A3;               { Source-Handle ungltig }      ERR_SOINVALID      = $A4;               { Source-Offset ungltig }      ERR_DHINVALID      = $A5;          { Destination-Handle ungltig }      ERR_DOINVALID      = $A6;          { Destination-Offset ungltig }      ERR_LENINVALID     = $A7;   { ungltige L„nge fr Move- Funktion }      ERR_OVERLAP        = $A8;                { verbotene šberlappung }      ERR_PARITY         = $A9;                      { Par„tits-Fehler }      ERR_EMBUNLOCKED    = $AA;               { UMB ist nicht gesperrt }      ERR_EMBLOCKED      = $AB;                { UMB ist noch gesperrt }      ERR_LOCKOVERFLOW   = $AC;        { šberlauf des UMB-Sperrz„hlers }      ERR_LOCKFAIL       = $AD;       { UMB kann nicht gesperrt werden }      ERR_UMBSIZETOOBIG  = $B0;              { kleinerer UMB verfgbar }      ERR_NOUMBS         = $B1;              { kein UMB mehr verfgbar }      ERR_INVALIDUMB     = $B2;      { UMB-Segmentadresse ist ungltig }var XMS_Avail     : boolean;    SegXMM,OfsXMM : word;    PtrXMM        : pointer;const    XMM_Error     : integer = 0;function GetEMB (size: word): integer;procedure FreeEMB (Handle: integer);procedure ChangeEMBSize (Handle: integer;Newsize: word);procedure CopyMem (SourceHandle: integer;SourceOfs: longint;                   DestHandle: integer;DestOfs,Count: longint);function GetPhyAdr(segment,offset: word): longint;function GetHMA( LenB : word ) : boolean;procedure ReleaseHMA;function GetXMMErr: string; { (c) patrick levin }function FreeXMS: integer; { (c) patrick levin }implementation{ procedure Init  ==============  in  : -  out : XMM_Error, XMS_Avail,        SegXMM, OfsXMM  XMS_Avail=true, wenn  XMS verfgbar  XMM_Error h„lt Fehlerwert,  wenn HIMEM.SYS nicht installiert  Init stellt fest, ob ein XMM  und XMS vorhanden sind und  setzt einen Zeiger auf d. XMM}procedure Init;assembler;asm mov ax,4300h{ mov ax,$4300-> Fkt.nummer v. HIMEM.SYS ( Anmerkungen P.L. ) } int 2Fh     { int 47      -> Multiplexeraufruf       } cmp al,80h  {             -> HIMEM gibt als einziger 80h zurck (andere FFh)} je @Ok mov XMS_Avail,0 jmp @Ende@Ok: mov ax,4310h   { mov ax,$4310 -> Fkt.nummer Adr. ermitteln } int 2Fh        { Multiplexer aufrufen } mov SegXMM,es  { Far Pointer als ES:BX } mov OfsXMM,bx mov XMS_Avail,1@Ende:end;{ Function GetEMB  ===============  in  : Size  out : Handle des EMB,        XMM_Error  Size gibt die Gr"áe des EMB  in KByte an  Handle ist das EMB-Handle f.  die anderen Funktionen  GetEMB allokiert Speicher im XMS}function GetEMB (size: word): integer;assembler;asm mov ah,9           { Fkt.nummer f. HIMEM } mov dx,size        { Gr"áe in DX ablegen } call ds:[PtrXMM]   { HIMEM ber Far Call aufrufen } cmp ax,1           { alles Ok ? } je @Ok mov bh,0           { nein, HiByte l"schen } mov XMM_Error,bx   { Fehlerwert aus BX in XMM_Error laden } jmp @Ende          { Ende }@Ok: mov XMM_Error,0    { kein Fehler } mov ax,dx          { Handle in Ergebnisregister AX eintragen }@Ende:end;{ procedure FreeEMB  =================  in  : Handle  out : XMM_Error  Handle ist das, zuvor mit  GetEMB ermittelte Handle d. EMB  FreeEMB gibt allokierten Speicher  wieder frei}procedure FreeEMB (Handle: integer);assembler;asm mov ah,$A        { -> ah s„he leicht bescheuert aus } mov dx,Handle    { Handle in DX laden } call ds:[PtrXMM] { HIMEM ber Far Call aufrufen } cmp ax,1         { alles Ok ? } je @Ende mov bh,0         { nein, Fehlerwert aus bx in XMM_Error laden } mov XMM_Error,bx@Ende:end;{ procedure ChangeEMBSize  =======================  in  : Handle,NewSize  out : XMM_Error, Handle  NewSize ist d. neue Gr"áe des  bereits allokierten EMB  ChangeEMBSize „ndert die Gr"áe  allokierter EMBs}procedure ChangeEMBSize (Handle: integer;Newsize: word);assembler;asm mov ah,$F        { Fkt.nummer f. HIMEM   } mov bx,Newsize   { Gr"áe nach BX laden   } mov dx,Handle    { Handle nach DX landen } call ds:[PtrXMM] { HIMEM ber Far Call   } cmp ax,1         { alles Ok ?            } je @Ok mov bh,0         { nein, Fehler aus BX   } mov XMM_Error,bx jmp @Ende@Ok: mov XMM_Error,0  { Fehler auf null setzen} mov ax,dx        { Handle aus DX nach AX }@Ende:end;{ procedure CopyMem  =================  in  : SourceHandle, SourceOfs,        DestHandle, DestOfs, Count  out : XMM_Error  CopyMem kopiert den EMB m. SourceHandle  und d. Adr. SourceOfs in den EMB m.  DestHandle und der Adresse DestOfs}procedure CopyMem (SourceHandle: integer;SourceOfs: longint;                   DestHandle: integer;DestOfs,Count: longint);var SegXMMRec,OfsXMMRec: word;    XMMRec: record              Counter: longint;              SrceHdl: integer;              Source : longint;              DestHdl: integer;              Destina: longint;            end;begin  with XMMRec do begin    Counter := Count;    SrceHdl := SourceHandle;    Source  := SourceOfs;    DestHdl := DestHandle;    Destina := DestOfs;  end;  SegXMMRec := Seg(XMMRec);  OfsXMMRec := Ofs(XMMRec);  XMM_Error := 0;  asm   push ds   mov ax,ds   mov es,ax   mov ax,SegXMMRec   mov ds,ax   mov si,OfsXMMRec   mov ah,$b   call es:[PtrXMM]   cmp ax,1   je @Ende   mov bh,0   mov SegXMMRec,bx@Ende:   pop ds  end;  XMM_Error:=SegXMMRec;end;{ function GetHMA  ===============  in  : Anzahl zu allokierender Bytes  out : true, wenn HMA zur Verfgung        gestellt wurde, sonst false  TSR-Programme sollten nur genau den  Speicher allokieren, den sie tat-  s„chlich brauchen, andere $FFFF}function GetHMA( LenB : word ) : boolean; assembler;  asm    mov   dx, lenB    mov   ah, 01h    call  ds:[PtrXMM]    cmp   ax,1    jne   @Err    mov   XMM_Error,0    mov   ax,00h    jmp   @Ende@Err:    xor   bh,bh    mov   XMM_Error,bx    mov   AX,01h@Ende:end;{ procedure ReleaseHMA  ====================  in  : -  out : XMM_Error<>0, wenn HMA        nicht allokiert wurde  ReleaseHMA sollte vor Beendigung  eines Programms, das die HMA  benutzte, aufgerufen werden, damit  nachfolgende Programme die HMA nut-  zen k"nnen}procedure ReleaseHMA; assembler;asm  mov   ah,02h  call  ds:[PtrXMM]  cmp   bx,0  je    @Ok  xor   bh,bh  mov   XMM_Error,bx  jmp   @TheEnd@Ok:  mov   XMM_Error,0@TheEnd:end;{ function GetXMMErr  ==================  in  : -  out : Fehlermeldungstring}function GetXMMErr: string;begin  case XMM_Error of      ERR_NOERR          : GetXMMErr:='Kein Fehler.';      ERR_NOTIMPLEMENTED : GetXMMErr:='Unbekannte Funktion.';      ERR_VDISKFOUND     : GetXMMErr:='VDISK - RAMDISK entdeckt.';      ERR_A20            : GetXMMErr:='Fehler auf A20 Adressleitung.';      ERR_GENERAL        : GetXMMErr:='Allgemeiner Treiberfehler.';      ERR_UNRECOVERABLE  : GetXMMErr:='Nicht-behebbarer Fehler.';      ERR_HMANOTEXIST    : GetXMMErr:='Kein HMA gefunden.';      ERR_HMAINUSE       : GetXMMErr:='HMA bereits vergeben.';      ERR_HMAMINSIZE     : GetXMMErr:='Nicht genug Platz in HMA.';      ERR_HMANOTALLOCED  : GetXMMErr:='HMA nicht allokiert.';      ERR_A20STILLON     : GetXMMErr:='Adressleitung A20 ist noch aktiv.';      ERR_OUTOMEMORY     : GetXMMErr:='Kein EMB verfgbar.';      ERR_OUTOHANDLES    : GetXMMErr:='Kein Handle mehr verfgbar.';      ERR_INVALIDHANDLE  : GetXMMErr:='Ungltiges Handle.';      ERR_SHINVALID      : GetXMMErr:='Ungltiges Source-Handle.';      ERR_SOINVALID      : GetXMMErr:='Ungltige Source-Adresse.';      ERR_DHINVALID      : GetXMMErr:='Ungltiges Destination-Handle.';      ERR_DOINVALID      : GetXMMErr:='Ungltige Destination-Adresse.';      ERR_LENINVALID     : GetXMMErr:='Ungltige Anzahl von Bytes fr CopyMem.';      ERR_OVERLAP        : GetXMMErr:='Verbotene šberlappung von Adressen.';      ERR_PARITY         : GetXMMErr:='Parit„tsfehler.';      ERR_EMBUNLOCKED    : GetXMMErr:='Nicht gesperrter UMB.';      ERR_EMBLOCKED      : GetXMMErr:='UMB gesperrt.';      ERR_LOCKOVERFLOW   : GetXMMErr:='UMB Sperrz„hler šberlauf.';      ERR_LOCKFAIL       : GetXMMErr:='UMB kann nicht gesperrt werden.';      ERR_UMBSIZETOOBIG  : GetXMMErr:='UMB zu groá.';      ERR_NOUMBS         : GetXMMErr:='Kein UMB verfgbar.';      ERR_INVALIDUMB     : GetXMMErr:='Ungltige UMB-Segmentadresse.';      else GetXMMErr:='Unbekannter Fehler.';  end;end;function FreeXMS: integer; assembler;asm  mov   ah,08h  call  ds:[PtrXMM]  mov   ax,dx  cmp   bx,80h  jb    @Ok  xor   bh,bh  mov   XMM_Error,bx  jmp   @TheEnd@Ok:  mov   XMM_Error,ERR_NOERR@TheEnd:end;function GetPhyAdr(segment,offset: word): longint;begin GetPhyAdr:=longint(segment) shl 16 or offset;end;{ Initialisierungsteil }begin  Init;                      { XMS berprfen, Fehler setzen }  PtrXMM:=Ptr(SegXMM,OfsXMM);{ Zeiger auf XMM initialisieren }end.