{

 REAL FLAT MODE FšR TP
------------------------
 by STEViE/WtB


}


UNIT XMSUNIT2;


INTERFACE



USES CRT;



 Procedure XMSAUTOINIT(lm:Word);                                { lm= Mindest Speicher in Kbyte               }
 Function  XMSMEMAVAIL:Word;                                    { Freier Speicher in Kbyte                    }
 Procedure XMSGETMEM(size:Word;var handle:Word;var p:Longint);  { Reserves                  | Size in Kbyte!!!}
 Procedure XMSFREEMEM(handle:Word;var t:Word);                  { Gibt Speicher wieder frei | T=0=OK !        }
 Procedure XMSREADBLOCK(name:String;xmsp:Longint);              { Read Block from HD        | len in Byte     }
 Procedure XMSWRITEBLOCK(name:String;xmsp,len:Longint);         { Write Block to  HD        | len in Byte     }
 Procedure XMSMOVE(source,dest,len:Longint);                    { Copy Block                                  }
 Procedure XMSFILL(dest,len:Longint;b:Word);                    { Fill Block                                  }
 Function  FLATPTR(p:Pointer):Longint;                          { Convert TP-Pointer to FlatPtr               }

 (************* INLINE MUMPITZ *****************)

 Procedure CLEARGS;                                             { SEE DOCU                                    }
     INLINE(
           $33/$C0/          { XOR AX,AX       }
           $8E/$E8           { MOV GS,AX       }
           );

 Procedure XMSPOKEB(A:longint;b:Word);
     INLINE(
           $58/              { POP AX          }
           $66/$5B/          { POP EBX         }
           $65/$67/$88/$03   { MOV GS:[EBX],AL }
           );

 Function XMSPEEKB(A:longint):Byte;
     INLINE(
           $66/$5B/          { POP EBX         }
           $65/$67/$8A/$03   { MOV AL,GS:[EBX] }
           );

 Procedure XMSPOKEW(A:longint;b:Word);
     INLINE(
           $58/              { POP AX          }
           $66/$5B/          { POP EBX         }
           $65/$67/$89/$03   { MOV GS:[EBX],AX }
           );

 Function XMSPEEKW(A:longint):Word;
     INLINE(
           $66/$5B/          { POP EBX         }
           $65/$67/$8B/$03   { MOV AX,GS:[EBX] }
           );

 Procedure XMSPOKED(A:longint;b:Longint);
     INLINE(
           $66/$58/              { POP EAX           }
           $66/$5B/              { POP EBX           }
           $66/$65/$67/$89/$03   { MOV GS:[EBX],EAX  }
           );

 Function XMSPEEKD(A:longint):Longint;
     INLINE(
           $66/$5B/              { POP EBX           }
           $65/$67/$8B/$03/      { MOV AX,GS:[EBX]   }
           $65/$67/$8B/$53/$02   { MOV DX,GS:[EBX+2] }
           );

 (**********************************************)

IMPLEMENTATION


CONST GDT:Array[0..15] of Byte =
    ($00,$00,$00,$00,$00,$00,$00,$00,
     $FF,$FF,$00,$00,$00,$92,$CF,$FF);


VAR
   lmg:Word;


(************* EXTERNE PROCEDUREN **********)

 Procedure XMSLOADGDT(gdtseg,gdtofs:Word);EXTERNAL;
 Function  XMSTESTV86:Word;EXTERNAL;
 Function  XMSDRVINIT:Word;EXTERNAL;
 Function  XMSASKFREEMEM:Word;EXTERNAL;
 Function  XMSASKFREEBLOCK:Word;EXTERNAL;
 Function  XMSALOCEMB(size:Word;var ptr:Longint):Word;EXTERNAL;
 Function  XMSFREEEMB(handle:Word):Word;EXTERNAL;
 Procedure XMSREADBLOCK(name:String;xmsp:Longint);EXTERNAL;
 Procedure XMSWRITEBLOCK(name:String;xmsp,len:Longint);EXTERNAL;
 Procedure XMSMOVE(source,dest,len:Longint);EXTERNAL;
 Procedure XMSFILL(dest,len:Longint;b:Word);EXTERNAL;

 {$L XMS2.OBJ }

(*******************************************)


 Function FLATPTR(p:Pointer):Longint;     { seg*16+ofs}
   Begin;
     flatptr:=longint(seg(p^))*16+longint(ofs(p^));
   End;

 Procedure XMSINIT(var t:Word);
    var w,r:Word;
   Begin;
     r:=0;
     w:=XMSTESTV86;
     if w>0 then r:=1;
     if w=0 then
     Begin;
       XMSLOADGDT(seg(gdt),ofs(gdt));
       w:=XMSDRVINIT;
       if w=1 then r:=2;
       if w=2 then r:=3;
     End;
     t:=r;
   End;

 Function XMSMEMAVAIL:Word;
    var w:Word;
   Begin;
     w:=xmsaskfreemem;
     xmsmemavail:=w;
   End;


 Procedure XMSGETMEM(size:Word;var handle:Word;var p:Longint);
     var pt:Longint;
         h:Word;
   Begin;
     h:=XMSALOCEMB(size,pt);
     handle:=h;
     p:=pt;
   End;


 Procedure XMSFREEMEM(handle:Word;var t:Word);
   Begin;
     t:=xmsfreeemb(handle);
   End;


 (*****************************************)

 Procedure XMSERROR(t:Word);
   Begin;
     Textcolor(red);
     Writeln('þ ERROR:');
     Textcolor(red);
     case t of
      1: Begin;
           Writeln('  CPU already in V86-Mode !!! ');
           Writeln('  Only HIMEM.SYS must be installed !!!');
         End;
      2: Begin;
           Writeln('  Himem.Sys not found !!! ');
         End;
      3: Begin;
           Writeln('  Himem.Sys Version < 2.0 !!!');
         End;
      4: Begin;
           Writeln('  You need at least ',lmg,' Kbyte ');
           Writeln('  XMS to run this program !!!');
         End;
      5: Begin;
           Writeln('  You need at least a 80386 CPU ');
           Writeln('  to run this program !!!');
         End;
      end;
     halt(1);
   End;


   FUNCTION TEST386:Boolean;ASSEMBLER;
     ASM
      push 0
      popf
      pushf
      pop ax
      cmp ax,7000h
      je @kleiner286
      push 7000h
      popf
      pushf
      pop ax
      cmp ax,7000h
      jne @ist286
      {----- 386! --------}
      mov AX,1
      jmp @ende
      {----- kein 386 ----}
      @ist286:
      @kleiner286:
      mov AX,1
      @ENDE:
     END;



 Procedure XMSAUTOINIT(lm:Word);
    var t:Word;
   Begin;
     lmg:=lm;
     Textbackground(black);
     {----- 386er CPU ? ------------}
     Textcolor(green);
     if not(test386) then XMSERROR(5)
                     else Writeln('þ 386 CPU found !');
     {----- Iinit Real Flat Mode ---}
     XMSinit(t);
     Case t of
       1: XMSError(1);
       2: XMSError(2);
     end;

     Textcolor(green);
     Writeln('þ XMS-Treiber gefunden !!! ');
     Writeln('þ CPU programmed to flat mem !');
     Textcolor(lightblue);

     {----- Freier Speicher --------}
     t:=xmsmemavail;
     if t>=lm then Writeln('þ ',t,' Kbyte freier XMS-Speicher !')
              else XMSError(4);

     {----- GS l”schen -------------}
     CLEARGS;
   End;


END.