home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c220 / 4.ddi / LIB / SRC / HEAP.PF < prev    next >
Encoding:
Text File  |  1990-12-16  |  4.1 KB  |  96 lines
  1. { Heap intrinsics.  Used by Pascal "new" and "dispose" but    }
  2. { may also be used by the programmer.                }
  3. { Multiple heaps are supported.                    }
  4. { Restriction on 8086 implementation: one may not allocate      }
  5. { anything larger then 64356 bytes.                }
  6.  
  7. pragma c_include('implement.pf');
  8. pragma c_include('filep.pf');
  9. package Heap type Heap_index;    -- is abstract.
  10.    pragma Routine_aliasing_convention(Implement.RTE_aliasing);
  11.  
  12.    with Implement;
  13.  
  14.  
  15.    type Heap_index = Cardinal;
  16.   
  17.    const Reserved_heap = Heap_index(0); --Mark/Release does not affect this heap
  18.  
  19.    { Create a new heap.                            }
  20.    { You can get new and dispose to use this heap by setting Curr_heap; }
  21.    { see below.                                }
  22.    function New_heap():Heap_index;                external;
  23.    { Free all storage associated with heap H.                }
  24.    { This is more efficient than disposing or freeing each item at a time.    }
  25.    procedure Free_heap(H:Heap_index);                external;
  26.    
  27.    { Allocate memory of size Len bytes in Curr_heap.    }
  28.    { If Malloc fails, it returns nil.            }
  29.    function Malloc(Len: Byte_count): Pointer;                external;
  30.  
  31.    { Allocate memory of size Len bytes in Heap H    }
  32.    { If HMalloc fails, it returns nil.            }
  33.    function HMalloc(H: Heap_index; Len: Byte_count): Pointer;    external;
  34.  
  35.    { Free a pointer returned by Malloc.            }
  36.    procedure Free(P: Pointer);                    external;
  37.  
  38.    { Increase or decrease the size of P's space to Len.    }
  39.    { Realloc will expand in-place if possible.        }
  40.    { Reallocation always occurs in the same heap that the    }
  41.    { original data was allocated in.            }
  42.    { If the re-allocation failed on expansion we leave the original
  43.      memory alone. }
  44.    function Realloc(P:Pointer; Len:Byte_count):Pointer;        external;
  45.  
  46.    { NOTE:  None of Malloc, Free, or Realloc "zero out" allocated    }
  47.    { memory.  Such storage is set to "Heap_init_byte" defined below    }
  48.    { if the variable "Init_allocated_storage" is set True (which it    }
  49.    { is, by default).                            }
  50.  
  51.    { Conditional realloc.  Returns one of three results.        }
  52.    { If Succeeded, P points to the newly allocated storage.          }
  53.    { If Retained_memory, P points                    }
  54.    {   to storage of the same length as the old storage, with the same    }
  55.    {   contents, but NOT NECESSARILY AT THE SAME ADDRESS.  If the request}
  56.    {   for more memory fails, a request is made for the old amount of     }
  57.    {   memory, so that you can try to CRealloc again with a        }
  58.    {   more modest request.  Typically this is used to increase the    }
  59.    {   size of an array by first attempting to double it; then, if that    }
  60.    {   fails, increasing it only by a small amount.            }
  61.    { If Lost_memory, then not only could it not obtain the new memory, but}
  62.    {   it couldn't get the old back.  This may be the case on some oper-}
  63.    {   ating systems.  It is never True for MS-DOS 2.0.            }
  64.    type CRealloc_returns =
  65.       (Succeeded, Lost_memory, Retained_memory);
  66.    function CRealloc(var P:Pointer; Len:Byte_count):CRealloc_returns;
  67.                                 external;
  68.    
  69.    { Dump all heaps.    }
  70.    procedure Dump_heap(F: Filep_type.Filep);             external;
  71.    
  72.    { For debugging.    }
  73.    { If heap has a problem, you'll get a heap dump.    }
  74.    procedure Check_heap_integrity;                external;
  75.    
  76.    { If the flag below is set, heap integrity will be checked upon new/dispose }
  77.    { or malloc/realloc/free.                        }
  78.    { Heap_init_byte is what newly allocated storage is initialized with,}
  79.    { if Init_allocated_storage is True.                    }
  80.    { Curr_heap is the current heap from which data is allocated (unles  }
  81.    { HMalloc is used to allocate from a specific heap).  You can freely }
  82.    { assign Curr_heap any valid Heap_index.                }
  83.    var Check_heap_integrity_flag: Boolean;
  84.        Heap_init_byte:char;
  85.        Init_allocated_storage:Boolean;
  86.        Curr_heap: Heap_index;
  87.        
  88.    { 8086 systems only: }
  89.    { 2.8 release:
  90.    -- Allocating objects > 64K in size (8086/286 only):
  91.    function Halloc(Elements:Longint; Esize: Cardinal):_huge Address; External;
  92.    procedure Hfree(_huge Address);                              External;
  93.    }
  94.    end;
  95. pragma Alias(Heap,Implement.RTE || 'heap');
  96.