-- Copyright (C) 1986  by Xerox Corporation. All rights reserved. 
-- CHeapImpl.mesa
-- NFS    3-Mar-86 11:10:55

-- C Library storage allocation/deallocation procedures.

DIRECTORY
  CHeap USING [BytePointer],
  CRuntime USING [GetHeap, SetHeap, StopIfUserAborted],
  CString USING [ToBytePointer, ToWordPointer],
  Environment USING [bytesPerWord, Word, wordsPerPage],
  Heap USING [Create, Error],
  Inline USING [DBITAND, LongCOPY],
  SpecialCRuntime USING [heapSize];

CHeapImpl: PROGRAM
  IMPORTS CRuntime, CString, Heap, Inline, SpecialCRuntime EXPORTS CHeap =
  {

  BytePointer: TYPE = CHeap.BytePointer;

  GetHeap: PUBLIC PROCEDURE RETURNS [UNCOUNTED ZONE] = {
    z: UNCOUNTED ZONE;
    CRuntime.StopIfUserAborted[];
    z ← CRuntime.GetHeap[];
    IF z = NIL THEN {
      z ← Heap.Create[
        initial: SpecialCRuntime.heapSize, increment: SpecialCRuntime.heapSize,
        largeNodeThreshold:
        INTEGER[SpecialCRuntime.heapSize] * Environment.wordsPerPage];
      CRuntime.SetHeap[z];
      };
    RETURN[z];
    };

  WordsForBytes: PROCEDURE [nBytes: CARDINAL] RETURNS [nWords: CARDINAL] = INLINE {
    RETURN[(nBytes + Environment.bytesPerWord - 1) / Environment.bytesPerWord]; };

  malloc: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [ptr: BytePointer] = {
    ENABLE Heap.Error => {ptr.pointer ← NIL; CONTINUE; };
    z: UNCOUNTED ZONE ← GetHeap[];
    ptr ← CString.ToBytePointer[MakeNode[z: z, n: WordsForBytes[size]]];
    };

  calloc: PUBLIC PROCEDURE [nelem, elsize: CARDINAL] RETURNS [ptr: BytePointer] = {
    ENABLE Heap.Error => {ptr.pointer ← NIL; CONTINUE; };
    z: UNCOUNTED ZONE;
    wptr: LONG POINTER;
    nWords: CARDINAL = WordsForBytes[nelem * elsize];
    IF nWords = 0 THEN {ptr.pointer ← NIL; RETURN};
    z ← GetHeap[];
    wptr ← MakeNode[z: z, n: nWords];
    LOOPHOLE[wptr, LONG POINTER TO Environment.Word]↑ ← 0;
    Inline.LongCOPY[
      from: wptr, nwords: nWords - 1,
      to: LOOPHOLE[wptr, LONG ORDERED POINTER] + 1];
    ptr ← CString.ToBytePointer[wptr];
    };

  realloc: PUBLIC PROCEDURE [ptr: BytePointer, size: CARDINAL]
    RETURNS [nptr: BytePointer] = {
    ENABLE Heap.Error => {nptr.pointer ← NIL; CONTINUE; };
    z: UNCOUNTED ZONE;
    oldSize: CARDINAL;
    newSize: CARDINAL = WordsForBytes[size];
    wptr: LONG POINTER ←
      IF IsBytePtr[ptr.pointer] THEN CString.ToWordPointer[ptr] ELSE ptr.pointer;
    wnptr: LONG POINTER;
    z ← GetHeap[];
    oldSize ← GetNodeSize[wptr, z];
    IF newSize <= oldSize THEN RETURN[ptr];
    wnptr ← MakeNode[z: z, n: newSize];
    Inline.LongCOPY[from: wptr, nwords: oldSize, to: wnptr];
    FreeNode[z: z, p: wptr];
    nptr ← CString.ToBytePointer[wnptr];
    };

  GetNodeSize: PROCEDURE [
    ptr: LONG POINTER, z: UNCOUNTED ZONE]
    RETURNS [size: CARDINAL] = {
    node: NodeHandle ← ptr - SIZE[CARDINAL];
    RETURN[node.length];
    };

  free: PUBLIC PROCEDURE [ptr: BytePointer] RETURNS [INTEGER ← 0] = {
    z: UNCOUNTED ZONE;
    wptr: LONG POINTER ←
      IF IsBytePtr[ptr.pointer] THEN CString.ToWordPointer[ptr] ELSE ptr.pointer;
    z ← GetHeap[];
    FreeNode[z: z, p: wptr];
    };

  IsBytePtr: PROCEDURE [ptr: LONG UNSPECIFIED] RETURNS [BOOLEAN] = INLINE {
    hiBit: LONG CARDINAL = 20000000000B; RETURN[Inline.DBITAND[ptr, hiBit] # 0]; };

  SetHeap: PUBLIC PROCEDURE [z: UNCOUNTED ZONE] RETURNS [INTEGER ← 0] = {
    CRuntime.SetHeap[z]; };
    
  NodeObject: TYPE = RECORD [
    body: SEQUENCE length: CARDINAL OF WORD];
  NodeHandle: TYPE = LONG POINTER TO NodeObject;
  
  FreeNode: PROC[z: UNCOUNTED ZONE, p: LONG POINTER]={
    node: NodeHandle ← p - SIZE[CARDINAL];
    z.FREE[@node];
    };
    
  MakeNode: PROC[z: UNCOUNTED ZONE, n: CARDINAL] RETURNS [p: LONG POINTER]={
    node: NodeHandle;
    node ← z.NEW[NodeObject[n]];
    RETURN[@node[0]];
    };
  

  }.