home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / RAW1.ZIP / MEM_MGR.PAS next >
Pascal/Delphi Source File  |  1996-06-22  |  10KB  |  342 lines
  1. {****************************************************************************}
  2. {*                                                                          *}
  3. {*                        Pascal Memory Manager v.1.0                       *}
  4. {*                               Code by KOT                                *}
  5. {*                             Frozen Fire 1996                             *}
  6. {*                                                                          *}
  7. {*                      Compiled with Turbo Pascal 7.0                      *}
  8. {*                           ( Default Switches )                           *}
  9. {************************************************************: Shareware :***}
  10. Unit Mem_mgr;
  11. INTERFACE
  12. Uses DOS;
  13. {****************************************************************************}
  14. type ExtHandle=record
  15.      Handle:word;
  16.      Size,Offset:Longint;
  17. end;
  18.      XMSHandle=record
  19.      Handle,Size:word;
  20. end;
  21. {****************************************************************************}
  22. Const
  23. { Move Operation Types }
  24.     Single   = 0;
  25.     Extended = 1;
  26. { Move Operation Modes }
  27.     NoMoving  = 0;
  28.     UMBToEMB = 1;
  29.     EMBtoUMB = 2;
  30.  
  31.     MM_Init:boolean=FALSE;
  32. {****************************************************************************}
  33. Var
  34. { Points to the service memory block }
  35.     MemoryBuffer:pointer;
  36. {****************************************************************************}
  37.     function  Init_MemMgr:word;
  38.     function  Done_MemMgr:word;
  39.     function  XMSInstalled:boolean;
  40.     function  MM_FreeXMS:word;
  41.     function  MM_Limit(MinDosMem,MinXMS:word):boolean;
  42.     function  MM_Move(var HeapBuf;var EMBHandle;Qsize:word;
  43.                                          MO_type,Mode:byte):byte;
  44.     function  MM_Allocate(var EMBHandle;MO_type:byte;QSize:word):byte;
  45.     function  MM_FreeMem(var EMBHandle;MO_type:byte):byte;
  46. IMPLEMENTATION
  47. {****************************************************************************}
  48. type EMMStructure=record
  49.     Size:LongInt;
  50.     SourceHandle:word;
  51.     SourceOfs:Longint;
  52.     DestHandle:word;
  53.     DestOfs:Longint;
  54. end;
  55. {****************************************************************************}
  56. Const
  57. { XMM driver functions }
  58.     XMS_MEMALLOC=$09;
  59.     XMS_FREEMEM=$0A;
  60.     XMS_MOVEMEM=$0B;
  61. {****************************************************************************}
  62. var
  63.     XMSaddr:array[1..2] of word;
  64.     r:registers;
  65.     XMSok,Init:boolean;
  66.     EMMS:EMMstructure;
  67.     H1:XMSHandle;
  68.     H2:ExtHandle;
  69. {****************************************************************************}
  70. {* ROUTINES                                                                 *}
  71. {****************************************************************************}
  72. function even(num:word):longint;
  73. begin
  74. if num and 1=1 then even:=num xor 1 else even:=num;
  75. end;
  76. {****************************************************************************}
  77. {* MEM_MGR PROCEDURES                                                       *}
  78. {****************************************************************************}
  79. function Init_MemMgr;
  80. {****************************************************************************}
  81. {* Initializes MEM_MGR unit. Should be always started first, before using   *}
  82. {* any other MEM_MGR procedures.                                            *}
  83. {****************************************************************************}
  84. begin
  85. Init_MemMgr:=0;
  86. if not MM_Init then
  87. begin
  88. if XMSInstalled then
  89. begin
  90. { Get XMS driver address }
  91.   r.ax:=$4300;
  92.   intR($2F,r);
  93.   XMSok:=(r.al=$80);
  94.   if XMSok then
  95.   begin
  96.   r.ax:=$4310;
  97.   intR($2F,r);
  98.   XMSAddr[1]:=r.bx;
  99.   XMSAddr[2]:=r.es;
  100.   end;
  101. if XMSok then
  102. begin
  103. Init_MemMgr:=0;
  104. Init:=TRUE;
  105. GetMem(MemoryBuffer,$FFFF);
  106. end
  107. else Init_MemMgr:=1;
  108. MM_Init:=TRUE;
  109. end;
  110. end;
  111. end;
  112. {****************************************************************************}
  113. function Done_MemMgr;
  114. {****************************************************************************}
  115. {* This clears memory and retrieves the normal PC state                     *}
  116. {****************************************************************************}
  117. begin
  118. if MM_Init then
  119. begin
  120. MM_Init:=FALSE;
  121. FreeMem(MemoryBuffer,$FFFF);
  122. Done_MemMgr:=0;
  123. end;
  124. end;
  125. {****************************************************************************}
  126. function XMSInstalled;assembler;
  127. {****************************************************************************}
  128. {* Checks if XMM driver is resident in conventional memory                  *}
  129. {****************************************************************************}
  130. asm
  131.  mov     ax, $4300
  132.  int     $2f
  133.  cmp     al, $80
  134.  je      @@1
  135.  xor     ax, ax
  136. @@1:
  137. end;
  138. {****************************************************************************}
  139. function MM_FreeXMS;
  140. {****************************************************************************}
  141. {* Returns the size of the free XMS in kilobytes                            *}
  142. {****************************************************************************}
  143. var
  144. temp:word;
  145. begin
  146. MM_FreeXMS:=0;
  147. if Init then
  148. begin
  149. asm
  150.      mov ah,$08
  151.      call [XMSaddr]
  152.      mov temp,dx
  153. end;
  154. MM_FreeXMS:=temp;
  155. end;
  156. end;
  157. {****************************************************************************}
  158. function MM_Limit;
  159. {****************************************************************************}
  160. {* Sets the limits for the lowest memory sizes, returns true if available   *}
  161. {****************************************************************************}
  162. begin
  163. MM_Limit:=FALSE;
  164. if Init then
  165. if (MM_FreeXMS>=MinXMS) and (MemAvail>=(MinDosMem div 1024)) then
  166.    MM_Limit:=TRUE;
  167. end;
  168. {****************************************************************************}
  169. function MM_Move;
  170. {****************************************************************************}
  171. {* Moves data to and from EMB                                               *}
  172. {****************************************************************************}
  173. var
  174. erc:byte;
  175. EMMSeg,EMMOfs,XSeg:word;
  176. begin
  177. Erc:=0;
  178. if MO_Type=Single then
  179.  begin
  180.  move(EMBHandle,H1,4);
  181.  EMMS.Size:=even(QSize+1);
  182.  if Mode=UMBToEMB then
  183.   begin
  184.   EMMS.SourceHandle:=0;
  185.   EMMS.SourceOfs:=LongInt(Addr(HeapBuf));
  186.   EMMS.DestHandle:=H1.Handle;
  187.   EMMS.DestOfs:=0;
  188.   end;
  189.  if Mode=EMBtoUMB then
  190.   begin
  191.   EMMS.SourceHandle:=H1.Handle;
  192.   EMMS.SourceOfs:=0;
  193.   EMMS.DestHandle:=0;
  194.   EMMS.DestOfs:=Longint(Addr(HeapBuf));
  195.   end;
  196.  end else
  197. if MO_type=Extended then
  198.  begin
  199.  move(EMBHandle,H2,10);
  200.  EMMS.Size:=even(QSize+1);
  201.  if Mode=UMBToEMB then
  202.   begin
  203.   EMMS.SourceHandle:=0;
  204.   EMMS.SourceOfs:=LongInt(Addr(HeapBuf));
  205.   EMMS.DestHandle:=H2.Handle;
  206.   EMMS.DestOfs:=H2.Offset;
  207.   end;
  208.  if Mode=EMBtoUMB then
  209.   begin
  210.   EMMS.SourceHandle:=H2.Handle;
  211.   EMMS.SourceOfs:=H2.Offset;
  212.   EMMS.DestHandle:=0;
  213.   EMMS.DestOfs:=Longint(Addr(HeapBuf));
  214.   end;
  215.  end else
  216.   begin
  217.   MM_Move:=$FF;
  218.   exit;
  219.   end;
  220.     EMMSeg:=Seg(EMMS);
  221.     EMMOfs:=Ofs(EMMS);
  222.     XSeg:=Seg(XMSaddr);
  223. asm
  224.     push DS
  225.     mov  AH,XMS_MOVEMEM
  226.     mov  SI,EMMOfs
  227.     mov  BX,XSeg;
  228.     mov  ES,BX
  229.     mov  BX,EMMSeg
  230.     mov  DS,BX
  231.     call [ES:XMSAddr]
  232.     cmp  ax,1
  233.     jne  @@1
  234.     jmp  @@2
  235. @@1:
  236.     mov erc,bl
  237. @@2:
  238.     pop ds
  239. end;
  240. MM_Move:=Erc;
  241. end;
  242. {****************************************************************************}
  243. function MM_Allocate;
  244. {****************************************************************************}
  245. {* Allocates memory in EMB                                                  *}
  246. {****************************************************************************}
  247. var
  248. Hnd:word;
  249. Erc:byte;
  250. begin
  251. Erc:=0;
  252. {if Size>64 then Size:=Size mod 64;}
  253. if XMSok then
  254. begin
  255. asm
  256.     mov ah,XMS_MEMALLOC
  257.     mov dx,QSize
  258.     call [XMSaddr]
  259.     cmp al,1
  260.     jne @@1
  261.     mov Hnd,dx
  262.     jmp @@2
  263. @@1:{XMSerror}
  264.     mov erc,bl
  265.     mov Hnd,$FFFF
  266. @@2:{End of function}
  267. end;
  268. if Hnd<>$FFFF then
  269. begin
  270. if MO_type=Single then
  271.  begin
  272.  H1.Handle:=Hnd;
  273.  H1.Size:=(QSize shl 10)-1;   { Convert from Kilobytes to bytes }
  274.  move(H1,EMBHandle,4);
  275.  end
  276.  else if MO_type=Extended then
  277.  begin
  278.  H2.Handle:=Hnd;
  279.  H2.Offset:=0;
  280.  H2.Size:=(longint(QSize) shl 10)-1;
  281.  move(H2,EMBHandle,10);
  282.  end;
  283. end;
  284. MM_Allocate:=erc;
  285. end;
  286. end;
  287. {****************************************************************************}
  288. function MM_FreeMem;
  289. {****************************************************************************}
  290. {* Clears memory allocated under given handle                               *}
  291. {****************************************************************************}
  292. var
  293. Hnd:word;
  294. Erc:byte;
  295. begin
  296. if MO_type=Extended then
  297.  begin
  298.  move(EMBHandle,H2,10);
  299.  Hnd:=H2.Handle;
  300.  end
  301.  else
  302.  begin  {Single}
  303.  move(EMBHandle,H1,4);
  304.  Hnd:=H1.Handle;
  305.  end;
  306.  
  307. Erc:=0;
  308. if XMSok then
  309. begin
  310. asm
  311.     mov ah,XMS_FREEMEM
  312.     mov dx,Hnd
  313.     call [XMSaddr]
  314.     cmp al,1
  315.     jne @@1
  316.     mov Hnd,0
  317.     jmp @@2
  318. @@1:{XMSerror}
  319.     mov erc,bl
  320.     mov Hnd,$FFFF
  321. @@2:{End of function}
  322. end;
  323. if MO_type=Extended then
  324.  begin
  325.  H2.Handle:=0;
  326.  H2.Size:=0;
  327.  H2.Offset:=0;
  328.  move(H2,EMBHandle,10);
  329.  end
  330.  else
  331.  begin  {Single}
  332.  H1.Handle:=0;
  333.  H1.Size:=0;
  334.  move(H1,EMBHandle,4);
  335.  end;
  336. MM_FreeMem:=Erc;
  337. end;
  338. end;
  339. {****************************************************************************}
  340. BEGIN
  341. Init:=False;
  342. END.