home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / AMOD095.ZIP / MEMUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-12  |  9KB  |  319 lines
  1. unit memunit;
  2. interface
  3. {$s-}
  4. {$g+}
  5. {$o-}
  6.  
  7. uses dos,modtypes;
  8. type
  9.    Bit32Struct = LongInt;
  10.  
  11.    ExtMemMoveStruct =
  12.    Record
  13.       Length       : Bit32Struct;
  14.       SourceHandle : Word;
  15.       SourceOffset : Bit32Struct;
  16.       DestHandle   : Word;
  17.       DestOffset   : Bit32Struct
  18.    End;
  19.  
  20. const
  21.  
  22.    isXMS       : Boolean = false;
  23. Var
  24.    XMSResult   : Word;
  25.    XMSError    : Byte;
  26.    XMM_Control : Array[0..1] of Word;
  27.    xmsinfo : record
  28.                buf : pointer;
  29.                bufsize : integer; {size of buf}
  30.                curptn : integer;
  31.                handle : word;
  32.                size : word;  {kbytes}
  33.              end;
  34.    movestruct : extmemmovestruct;
  35.  
  36.    Function EXISTXMS : Boolean;
  37.    function xmsmaxavail : word;
  38.    Function AllocXMSBlock(malloc : Word) : Word;
  39.    Procedure FreeXMSBlock(handle : Word);
  40.    Procedure MoveXMSBlock(Var MoveStructure : ExtMemMoveStruct);
  41.    function initxms : integer; {0 if ok}
  42.    procedure donexms;
  43.  
  44. implementation
  45. const
  46. xmssize = 750;
  47.  
  48. var
  49. patterns : array[0..128] of longint;
  50.  
  51. {$s-}
  52. Function EXISTXMS : Boolean;
  53. Var
  54.    _al : byte;
  55.    _bx,_es : word;
  56. Begin
  57.    asm
  58.      mov  ax,4300h
  59.      int  2fh
  60.      mov  _al,al
  61.    end;
  62.    If _al = $80 Then
  63.    Begin
  64.       asm
  65.         mov  ax,4310h
  66.         int  2fh
  67.         mov  _bx,bx
  68.         mov  _es,es
  69.       end;
  70.       XMM_Control[0] := _bx;
  71.       XMM_Control[1] := _es;
  72.       EXISTXMS := TRUE
  73.    End
  74.    Else
  75.       EXISTXMS := FALSE
  76. End;
  77.  
  78. function XMSMaxAvail : word;
  79. (* XMSResult = largest free block of Extended Memory in kilobytes *)
  80. Var
  81.    dx : Word;
  82. Begin
  83.    XMSResult := 1;
  84.    XMSError  := 0;
  85.    Inline
  86.    (  $BF/XMM_Control/                     {  MOV  DI,XMM_Control        }
  87.       $B8/$00/$08/                         {  MOV  AX,0800               }
  88.       $55/                                 {  PUSH BP                    }
  89.       $FF/$1D/                             {  CALL FAR[DI] (XMM_Control) }
  90.       $5D/                                 {  POP  BP                    }
  91.       $89/$96/dx                           {  MOV  dx[BP],DX             }
  92.    );
  93.    XMSResult := dx;
  94.    XMSMaxAvail := dx;
  95. End;
  96.  
  97. Function AllocXMSBlock(malloc : Word) : Word;
  98. (* If successful, returns handle to Extended Memory Block *)
  99. Var
  100.    ax : Word;
  101.    dx : Word;
  102.    bl : Byte;
  103. Begin
  104.    XMSResult := 1;
  105.    XMSError  := 0;
  106.    Inline
  107.    (  $BF/XMM_Control/                     {  MOV  DI,XMM_Control        }
  108.       $8B/$96/malloc/                      {  MOV  DX,malloc[BP]         }
  109.       $B8/$00/$09/                         {  MOV  AX,0900               }
  110.       $55/                                 {  PUSH BP                    }
  111.       $FF/$1D/                             {  CALL FAR[DI] (XMM_Control) }
  112.       $5D/                                 {  POP  BP                    }
  113.       $89/$86/ax/                          {  MOV  ax[BP],AX             }
  114.       $88/$9E/bl/                          {  MOV  bl[BP],BL             }
  115.       $89/$96/dx                           {  MOV  dx[BP],DX             }
  116.    );
  117.    XMSResult := ax;
  118.    XMSError  := bl;
  119.    AllocXMSBlock := dx
  120. End;
  121.  
  122. Procedure FreeXMSBlock(handle : Word);
  123. Var
  124.    ax : Word;
  125.    bl : Byte;
  126. Begin
  127.    XMSResult := 1;
  128.    XMSError  := 0;
  129.    Inline
  130.    (  $BF/XMM_Control/                     {  MOV  DI,XMM_Control        }
  131.       $8B/$96/handle/                      {  MOV  DX,handle[BP]         }
  132.       $B8/$00/$0A/                         {  MOV  AX,0A00               }
  133.       $55/                                 {  PUSH BP                    }
  134.       $FF/$1D/                             {  CALL FAR[DI] (XMM_Control) }
  135.       $5D/                                 {  POP  BP                    }
  136.       $89/$86/ax/                          {  MOV  ax[BP],AX             }
  137.       $88/$9E/bl                           {  MOV  bl[BP],BL             }
  138.    );
  139.    XMSResult := ax;
  140.    XMSError  := bl
  141. End;
  142.  
  143. Procedure MoveXMSBlock(Var MoveStructure : ExtMemMoveStruct);
  144. (* NOTE: This procedure assumes that the ExtMemMove structure is valid *)
  145. (* Changed 10/06/89: Needed to force ES: override for XMM Call         *)
  146. Var
  147.    ax,
  148.    segs,
  149.    ofss : Word;
  150.    bl   : Byte;
  151. Begin
  152.    XMSResult := 1;
  153.    XMSError  := 0;
  154.    segs := Seg(MoveStructure);
  155.    ofss := Ofs(MoveStructure);
  156.    Inline
  157.    (  $1E/                                 {  PUSH DS                    }
  158.       $1E/                                 {  PUSH DS                    }
  159.       $07/                                 {  POP  ES                    }
  160.       $8B/$86/segs/                        {  MOV  AX,segs[BP]           }
  161.       $8E/$D8/                             {  MOV  DS,AX                 }
  162.       $8B/$B6/ofss/                        {  MOV  SI,ofss[BP]           }
  163.       $BF/XMM_Control/                     {  MOV  DI,XMM_Control        }
  164.       $B8/$00/$0B/                         {  MOV  AX,0B00               }
  165.       $55/                                 {  PUSH BP                    }
  166.       $26/                                 {  ES:                        }
  167.       $FF/$1D/                             {  CALL FAR[DI] (XMM_Control) }
  168.       $5D/                                 {  POP  BP                    }
  169.       $1F/                                 {  POP  DS                    }
  170.       $89/$86/ax/                          {  MOV  ax[BP],AX             }
  171.       $88/$9E/bl                           {  MOV  bl[BP],BL             }
  172.    );
  173.    XMSResult := ax;
  174.    XMSError  := bl
  175. End;
  176.  
  177. {$s-}
  178. {$f+}
  179. procedure xms_virt_alloc(numptn,ptnsize : integer);
  180. var
  181. n : integer;
  182. begin
  183.   for n := 0 to 128 do patterns[n] := -1;
  184.   virt_info.numptn := numptn;
  185.   virt_info.ptnsize := ptnsize;
  186.   virt_info.err_cptn := -1;
  187.   virt_info.err_wptn := -1;
  188.   virt_info.err_nptn := -1;
  189.   xmsinfo.curptn := -1;
  190. end;
  191.  
  192. procedure xms_virt_free;
  193. var
  194. n : integer;
  195. begin
  196.   for n := 0 to 128 do if patterns[n] <> -1 then begin
  197.     patterns[n] := -1;
  198.   end;
  199. end;
  200.  
  201. procedure xms_virt_allocptn(ptn : integer);
  202. begin
  203.   patterns[ptn] := longint(ptn)*longint(virt_info.ptnsize);
  204. end;
  205.  
  206. procedure xms_virt_loadptn(ptn : integer;p : pointer);
  207. begin
  208.   with movestruct do begin
  209.     length := virt_info.ptnsize;
  210.     sourcehandle := 0;
  211.     sourceoffset := longint(p);
  212.     desthandle := xmsinfo.handle;
  213.     destoffset := patterns[ptn];
  214.   end;
  215.   movexmsblock(movestruct);
  216. end;
  217.  
  218. procedure xms_virt_freeptn(ptn : integer);
  219. begin
  220.   patterns[ptn] := -1;
  221. end;
  222.  
  223. function xms_virt_getptn(ptn : integer) : pointer;
  224. begin
  225.   xms_virt_getptn := xmsinfo.buf;
  226. end;
  227.  
  228. procedure xms_virt_warnptn(ptn : integer);
  229. begin
  230.   virt_info.warnedptn := ptn;
  231.   if xmsinfo.curptn <> ptn then begin
  232.     with movestruct do begin
  233.       length := virt_info.ptnsize;
  234.       sourcehandle := xmsinfo.handle;
  235.       sourceoffset := patterns[ptn];
  236.       desthandle := 0;
  237.       destoffset := longint(xmsinfo.buf);
  238.     end;
  239.     movexmsblock(movestruct);
  240.     xmsinfo.curptn := ptn;
  241.   end;
  242. end;
  243.  
  244. procedure xms_virt_needptn(ptn : integer);
  245. begin
  246.   if ptn <> virt_info.warnedptn then begin
  247.     virt_info.err_cptn := -1;
  248.     virt_info.err_wptn := virt_info.warnedptn;
  249.     virt_info.err_nptn := ptn;
  250.   end;
  251.   if xmsinfo.curptn <> ptn then begin
  252.     with movestruct do begin
  253.       length := virt_info.ptnsize;
  254.       sourcehandle := xmsinfo.handle;
  255.       sourceoffset := patterns[ptn];
  256.       desthandle := 0;
  257.       destoffset := longint(xmsinfo.buf)
  258.       {asm
  259.         mov  ax,word ptr xmsinfo.buf
  260.         mov  word ptr destoffset,ax
  261.         mov  ax,word ptr xmsinfo.buf+2
  262.         mov  word ptr destoffset+2,ax
  263.       end;}
  264.     end;
  265.     movexmsblock(movestruct);
  266.     xmsinfo.curptn := ptn;
  267.   end;
  268. end;
  269.  
  270. procedure xms_virt_noneedptn(ptn : integer);
  271. begin
  272. end;
  273.  
  274. {$f-}
  275.  
  276. function initxms : integer;
  277. var
  278. n : integer;
  279. begin
  280.   fillchar(xmsinfo,sizeof(xmsinfo),0);
  281.   if not existxms then begin
  282.     initxms := 1;
  283.     exit;
  284.   end;
  285.   if xmsmaxavail < xmssize then begin
  286.     initxms := 2;
  287.     exit;
  288.   end;
  289.   fillchar(patterns,sizeof(patterns),byte(-1));
  290.   xmsinfo.handle := allocxmsblock(xmssize);
  291.   if xmsresult <> 1 then begin
  292.     initxms := 3;
  293.     exit;
  294.   end;
  295.   xmsinfo.bufsize :=320*32;
  296.   getmem(xmsinfo.buf,xmsinfo.bufsize);
  297.   virt_alloc := xms_virt_alloc;
  298.   virt_free := xms_virt_free;
  299.   virt_allocptn := xms_virt_allocptn;
  300.   virt_loadptn := xms_virt_loadptn;
  301.   virt_freeptn := xms_virt_freeptn;
  302.   virt_getptn := xms_virt_getptn;
  303.   virt_warnptn := xms_virt_warnptn;
  304.   virt_needptn := xms_virt_needptn;
  305.   virt_noneedptn := xms_virt_noneedptn;
  306.  
  307.   isxms := true;
  308.   initxms := 0;
  309. end;
  310.  
  311. procedure donexms;
  312. begin
  313.   freemem(xmsinfo.buf,xmsinfo.bufsize);
  314.   freexmsblock(xmsinfo.handle);
  315. end;
  316.  
  317. end.
  318.  
  319.