{

 History
 -------

 11/09/85 - new function StoreImp, set Adid -1 in Acquire, call StoreImp
	  - in SetAddressFor, include file impint.pf.
 24/09/85 - amend Allocate, AreaFor, SetAddressFor; define InitAreas.
 17/10/85 - Tidy history.  Remove outdated documentation. (agh)
 17/10/85 - Many changes to provide correct data alignment, area
            assignment, and storage allocation. (agh)
 18/10/85 - add SetBdAddress to hide call to AlfaString from
            analyser. (agh)
 21/10/85 - change declaration of Amount in SetAddressFor to have
            type ByteRange. (agh)
 21/10/85 - make Acquire visible. (agh)
 22/10/85 - simplify Manual list processing for file initialisations
            only. (agh)
 23/10/85 - add ParamCount field in StackFrame for proc declaration/
            call consistency check. (agh)
 25/10/85 - Add procedure SaveParamSpace. (agh)
 25/10/85 - Correct bug in Acquire so that Stack is the only area
            that can have negative allocation. (agh)
 08/11/85 - Adjust initial stack-frame offset to leave space for
            display. (agh)
 12/11/85 - Ensure address-offsets are negative if negative stack
            model (agh).
 13/11/85 - In AreaFor, change VarType to IdType. (agh)
 13/11/85 - In MakeBase, set Area according to whether global
            or stack area is to be initialised. (agh)
 06/12/85 - Initialise Areas array in InitAllocator. (agh)
 -------------------------------------------------------------------
 14/12/85 - Suppress calls to Edataentry & Edataref for variables that
            are neither visible nor extern.
 20/01/86 - Initialise Adid field in Acquire.
 --------------------------------------------------------------------
 29/01/86 - assign Pointers to Gla in GlobalArea
                                                                    }

{+doc Static Storage Management 

			  MODULE 14


		  Static Storage Management



                                                                        }

program StorageManagement;
  
#include "globals.x"
#include "semantics.pf"
#include "generator.pf"
#include "datareps.pf"
#include "varref.pf"
#include "withstmts.pf"
#include "prologue.pf"
#include "impint.pf"

{+doc 14.1 Stack Frame Maintenance }

  function FirstOffset: ByteRange;

    begin
      FirstOffset := (MCFirstOffset + FrameLevel - 1) * MCBytesPerWord
    end { FirstOffset };

  procedure StartManuals(var List: ManualList);
    visible;
    forward;
  
  procedure OpenStackFrame;
    visible;
    
    var TopFrame: FrameEntry;
    
    begin
      FrameLevel := FrameLevel + 1;
      new(TopFrame);
      with TopFrame^ do
        begin
          StackOffset := FirstOffset;
          ParamOffset := 0;
          ParamCount := 0;
          StartManuals(FileList);
          Next := TopFrameEntry
        end;
      TopFrameEntry := TopFrame
    end { openstackframe };
  
  procedure CloseStackFrame;
    visible;
    
    var TopFrame: FrameEntry;
    
    begin
      TopFrame := TopFrameEntry;
      with TopFrame^ do TopFrameEntry := Next;
      dispose(TopFrame);
      FrameLevel := FrameLevel - 1
    end { closestackframe };

  procedure SaveParamSpace(var Space: ParamSpace);
    visible;

    begin
      with TopFrameEntry^ do
        begin
          Space.Number := ParamCount;
          Space.Size := ParamOffset
        end
    end { SaveParamSpace };
  
  procedure SaveStackFrame;
    visible;
    
    begin
      with Display[ScopeLevel] do
        begin
          SavedFrame := TopFrameEntry;
          TopFrameEntry := TopFrameEntry^.Next
        end;
      FrameLevel := FrameLevel - 1
    end { savestackframe };
  
  procedure ReclaimStackFrame;
    visible;
    
    begin
      with Display[ScopeLevel] do
        begin
          SavedFrame^.Next := TopFrameEntry;
          TopFrameEntry := SavedFrame
        end;
      FrameLevel := FrameLevel + 1
    end { restorestackframe };
  
  procedure InitFrames;
    visible;
    
    begin
      FrameLevel := 0;
      new(TopFrameEntry);
      with TopFrameEntry^ do
        begin
          StackOffset := 0;
          ParamOffset := 0;
          ParamCount := 0; 
          StartManuals(FileList);
          Next := nil
        end
    end { initframes };
  
