home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VMMNGR.ZIP / VMMNGR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-16  |  16.7 KB  |  421 lines
  1. $S-,R-,V-,I-,B-,F+,O-,A-}
  2.  
  3. {*********************************************************}
  4. {*                   VMMNGR.PAS 1.00                     *}
  5. {*********************************************************}
  6.  
  7. unit Vmmngr;
  8.   {-Virtual memory manager}
  9.  
  10. interface
  11.  
  12. uses
  13.   Dos,
  14.   OpRoot;
  15.  
  16.   procedure DynArrayStream(SPtr : IdStreamPtr);
  17.     {-Register all types needed for streams containing DynArrays}
  18.  
  19. const
  20.  
  21.   MaxHeapAlloc    = 65521;    {Maximum allocation on Turbo Pascal heap}
  22.   DefIncr         = 128;      {Default value for minimum freelist size incr.}
  23.   DefFreeEntries  = 2048;     {Default value for number of freelist entries}
  24.   DefQueueEntries = 512;      {Default size for Lru queue}
  25.   EmsPage         = 16384;    {Size of an Ems page}
  26.   NoEms           = $FFFF;
  27.   MaxEmsBlock     = $FFFF;
  28.   DefDskToKeep    = 1048576;  {Disk space to keep free - 1meg}
  29.   VmmMark         = $FFFF;
  30.  
  31.   {option codes}
  32.   vmDeleteSwap     = $0001;  {Delete swap file when Done}
  33.   vmUseDsk         = $0002;  {No more allocation on disk}
  34.   vmUseEms         = $0004;  {No more allocation in Ems}
  35.   DefVmmOptions : Word = vmUseEms+vmUseDsk+vmDeleteSwap;
  36.   BadVmmOptions : Word = 0;
  37.  
  38.   {masks used to decode VMM descriptors}
  39.   vmInRam          = $01;    {Dereferenced block is in Ram area}
  40.   vmInEms          = $02;    {Dereferenced block is in Ems}
  41.   vmOnDsk          = $04;    {Dereferenced block is on Disk}
  42.   vmLocked         = $08;    {Dereferenced block is locked in Ram area}
  43.   vmLocation       = $07;    {Used to isolate location bits}
  44.  
  45.   OutOfHandles  = $FFFF;
  46.  
  47.   {--------- object type codes (for streams) ---------}
  48.  
  49.   otDynArray = 53;
  50.   otVMMgr    = 54;
  51.  
  52.   {--------- object version codes (for streams) ---------}
  53.  
  54.   veDynArray = 00;
  55.   veVMMgr    = 00;
  56.  
  57.   {--------- object error codes ---------}
  58.  
  59.   ecOutOfRamEntries  = 08600;  {No more entries in RamFreeList}
  60.   ecOutOfEmsEntries  = 08601;  {No more entries in EmsFreeList}
  61.   ecOutOfDskEntries  = 08602;  {No more entries in DskFreeList}
  62.   ecOutOfDescEntries = 08603;  {No more entries in Descriptor table}
  63.   ecNoResources      = 08604;  {No resources for virtual memory}
  64.  
  65. type
  66.  
  67.   {----------- dynamic arrays -------------}
  68.   {-Needed for virtual heap management}
  69.  
  70.   DynArrayPtr = ^DynArray;
  71.   DynArray =
  72.     object(Root)
  73.       daElemSize   : Word;     {Size of one array element}
  74.       daArraySize  : Word;     {Actual size of array}
  75.       daInc        : Word;     {Minimum increment when growing (number of elem.)}
  76.       daMaxIndex   : Word;     {Maximum number of elements minus 1}
  77.       daValidElems : Word;     {Number of valid elements in array}
  78.       daStatus     : Word;     {Error codes are loaded here}
  79.       daBase       : pointer;  {Pointer to the array structure}
  80.  
  81.       constructor Init(MaxElements, ElementSize, Incr : Word);
  82.         {-Initialize array}
  83.       destructor Done; virtual;
  84.         {-Destroy array}
  85.       function GetStatus : Word;
  86.         {-Return and reset array status}
  87.       function PeekStatus : Word;
  88.         {-Return array status}
  89.       procedure Error(Code : Word);
  90.         {-Set array Status}
  91.       {...}
  92.       procedure SetElem(Index : Word; var Elem);
  93.         {-Set an array element to a given value; Increase size if necessary}
  94.       procedure GetElem(Index : Word; var Elem);
  95.         {-Return the indexth element}
  96.       function GetElemSize : Word;
  97.         {-Return size of an element}
  98.       {...}
  99.       function GetArraySize : Word;
  100.         {-Return actual size of array}
  101.       function GetMaxIndex : Word;
  102.         {-Return maximum index allowed}
  103.       function GetValidElems : Word;
  104.         {-Return number of valid elements}
  105.       procedure Shrink(ElemNb : Word);
  106.         {-Shrink array size and discard exceding elements}
  107.       procedure Clear;
  108.         {-Reset array to minimum size and discard all elements}
  109.       {...}
  110.       constructor Load(var S : IdStream);
  111.         {-Load a dynamic array from a stream}
  112.       procedure Store(var S : IdStream);
  113.         {-Store a dynamic array in a stream}
  114.     end;
  115.  
  116.   {----------- VMM StaticQueue -------------}
  117.  
  118.   {Add some functionalities to StaticQueue to manage the LRU blocks}
  119.   VmmStaticQueuePtr = ^VmmStaticQueue;
  120.   VmmStaticQueue =
  121.     object(StaticQueue)
  122.       procedure Remove(var Element);
  123.        {-Remove first element found equal to Element from the queue}
  124.       function IsEmpty : Boolean;
  125.        {-Return true if queue is empty}
  126.     end;
  127.  
  128.   {----------- freelists -------------}
  129.  
  130.   FreeRecord =
  131.     record
  132.       OrgPtr : Pointer;
  133.       EndPtr : Pointer;
  134.     end;
  135.   FreeRecordPtr = ^FreeRecord;
  136.  
  137.   {
  138.    In RamFreeLists OrgPtr and EndPtr should be considered as normal pointers.
  139.    In EmsFreeLists the segment part contains the Ems handle and the offset part
  140.      the offset in the 4 pages Ems frame.
  141.    In DskFreeLists OrgPtr and EndPtr should be considered as LongInt pointers
  142.      to the swap file.
  143.    This issue is processed transparently by the virtual methods implemented for
  144.      each kind of freelist.
  145.   }
  146.  
  147.   AbstractFreeListPtr = ^AbstractFreeList;
  148.   AbstractFreeList =
  149.     object(DynArray)
  150.       constructor Init(MaxElements, Incr : Word);
  151.         {-Initialize a dynamic array of FreeRecords}
  152.       function GetFreeEntrySize(Index : Word) : LongInt; virtual;
  153.         {-Return size of a free block}
  154.       {....}
  155.       function SizeToEndPtr(OrgPtr : Pointer;
  156.                             BlkSize : LongInt) : Pointer;  virtual;
  157.         {-Given OrgPtr and block size, return new entry's EndPtr}
  158.       function SizeToOrgPtr(EndPtr : Pointer;
  159.                             BlkSize : LongInt) : Pointer;  virtual;
  160.         {-Given EndPtr and block size, return new entry's OrgPtr}
  161.       function PtrIsEqual(P1, P2 : Pointer) : Boolean;  virtual;
  162.         {-Return true if pointers can be merged to form a new freelist entry}
  163.       {....}
  164.       function GetFreeEntry(BlkSize : Word) : Pointer;
  165.         {-Search free list for a free block, return a pointer to it}
  166.       function AddFreeEntry(ThisOrgP : Pointer; BlkSize : LongInt) : LongInt;
  167.         {-Insert a new free block in the FreeList or merge it with an }
  168.         { existing one - return size of entry in FreeList}
  169.       procedure RemoveFreeEntry(Index : Word);
  170.         {-Remove entry from the list and shrink list size}
  171.       function MaxFree : Longint;
  172.         {-Return size of largest free entry}
  173.       {....}
  174.       procedure QuickSort(L, R : Word);
  175.         {-Actual sort procedure called by Sort}
  176.       function Sort : Boolean;
  177.         {-Sort the free list in block size order}
  178.     end;
  179.  
  180.   VmmRamFreeListPtr = ^VmmRamFreeList;
  181.   VmmRamFreeList =
  182.     object(AbstractFreeList)
  183.       function GetFreeEntrySize(Index : Word) : LongInt; virtual;
  184.         {-Return size of a free block}
  185.       function SizeToEndPtr(OrgPtr : Pointer;
  186.                             BlkSize : LongInt) : Pointer;  virtual;
  187.         {-Given OrgPtr and block size, return new entry's EndPtr}
  188.       function SizeToOrgPtr(EndPtr : Pointer;
  189.                             BlkSize : LongInt) : Pointer;  virtual;
  190.         {-Given EndPtr and block size, return new entry's OrgPtr}
  191.       function PtrIsEqual(P1, P2 : Pointer) : Boolean; virtual;
  192.         {-Return true if pointers can be merged to form a new freelist entry}
  193.     end;
  194.  
  195.   VmmEmsFreeListPtr = ^VmmEmsFreeList;
  196.   VmmEmsFreeList =
  197.     object(AbstractFreeList)
  198.       function AddFreeEntry(ThisOrgP : Pointer; BlkSize : Word) : LongInt;
  199.         {-Insert a new free block in the FreeList or merge it with an }
  200.         { existing one - return size of entry in FreeList}
  201.       function GetFreeEntrySize(Index : Word) : LongInt; virtual;
  202.         {-Return size of a free block}
  203.       function SizeToEndPtr(OrgPtr : Pointer;
  204.                             BlkSize : LongInt) : Pointer; virtual;
  205.         {-Given OrgPtr and block size, return new entry's EndPtr}
  206.       function SizeToOrgPtr(EndPtr : Pointer;
  207.                             BlkSize : LongInt) : Pointer; virtual;
  208.         {-Given EndPtr and block size, return new entry's OrgPtr}
  209.       function PtrIsEqual(P1, P2 : Pointer) : Boolean; virtual;
  210.         {-Return true if pointers can be merged to form a new freelist entry}
  211.     end;
  212.  
  213.   VmmDskFreeListPtr = ^VmmDskFreeList;
  214.   VmmDskFreeList =
  215.     object(AbstractFreeList)
  216.       function GetFreeEntrySize(Index : Word) : LongInt; virtual;
  217.         {-Return size of a free block}
  218.       function SizeToEndPtr(OrgPtr : Pointer;
  219.                             BlkSize : LongInt) : Pointer;  virtual;
  220.         {-Given OrgPtr and block size, return new entry's EndPtr}
  221.       function SizeToOrgPtr(EndPtr : Pointer;
  222.                             BlkSize : LongInt) : Pointer;  virtual;
  223.         {-Given EndPtr and block size, return new entry's OrgPtr}
  224.       function PtrIsEqual(P1, P2 : Pointer) : Boolean; virtual;
  225.         {-Return true if pointers can be merged to form a new freelist entry}
  226.     end;
  227.  
  228.   {--------- descriptor table ------------}
  229.  
  230.   VmmDescriptorTablePtr = ^VmmDescriptorTable;
  231.   VmmDescriptorTable =
  232.     object(DynArray)
  233.       destructor Done; virtual;
  234.         {-Deallocate all Ems handles hold in descriptor table}
  235.     end;
  236.  
  237. type
  238.  
  239.   {--------- miscellaneous types for vmm ------------}
  240.  
  241.   VmmPtrRec =            {Useful to access segment and offset parts of}
  242.     record               { a pointer by typecasting}
  243.       Ofs : Word;
  244.       Seg : Word;
  245.     end;
  246.  
  247.   VmmDescriptor =        {Describe one element of the VMM descriptor table}
  248.     record
  249.       Location  : Byte; {bit 0 : in Ram; bit 1 : in Ems; bit 2 : on disk}
  250.                         {bit 3 : locked/unlocked; bits 4-7 : reserved/unused}
  251.       Size      : Word; {Size of block}
  252.       case integer of
  253.         1  :  (RamPtr : Pointer); {Block in Ram : use normal pointer}
  254.         2  :  (Offset : Word;     {Block in Ems : use Ems handle and offset}
  255.                Handle : Word);    { in Ems page frame}
  256.         3  :  (DskPtr : LongInt); {Block is on disk : use long offset in}
  257.                                   { swap file}
  258.         4  :  (Ptr    : Pointer;) {Used when generic pointers are needed}
  259.     end;
  260.  
  261.   VmmHandle = Word;
  262.   VmPtr = Pointer;    {Segment part always contains a VmmHandle and}
  263.                       { offset part is always $FFFF - used as a test mark}
  264.  
  265.   VmmRamArea = array [0..MaxHeapAlloc] of byte;
  266.   VmmRamAreaPtr = ^VmmRamArea;
  267.  
  268.   GetMemFunc  = function(var P; Size : LongInt) : Boolean;
  269.   FreeMemProc = procedure(var P; Size : LongInt);
  270.  
  271.   {--------- Virtual memory manager object description  ----------}
  272.  
  273. type
  274.  
  275.   VMMPtr = ^VMM;
  276.   VMM =
  277.     object(root)
  278.       {....Data....}
  279.       vmRamFreeList : VmmRamFreeList;          {Manage blocks in Ram}
  280.       vmEmsFreeList : VmmEmsFreeList;          {Manage blocks in Ems}
  281.       vmDskFreeList : VmmDskFreeList;          {Manage blocks on Disk}
  282.       vmDescTable   : VmmDescriptorTable;      {VmmHandles translation table}
  283.       vmLruQueue    : VmmStaticQueue;          {Manage LRU blocks}
  284.       {----------------------------Ram stuff}
  285.       vmRamArea     : VmmRamAreaPtr;           {Pointer to RAM area}
  286.       vmRamAreaSize : LongInt;                 {Size of RAM area}
  287.       {----------------------------Ems stuff}
  288.       vmEmsToKeep   : Word;                    {Number of Ems pages to keep free}
  289.       vmEmsBaseSeg  : Word;                    {Base segment of Ems frame}
  290.       {----------------------------Disk stuff}
  291.       vmDskToKeep   : LongInt;                 {Space to keep free on disk}
  292.       vmEofPtr      : LongInt;                 {Pointer to end of swap file}
  293.       vmSwapFName   : PathStr;                 {Name of swap file}
  294.       vmF           : File;                    {Swap file}
  295.       {----------------------------}
  296.       vmOptions     : Word;                    {Option flags}
  297.       vmStatus      : Word;                    {VMMgr status}
  298.       {....Methods....}
  299.       constructor Init(SwapFName : PathStr);
  300.         {-Create a new virtual memory manager with default options}
  301.       constructor InitCustom(RamSize : LongInt;
  302.                              Incr, MaxVmmEntries,
  303.                              MaxFreeEntries, VmmQueueEntries,
  304.                              EmsPagesToKeep     : Word;
  305.                              DskToKeep : LongInt;
  306.                              SwapFName : PathStr);
  307.         {-Create a new virtual memory manager with custom options}
  308.       destructor Done; virtual;
  309.         {-Destroy a VMM}
  310.       function PeekStatus : Word;
  311.         {-Return VMM status}
  312.       function GetStatus : Word;
  313.         {-Return and reset VMM status}
  314.       procedure Error(Code : Word);
  315.         {-Set VMM Status}
  316.       {...}
  317.       procedure LinkToDerefHandler;
  318.         {-Instruct the dereference interrupt handler to refer to THIS manager}
  319.       {...}
  320.       procedure GetMemV(var Pt; BlkSize : Word);
  321.         {-Allocate a memory block and return a Vmm "pointer" in Pt}
  322.       procedure FreeMemV(var Pt);
  323.         {-Free a block and set Pt to nil}
  324.       function Lock(var Pt; Lockit : Boolean) : Boolean;
  325.         {-Lock or Unlock a VMM block in Ram}
  326.       function GetSize(var Pt) : Word;
  327.         {-Return size of block pointed to by Pt}
  328.       function ClearRamArea : Boolean;
  329.         {-Page out all blocks unless they are locked}
  330.       {...}
  331.       function RamMaxAvail : LongInt;
  332.         {-Return size of the largest block available in Ram}
  333.       function EmsMaxAvail : LongInt;
  334.         {-Return amount of memory available in Ems}
  335.       function DskMaxAvail : LongInt;
  336.         {-Return amount of space available on Disk}
  337.       {...}
  338.       procedure vmOptionsOn(OptionFlags : Word);
  339.         {-Activate multiple options}
  340.       procedure vmOptionsOff(OptionFlags : Word);
  341.         {-Deactivate multiple options}
  342.       function vmOptionsAreOn(OptionFlags : Word) : Boolean;
  343.         {-Return true if all specified options are on}
  344.       {+++ Internal methods +++}
  345.       function PageOut(SizeNeeded : LongInt) : Boolean;
  346.         {-Page out until "SizeNeeded" bytes become available in the Ram area}
  347.       function GetHandle : Word;
  348.         {-Return a valid VMM handle}
  349.     end;
  350.  
  351.   {--------- Dereference function inline definition ---------}
  352.  
  353.   function VmmDrf(P : Pointer) : Pointer;
  354.     {-Call the dereference handler}
  355.     inline(
  356.       $5B/                     {pop bx          ;BX = Offset part of P}
  357.       $58/                     {pop ax          ;AX = Segment part of P}
  358.       $CD/$66);                {int 66h         ;Call INT 66}
  359.     {the pointer will be returned in DX:AX}
  360.  
  361. var
  362.   UserGetMem      : GetMemFunc; {User-defined routines for standard memory}
  363.   UserFreeMem     : FreeMemProc;{ allocation and deallocation}
  364.  
  365.   {======================================================================}
  366.  
  367. implementation
  368.  
  369. uses
  370.   OpInline,
  371.   OpSort,
  372.   OpEms;
  373.  
  374.   {--------- Virtual memory manager globals  ----------}
  375. var
  376.   VmmActiveMgr    : VMMPtr;     {Pointer to the active virtual memory manager}
  377.                                 { Set by LinkToDerefHandler}
  378.   VmmEmsInstalled : Boolean;    {True if EMM driver is installed}
  379.   VmmSaveIntUsed  : Pointer;    {Used to save previous value of int vector}
  380.   VmmExitSave     : Pointer;    {Used to save ExitProc}
  381.   VmmInstances    : DynArray;   {Keeps track of any instance of VMMgr}
  382. const
  383.   VmmIntUsed   = $66;      {Use Int 66h to dereference VMM pointers}
  384.   VmmRamAreaSizeGlb : LongInt = 0;    {Cumulates all Ram area sizes}
  385.  
  386.  {
  387.   Interrupt $66 is one of the user-definable interrupts described by IBM. If
  388.   this interrupt conflicts with your environment, you may change VmIntUsed to
  389.   use a different interrupt. User-definable interrupts range from $60 to $66.
  390.   ($67 is used for EMS, so it should be avoided here.)
  391.   ┌─────────────────────────────────────────────────────────────────────────┐
  392.   │If you change the interrupt, be sure to modify the VmmDrf inline function│
  393.   │as well.                                                                 │
  394.   └─────────────────────────────────────────────────────────────────────────┘
  395.  }
  396.  
  397.   {$I VMM.IN1}             {Inline macros}
  398.   {$I VMM.IN2}             {Data objects needed by VMMgr}
  399.   {$I VMM.IN3}             {Virtual memory manager public routines}
  400.   {$I VMM.IN4}             {Virtual memory manager internal routines}
  401.  
  402.   procedure VmmExit;
  403.     {-Reset the interrupt vector used by VMM to its previous value}
  404.     begin
  405.      ExitProc := VmmExitSave;
  406.      SetIntVec(VmmIntUsed, VmmSaveIntUsed);
  407.     end;
  408.  
  409. begin
  410.   {Initialize the dereference interrupt handler}
  411.   VmmExitSave := ExitProc;
  412.   ExitProc := @VmmExit;
  413.   GetIntVec(VmmIntUsed, VmmSaveIntUsed);
  414.   SetIntVec(VmmIntUSed, @DerefHandler);
  415.   VmmEmsInstalled := EmsInstalled;
  416.   {Default memory management routines on TP heap are VmmGetMem and VmmFreeMem}
  417.   UserGetMem := VmmGetMem;
  418.   UserFreeMem := VmmFreeMem;
  419.   if not VmmInstances.Init(255, SizeOf(Pointer), 1) then;
  420. end.
  421.