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