{+doc 14.2 Storage Allocation Utilities }

  function GlobalArea(Form: TypeForm): DataArea;

    { This function chooses an appropriate global storage area }
    { according to whether TheType is structured or scalar.    }
    { GlobalScalarArea and GlobalStructureArea are variables   }
    { initialised from constants in the target specification   }
    { file.                                                    }

    begin
      if Form <= Pointers
      then GlobalArea := GlobScalarArea
      else GlobalArea := GlobStructureArea
    end { GlobalArea };

  function AreaFor(VarId: IdEntry): DataArea;

    begin
      with VarId^ do
        case VarKind of
          ValueParam, VarParam, ReadonlyParam :
            AreaFor := Parameter;
          ExternalVar :
            AreaFor := Gla;
          VisibleVar :
            AreaFor := GlobalArea(IdType^.Form);
          LocalVar :
            if (FrameLevel = GlobalLevel) or (Klass = ReadonlyVars)
            then AreaFor := GlobalArea(IdType^.Form)
            else AreaFor := Stack
        end
    end { AreaFor };

  function AmountFor(VarId: IdEntry): ByteRange;

    begin
      with VarId^ do
       case VarKind of
         ValueParam :
           if IsConformant(IdType)
           then AmountFor := MCBytesPerWord 
           else AmountFor := DataBytes(IdType^.Representation);
         VarParam, ReadonlyParam, ExternalVar :
           AmountFor := MCBytesPerWord;
         VisibleVar, LocalVar :
           AmountFor := DataBytes(IdType^.Representation)
        end
    end { AmountFor };

  procedure AlignArea(Area: DataArea; Amount: ByteRange);

    begin
      case Area of 
        Stack :
          with TopFrameEntry^ do Align(StackOffset, Amount);
        Parameter :
          with TopFrameEntry^ do Align(ParamOffset, Amount);
        Gla : Align(GlaOffset, Amount);
        Static : Align(StatOffset, Amount);
        GST : Align(GSTOffset, Amount)
      end
    end { AlignArea };

  procedure ClaimSpace(Area: DataArea; Amount: ByteRange);
 
    begin
      case Area of 
        Stack :
          with TopFrameEntry^ do StackOffset := StackOffset + Amount;
        Parameter :
          with TopFrameEntry^ do
            begin
              ParamOffset := ParamOffset + Amount;
              ParamCount := ParamCount + 1
            end;
        Gla : GlaOffset := GlaOffset + Amount;
        Static : StatOffset := StatOffset + Amount;
        GST : GSTOffset := GSTOffset + Amount
      end
    end { ClaimSpace };

  function AreaOffset(Area: DataArea): ByteRange;

    begin
      case Area of
        Stack : AreaOffset := TopFrameEntry^.StackOffset;
        Parameter : AreaOffset := TopFrameEntry^.ParamOffset;
        Gla : AreaOffset := GlaOffset;
        Static : AreaOffset := StatOffset;
        GST : AreaOffset := GSTOffset
      end
    end { SetOffset };

  procedure Acquire(Amount: ByteRange; Area: DataArea; 
                    var Address: RuntimeAddress);
    visible;

    begin
      AlignArea(Area, Amount);
      Address.Area := Area;
      Address.Adid := 0;
      with Address do
        case Area of
          Stack :
            begin
              BlockLevel := FrameLevel;
              if NegativeStack
              then
                begin
                  ClaimSpace(Area, Amount);
                  ByteOffset := -AreaOffset(Area)
                end
              else
                begin
                  ByteOffset := AreaOffset(Area);
                  ClaimSpace(Area, Amount)
                end
            end;
          Parameter :
            begin
              BlockLevel := FrameLevel;
              ByteOffset := AreaOffset(Area);
              ClaimSpace(Area, Amount)
            end;
          Gla, GST, Static :
            begin
              BlockLevel := GlobalLevel;
              ByteOffset := AreaOffset(Area);
              ClaimSpace(Area, Amount)
            end
        end
    end { Acquire };  

{+doc 14.2 Runtime Address Allocation }

  procedure SelectManual(var List: ManualList; LocalId: IdEntry);
    visible;
    forward;

  function Linkable(Area: DataArea): Boolean;
  
    begin
      { linkable areas = [Gla, Static, GST ] }
      Linkable := Area in LinkableAreas
    end { LinkableAreas };

  procedure PassName(Name: Alfa; var Address: RuntimeAddress);

    begin
      with Address do AdId := AlfaString(Name)
    end { PassName };

  procedure PassDataEntry(Address: RuntimeAddress; VarKind: KindOfVar;
                          Amount: ByteRange);

    begin
      with Address do
        case Area of
          Gla : 
            if VarKind = ExternalVar 
            then Pasdref(Gla, ByteOffset, Amount, Adid) 
            else Pasdent(Gla, ByteOffset, Amount, Adid);
          Static, GST : Pasdent(Area, ByteOffset, Amount, Adid);
          Parameter, Stack :
        end
    end { PassDataEntry };

  procedure SetAddressFor(VarId: IdEntry);
    visible;
    
    var
      Address: RuntimeAddress;
      Amount: ByteRange;
      Area: DataArea;
    
    begin
      with VarId^ do
        case Klass of
          Vars, PresetVars, ReadOnlyVars :
            begin
              Amount := AmountFor(VarId);
              Area := AreaFor(VarId);
	      Acquire(Amount, Area, Address);
              PassName(Name, Address);
              if Linkable(Area) and (VarKind in [VisibleVar, ExternalVar]) 
              then PassDataEntry(Address, VarKind, Amount);
              VarAddress := Address;
	      if (Klass = Vars) and (VarKind in [VisibleVar, LocalVar])
                 and EmbeddedFile(VarId^.IdType)
              then
                with TopFrameEntry^ do
                  SelectManual(FileList, VarId);
            end;
          Proc, Func :
            if PfKind = Formal
            then
              begin
                Acquire(MCPfParamSize, Parameter, Address);
                PassName(Name, Address);
                FAddress := Address
	      end
            else
              begin
                Amount := DataBytes(IdType^.Representation);
                Acquire(Amount, Stack, Address);
                Address.AdId := CodeBody.AdId;
                Result := Address
              end
        end
    end { setaddressfor };
  
  procedure SetBoundPairBlockFor(var LowBound, HighBound: CAPBound);
    visible;
    
    var Address: RuntimeAddress;
    
    begin
      Acquire(MCCAPBpSize * MCBytesPerWord, Parameter, Address);
      LowBound.Address := Address;
      with Address do ByteOffset := ByteOffset + MCBytesPerWord;
      HighBound.Address := Address
    end { setboundpairblock };

  procedure SetBdAddress(BdId: IdEntry; var Address: RuntimeAddress);
    visible;

    begin
      with BdId^ do
        begin
          Address.AdId := AlfaString(Name);
          BdAddress := Address
        end
    end { SetBdAddress };

  procedure PrintAddress(Address: RuntimeAddress; var f: text);
    visible;

    begin
      with Address do
        begin
          write(f, '[ ', 'Level = ',BlockLevel:1,
                ' Offset = ', ByteOffset: 1, ' Area = ');
          case Area of
            Stack : write(f, 'Stack');
            Code : write(f, 'Code');
            Gla : write(f, 'Gla');
            Parameter : write(f, 'Param');
            SST : write(f, 'Sst');
            GST : write(f, 'Gst');
            Diagnostic : write(f, 'Diags');
            Static : write(f, 'Static');
            IoTables : write(f, 'IO');
            Spare : write(f, 'Spare');
            Constants : write(f, 'Const')
          end;
          write(f, ' ]')
        end
    end { PrintAddress }; 
  
  procedure InitAllocator;
    visible;

    var i: DataArea;

    begin
      for i := Stack to Constants do Area[i] := 0;
      GlaOffset := 0;
      StatOffset := 0;
      GSTOffset := 0;
      NegativeStack := (MCNegativeStackFlag = 1);
      GlobScalarArea := Gla;
      GlobStructureArea := GST;
      LinkableAreas := [Gla, Static, GST]
    end;

{+doc 14.6 Variable Initialisation and Finalisation }
  
  procedure StartManuals { var List : ManualList };
    
    begin
      List.FirstEntry := nil;
      List.LastEntry := nil
    end { StartManuals };
  
  procedure ChainItem(var List: ManualList; Entry: ManualEntry);
    visible;
    
    begin
      with List do
        begin
          if FirstEntry = nil
          then FirstEntry := Entry else LastEntry^.NextItem := Entry;
          LastEntry := Entry
        end
    end { chainitem };
  
  procedure MakeItem(var Item: ManualEntry);
    visible;
 
    begin
      new(Item);
      with Item^ do
        begin
          ItsOffset := DftOffset;
          Repeated := 1;
          NextItem := nil
        end
    end { makeitem };

  function LastType(List: ManualList): TypEntry;

    begin
      with List do
        if LastEntry = nil 
        then LastType := Unknown else LastType := LastEntry^.ItsType
    end { LastType };

  function MergedItems(List: ManualList; ThisType: TypEntry): Boolean;

    begin
      if (LastType(List) = ThisType) and (ThisType^.Form = Files)
      then
        with List.LastEntry^ do
          begin
            Repeated := Repeated + 1;
            MergedItems := true
          end
      else MergedItems := false
    end { MergedItems };          

  procedure SelectManual{var List: ManualList; LocalId : IdEntry };
    
    var 
      NewItem: ManualEntry;

    begin
      with LocalId^ do
        if not MergedItems(List, IdType)
        then
          begin
            MakeItem(NewItem);
            with NewItem^ do
              begin
                ItsType := IdType;
                if Klass = Field
                then ItsOffset := Offset
                else ItsOffset.ByteOffset := VarAddress.ByteOffset
              end;
            ChainItem(List, NewItem)
          end
    end { selectmanual };
  
  procedure DsposeManuals(var List: ManualList);
    visible;
    
    var OldEntry: ManualEntry;
    
    begin
      with List do
        while FirstEntry <> nil do
          begin
            OldEntry := FirstEntry;
            FirstEntry := OldEntry^.NextItem;
            dispose(OldEntry)
          end;
      List.LastEntry := nil
    end { disposemanuals };

  procedure MakeBase(var BaseAddress: RuntimeAddress);
  
    begin
      with BaseAddress do
        begin
          BlockLevel := FrameLevel;
          if FrameLevel = GlobalLevel
          then Area := GlobalArea(Files) else Area := Stack;
          if NegativeStack
          then ByteOffset := -FirstOffset
          else ByteOffset := FirstOffset;
          Adid := 0
        end
    end { MakeBase };

  procedure InitializeVariables;
    visible;
    
    var FrameBase: RuntimeAddress;
    
    begin
      if not (UChecks in Requested)
      then
        with TopFrameEntry^ do
          if FileList.FirstEntry <> nil
          then
            begin
              MakeBase(FrameBase);
              StackReference(false, FrameBase);
              OpenWith(FrameLevel);
              ProcessManuals(FrameLevel, FileList, true);
              CloseWith
            end
    end { initialisevariables };
  
  procedure FinalizeVariables;
    visible;
    
    var FrameBase: RuntimeAddress;
    
    begin
      with TopFrameEntry^ do
        if FileList.FirstEntry <> nil
        then
          begin
            MakeBase(FrameBase);
            StackReference(false, FrameBase);
            OpenWith(FrameLevel);
            ProcessManuals(FrameLevel, FileList, false);
            CloseWith;
            DsposeManuals(FileList)
          end
    end { finalizevariables };
  
  begin 
  { end of module }
  end.