{

 History
 -------

 12/09/85 - new include files impint.pf & eput.pf, amend procedures
	  - EnterProgram, EnterPfBody, ExitProgram, LeaveProcedure &
	  - LeaveFunction.
 17/10/85 - amend PassArrayBounds, PassCAPBounds, LoadActuals, 
            CallBlock.
 21/10/85 - reformatted. (agh)
 21/10/85 - removed calls to AugmentSchema from EnterPfBody.
            remove include text datareps.pas (agh)
 21/10/85 - modify body of PassArrayBounds to take account of 
            permanently packed character arrays. (agh)
 25/10/85 - Modify StackActualBlock and StackFormalBlock to
            record Parameter-Space. Simplify LoadActuals and
            CallBlock accordingly. (agh)
 28/10/85 - Restructure ActualList and conformant-array parameter
            passing to take account of positive and negative
            stacks. (agh)
 04/11/85 - Change calls of AccessArea and AddressArea to match
            new parameter lists. (agh)
 07/11/85 - Modify PassValue to call ConvertInteger and AdjustSet
            when necessary. (agh)
 11/11/85 - Modify calls to paseprc to include parameter-space
            number and size. (agh)
 11/11/85 - Add CheckCAPBounds to perform range-checks when a
            conformant array is passed to an unbounded conformant
            array. (agh)
 26/11/85 - Re-implement conformant-array conformance checking
            for ICL Pascal. (agh)
 27/11/85 - Modify conformant array parameter passing to handle
            word-values (agh)
 03/12/85 - Changes to PassValue and PassCAPBounds to incorporate
            bit-level packing. (agh)
 04/12/85 - Remove CHKLWD and CHKUPD from CheckBounds. Replace
            by equivalent manual check. (agh)
 04/12/85 - Adjust conformant array bp-block so that third word
            always holds the actual byte size of the innermost
            dimension. (agh)
 09/12/85 - Pass actual-var parameters by calling LoadAddress
            followed by Eop(PUSHVAL). (agh)
 --------------------------------------------------------------------
 03/02/86 - call EstkResult from TakeResult
                                                                      }
{


                          MODULE 24


                     Generating Code For
                 Procedure and Function Calls





 24.1  Delayed Code Generation in Procedure Function Calls

 In the implementation of procedure and function calls delayed code
 generation is used at two levels:

 (a)  generation  of  parameter-passing  code  is  delayed   during
      analysis  of the actual parameter list for both procedure and
      function calls, and

 (b)  generation of parameter-passing and calling code for a  func-
      tion  is  further  delayed until code generation for the com-
      plete expression in which the function call occurs.

 Thus the procedures  StackActualBlock  and  StackFormalBlock  each
 push a stack record of variant BlockRef, which acts as the head of
 a list of actual parameter descriptors pointed to  by  the  fields
 First and Last.

 The stack record also holds the blocklabel for an actual block, or
 the address of the block descriptor for a formal block, for use in
 subsequent calling or block passing code.

                                                                     }

program ProcFuncCalls;
  
#include "globals.x"
#include "datareps.pf"
#include "storage.pf"
#include "varref.pf"
#include "expeval.pf"
#include "objvalues.pf"
#include "generator.pf"
#include "codeutils.pf"
#include "impint.pf"
#include "eput.pf"

  procedure StackActualBlock(var Body: BlockLabel; Space: ParamSpace);
    visible;
    
    var BlockEntry: StackEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          GetEntry(BlockEntry);
          with BlockEntry^ do
            begin
              Kind := BlockRef;
              CallToBeGenerated := true;
              First := nil;
              Last := nil;
              PSpace := Space;
              BlockKind := Actual;
              BlockBase := Body
            end;
          Push(BlockEntry)
        end
    end { stackactualblock };
  
  procedure StackFormalBlock(FAddress: RuntimeAddress; Space: ParamSpace);
    visible;
    
    var BlockEntry: StackEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          GetEntry(BlockEntry);
          with BlockEntry^ do
            begin
              Kind := BlockRef;
              CallToBeGenerated := true;
              First := nil;
              Last := nil;
              PSpace := Space;
              BlockKind := Formal;
              FormalAddress := FAddress
            end;
          Push(BlockEntry)
        end
    end { stackformalblock };
  
  {
  
   24.2  Delayed Parameter Passing
  
   The field CallToBeGenerated is initially true for both  procedures
   and  functions,  but  is  set false for functions by the procedure
   OpenParameterList (to effect the  further  delay  of  calling-code
   generation, as explained in Section 24.4).
  
   During parameter list analysis each actual parameter  is  appended
   to  the  list  headed  by the stacked block reference, by the pro-
   cedure ExtendActualList which is  called  by  the  interface  pro-
   cedures PassBlock, PassValue and PassReference.
  
   The interface procedure CloseParameterList has no useful  role  in
   this implementation strategy.
  
                                                                       }

  procedure ExtendActualList(ThisParam: ActualEntry); 
    
    begin
      with TopStackEntry^ do
        begin
          if NegativeStack
          then ThisParam^.Next := Last
          else
            begin
              ThisParam^.Next := nil;
              if First = nil 
              then First := ThisParam else Last^.Next := ThisParam
            end;
          Last := ThisParam
        end
    end { extendactuallist };
  
  procedure OpenParameterList(ClassOfCall: IdClass);
    visible;
    
    begin
      if CodeIsToBeGenerated
      then
        if ClassOfCall = Func 
        then TopStackEntry^.CallToBeGenerated := false
    end { openparameterlist };
  
  procedure PassValue(RepRequired: TypeRepresentation);
    visible;
    
    var 
      ThisActual: ActualEntry;
      Expression: StackEntry;
      ExpnSize, FormalSize: ByteRange;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          Pop(Expression);
          if RChecks in Requested
          then
            if RepRequired.Kind = ForSet
            then SelectCheck(Expression, 8) 
            else SelectCheck(Expression, 7);
          if RepRequired.Kind <= ForSet
          then
            case RepRequired.Kind of
              ForScalar, ForChar, ForWord :
                begin
                  with Expression^ do
                    if Kind = Reference
                    then
                      case AccessKind of
                        Bits : ExpnSize := MCBytesPerWord;
                        Bytes : ExpnSize := ByteSize;
                        Words : ExpnSize := DataSize(DataRep)
                      end
                    else ExpnSize := MCBytesPerWord;
                  FormalSize := DataSize(RepRequired);
                  if FormalSize < ExpnSize
                  then ConvertInteger(FormalSize, Expression)
                end;
              ForSet :
                if Expression^.Kind = AConstant
                then AdjustSet(RepRequired.WordSize, Expression)
            end;
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsValue;
              ActualParam := Expression;
              FormalRep := Reprequired
            end;
          ExtendActualList(ThisActual)
        end
    end { passvalue };
  
  procedure PassReference(RefStatus: RefSecurity);
    visible;
    
    var ThisActual: ActualEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsVar;
              Pop(ActualParam)
            end;
          ExtendActualList(ThisActual)
        end
    end { passreference };
  
  procedure PassBlock;
    visible;
    
    var ThisActual: ActualEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsBlock;
              Pop(ActualParam)
            end;
          ExtendActualList(ThisActual)
        end
    end { passblock };
  
  procedure CloseParameterList;
    visible;
    
    begin  end;
  
{+doc 24.3  Conformant Array Parameters }

  procedure StartBoundPairs;
    visible;
    
    begin  end;

  procedure PassArrayBounds(ActualLowBound, ActualHighBound: ObjectValue;
                            SchemaLowBound, SchemaHighBound: CAPBound;
                            IndexLow, IndexHigh: ObjectValue;
                            LastLevel: Boolean;
                            ElementRep: TypeRepresentation; 
                            ArrayPacked: Boolean);
    visible;
    
    var
      BoundError: Boolean;
      WordsNeeded, Members: Scalar;
      ElsPerWord: MCBitRange;
      BoundPair: BpEntry;
      Expression: StackEntry;
      ThisActual: ActualEntry;
      LowerBoundTest, UpperBoundTest: BoundTest;
      StoreUnit: AccessUnit;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          if RChecks in Requested
          then
            begin
              with SchemaLowBound do
                if Fixed
                then BoundError := not SameValue(ActualLowBound, Value)
                else BoundError := OrderedValues(ActualLowBound, IndexLow);
              if BoundError
              then
                begin
                  PredictedError(59);
                  LowerBoundTest := RngError
                end
              else LowerBoundTest := NoTest;
              with SchemaHighBound do
                if Fixed
                then BoundError := not SameValue(ActualHighBound, Value)
                else BoundError := OrderedValues(IndexHigh,ActualHighBound);
              if BoundError  
              then
                begin
                  PredictedError(59);
                  UpperBoundTest := RngError
                end
              else UpperBoundTest := NoTest
            end
          else
            begin
              LowerBoundTest := NoTest;
              UpperBoundTest := NoTest
            end;
          if LastLevel
          then
            begin
              StoreUnit := IndexUnit(ArrayPacked, ElementRep);
              Members := Range(ActualLowBound, ActualHighBound);
              case StoreUnit of
                Bits :
                  begin
                    ElsPerWord := MCBitsPerWord div ElementRep.BitSize;
                    WordsNeeded := WordsFor(Members, ElsPerWord)
                  end;
                Bytes :
                  begin
                    ElsPerWord := MCBytesPerWord div ElementRep.ByteSize;
                    WordsNeeded := WordsFor(Members, ElsPerWord);
                  end;
                Words : 
                  WordsNeeded := Members * ElementRep.WordSize
              end
            end
          else WordsNeeded := ElementRep.WordSize;
          new(BoundPair);
          with BoundPair^ do
            begin
              Size := WordsNeeded * MCBytesPerWord;
              Lower := ActualLowBound.Ival;
              Upper := ActualHighBound.Ival;
              LowerTest := LowerBoundTest;
              UpperTest := UpperBoundTest;
              WordBounds := (IndexLow.Kind = BaseValue);
              CAPBounds := false
            end;
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsBounds;
              BdPair := BoundPair
            end;
          Pop(Expression);
          ExtendActualList(ThisActual);
          Push(Expression)
        end
    end { passarraybounds };
  
  procedure PassCAPBounds(LowBound, HighBound, 
                          SchemaLowBound, SchemaHighBound: CAPBound;
                          IndexLow, IndexHigh: ObjectValue;
                          BoundPairRep: TypeRepresentation);
    visible;
    
    var 
      BoundPair: BpEntry;
      BoundError: Boolean;
      Expression: StackEntry;
      ThisActual: ActualEntry;
      LowerBoundTest, UpperBoundTest: BoundTest; 
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          if RChecks in Requested
          then
            begin
              with SchemaLowBound do
                if Fixed
                then
                  if LowBound.Fixed
                  then
                    if not SameValue(LowBound.Value, Value)
                    then
                      begin
                        PredictedError(59);
                        LowerBoundTest := RngError
                      end
                    else LowerBoundTest := NoTest
                  else LowerBoundTest := NeTest
                else LowerBoundTest := LtTest;
              with SchemaHighBound do
                if Fixed
                then
                  if HighBound.Fixed
                  then
                    if not SameValue(HighBound.Value, Value)
                    then
                      begin
                        PredictedError(59);
                        UpperBoundTest := RngError
                      end
                    else UpperBoundTest := NoTest
                  else UpperBoundTest := NeTest
                else UpperBoundTest := GtTest
            end
          else
            begin
              LowerBoundTest := NoTest;
              UpperBoundTest := NoTest
            end;   
          new(BoundPair);
          with BoundPair^ do
            begin
              Size := BoundPairRep.WordSize * MCBytesPerWord;
              if LowerBoundTest = NeTest
              then Lower := SchemaLowBound.Value.Ival
              else Lower := IndexLow.Ival;
              if UpperBoundTest = NeTest
              then Upper := SchemaHighBound.Value.Ival
              else Upper := IndexHigh.Ival;
              LowerTest := LowerBoundTest;
              UpperTest := UpperBoundTest;
              WordBounds := (IndexLow.Kind = BaseValue);
              CAPBounds := true;
              BpAddress := LowBound.Address;
            end;
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsBounds;
              BdPair := BoundPair
            end;
          Pop(Expression);
          ExtendActualList(ThisActual);
          Push(Expression)
        end
    end { passcapbounds };

  procedure CheckCAPBounds(LowBound, HighBound: CAPBound;
                           IndexLow, IndexHigh: ObjectValue);
    visible;

    var
      BoundPair: BpEntry;
      Expression: StackEntry;
      ThisActual: ActualEntry;
      LowerBoundTest, UpperBoundTest: BoundTest;

    begin
      if CodeIsToBeGenerated 
      then
        begin
          if RChecks in Requested
          then
            begin
              with LowBound do
                if Fixed
                then
                  if OrderedValues(Value, IndexLow)
                  then
                    begin
                      PredictedError(59);
                      LowerBoundTest := RngError
                    end
                  else LowerBoundTest := NoTest
                else LowerBoundTest := LtdTest;
              with HighBound do
                if Fixed 
                then
                  if OrderedValues(IndexHigh, Value)
                  then
                    begin
                      PredictedError(59);
                      UpperBoundTest := RngError
                    end
                  else UpperBoundTest := NoTest
                else UpperBoundTest := GtdTest
            end
          else
            begin
              UpperBoundTest := NoTest;
              LowerBoundTest := NoTest
            end;
          new(BoundPair);
          with BoundPair^ do
            begin
              Lower := IndexLow.Ival;
              Upper := IndexHigh.Ival;
              LowerTest := LowerBoundTest;
              UpperTest := UpperBoundTest;
              WordBounds := (IndexLow.Kind = BaseValue);
              CAPBounds := true;
              BpAddress := LowBound.Address
            end;
          new(ThisActual);
          with ThisActual^ do
            begin
              Kind := IsCheck;
              BdPair := BoundPair
            end;
          Pop(Expression);
          ExtendActualList(ThisActual);
          Push(Expression)
        end
    end { CheckCAPBounds };

  procedure CheckArrayBounds(LowBound, HighBound, 
                             IndexLow, IndexHigh: ObjectValue);
    visible;

    begin
      if CodeIsToBeGenerated and (RChecks in Requested)
      then
        if OrderedValues(LowBound, IndexLow) or
           OrderedValues(IndexHigh, HighBound)
        then PredictedError(59)
    end { CheckArrayBounds }; 
  
  procedure MakeAuxiliary(RepRequired: TypeRepresentation);
    visible;

    var Expression, Copy: StackEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          Pop(Expression);
          Load(Expression);
          FreeEntry(Expression);
          GetReference(Copy);
          with Copy^ do
            begin
              Acquire(DataBytes(RepRequired), Stack, BaseAddress);
              AddressArea(BaseAddress, 0, MCBytesPerWord);
              Eop(Estore)
            end;
          Push(Copy)
        end
    end;
  
  {
  
   In this implementation, the  copying  of  value  conformant  array
   parameters is carried out within the receiving block, as explained
   in Chapter 26, so the interface procedure MakeAuxiliary is  redun-
   dant.

   24.4  Generation of Calling Code

   Calling code for both procedures and functions is generated by the
   procedure  CallBlock.   For  procedures  this occurs as the direct
   result of the corresponding interface  call.   For  functions  the
   interface  call pushes an expression node representing the delayed
   function call onto the stack, but the  subsequent  application  of
   Load to this node makes a further call to CallBlock, with the flag
   CallToBeGenerated reset to true, to generate  the  actual  calling
   code.
  
   The procedure LoadActuals generates the code required to load  the
   actual  parameters onto the runtime evaluation stack, by interpre-
   tation of the actual parameter descriptors appended to  the  block
   reference.
  
   Since execution of a function call by  the  P-machine  leaves  the
   function  result on the top of the evaluation stack, i.e. 'loaded'
   the procedure TakeResult need only add the  result  representation
   to the expression node which denotes a call.
  
                                                                       }

  procedure PassCheckedBounds(BoundPair: BpEntry);

    procedure PassLowBound;
    
      begin
        with BoundPair^ do
          begin
            AccessArea(BpAddress, 0, MCBytesPerWord);
            if LowerTest <> NoTest
            then
              begin
                if LowerTest = RngError
                then
                  begin
                    Estklit(59);
                    Epasop(TRAP)
                  end
                else
                  begin
                    Estklit(Lower);
                    Estklit(59);
                    Epasop(BoundCheck[WordBounds, LowerTest])
                  end
              end;
            Eop(PUSHVAL)
          end
      end { PassLowBound };

    procedure PassHighBound;

      begin
        with BoundPair^ do
          begin
            AccessArea(BpAddress, MCBytesPerWord, MCBytesPerWord);
            if UpperTest <> NoTest
            then
              begin
                if UpperTest = RngError
                then
                  begin
                    Estklit(59);
                    Epasop(TRAP)
                  end
                else
                  begin
                    Estklit(Upper);
                    Estklit(59);
                    Epasop(BoundCheck[WordBounds, UpperTest])
                  end
              end;
            Eop(PUSHVAL)
          end
      end { PassLowBound };

    procedure PassSize;

      begin
        with BoundPair^ do
          begin
            AccessArea(BpAddress, 2 * MCBytesPerWord, MCBytesPerWord);
            Eop(PUSHVAL)
          end
      end { PassSize };

    begin
      if NegativeStack then PassSize else PassLowBound;
      PassHighBound;
      if NegativeStack then PassLowBound else PassSize
    end { PassCheckedBounds };

  procedure PassConstBounds(BoundPair: BpEntry);

    procedure PassLowBound;

      begin
        with BoundPair^ do
          if LowerTest = RngError
          then
            begin
              Estklit(59);
              Epasop(TRAP)
            end
          else
            begin
              Estklit(Lower);
              Eop(PUSHVAL)
            end
      end { PassLowBound };

    procedure PassHighBound;

      begin
        with BoundPair^ do
          if UpperTest = RngError
          then
            begin
              Estklit(59);
              Epasop(TRAP)
            end
          else
            begin
              Estklit(Upper);
              Eop(PUSHVAL)
            end
      end { PassHighBound };

    procedure PassSize;

      begin
        with BoundPair^ do
          begin
            Estklit(Size);
            Eop(PUSHVAL)
          end
      end { PassSize };

    begin
      if NegativeStack then PassSize else PassLowBound;
      PassHighBound;
      if NegativeStack then PassLowBound else PassSize
    end { PassConstBounds };

  procedure CopyBpBlocks(var ThisActual: ActualEntry);

    procedure SkipToLastPair(NextActual: ActualEntry);

      begin
        while NextActual^.Kind = IsBounds do
          begin
            dispose(ThisActual^.Bdpair);
            dispose(ThisActual);
            ThisActual := NextActual;
            NextActual := ThisActual^.Next
          end
      end { SkipToLastPair };

    procedure CopyBlock(BoundPair: BpEntry);

      begin
        with BoundPair^ do
          begin
            AddressArea(BpAddress, 0, MCBytesPerWord);
            Estklit(Size);
            Eop(PUSHBYTES)
          end
      end { CopyBlock };
    
    begin
      if NegativeStack
      then
        begin
          SkipToLastPair(ThisActual^.Next);
          CopyBlock(ThisActual^.Bdpair)
        end
      else
        begin
          CopyBlock(ThisActual^.BdPair);
          SkipToLastPair(ThisActual^.Next)
        end
    end { CopyBlocks };

  procedure CheckBounds(BoundPair: BpEntry);

    begin
      with BoundPair^ do
        begin
          if LowerTest <> NoTest
          then
            begin
              if LowerTest = LtdTest
              then
                begin
                  AccessArea(BpAddress, 0, MCBytesPerWord);
                  Estklit(Lower);
                  if WordBounds
                  then { Etrap(ULT, 59) else Etrap(ILT, 59) }
                end
              else
                begin
                  Estklit(59);
                  Epasop(TRAP)
                end
            end;
          if UpperTest <> NoTest
          then
            begin
              if UpperTest = GtdTest
              then
                begin
                  AccessArea(BpAddress, MCBytesPerWord, MCBytesPerWord);
                  Estklit(Upper);
                  if WordBounds
                  then { Etrap(UGT, 59) else Etrap(IGT, 59) }
                end
              else
                begin
                  Estklit(59);
                  Epasop(TRAP)
                end
            end
        end
    end { CheckBounds };

  procedure LoadActuals(ThisActual: ActualEntry);
    
    var
      NextActual: ActualEntry;
    
    begin
      while ThisActual <> nil do
        begin
          with ThisActual^ do
            begin
              case Kind of
                IsValue :
                  begin
                    Load(ActualParam);
                    Eop(PUSHVAL)
                  end;
                IsRef, IsVar :
                  begin
                    LoadAddress(ActualParam);
                    Eop(PUSHVAL)
                  end;
                IsBlock :
                  begin
                    with ActualParam^ do
                      if BlockKind = Actual
                      then
                        with BlockBase do Eprocref(LabelId, BlockLevel)
                      else
                        AccessArea(FormalAddress, 0, MCBytesPerWord);
                    Eop(PUSHVAL)
                  end;
                IsBounds :
                  with Bdpair^ do
                    if CAPBounds
                    then
                      if RChecks in Requested
                      then PassCheckedBounds(BdPair)
                      else CopyBpBlocks(ThisActual)
                    else PassConstBounds(BdPair);
                IsCheck :
                  CheckBounds(BdPair)
              end;
              if Kind = IsBounds
              then dispose(BdPair) else FreeEntry(ActualParam);
              NextActual := Next
            end;
          dispose(ThisActual);
          ThisActual := NextActual
        end
    end { loadactuals };
  
  procedure CallBlock;
    visible;
    
    var
      CallEntry, BlockEntry: StackEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          Pop(BlockEntry);
          if BlockEntry^.CallToBeGenerated
          then
            begin
              with BlockEntry^ do
                begin
                  if BlockKind = Actual
                  then Eprecall(BlockBase.LabelId)
                  else Eprecall(-1);
                  if NegativeStack
                  then LoadActuals(Last) else LoadActuals(First);
                  if BlockKind = Actual
                  then 
                    Ecall(BlockBase.LabelId, PSpace.Number, PSpace.Size)
                  else
                    begin
                      AccessArea(FormalAddress, 0, MCBytesPerWord);
                      Eop(ARGPROC)
                    end
                end;
              FreeEntry(BlockEntry)
            end
          else
            begin
              GetEntry(CallEntry);
              with CallEntry^ do
                begin
                  Kind := Operation;
                  OpForm := BlockCall;
                  FnBlockEntry := BlockEntry
                end;
              Push(CallEntry)
            end
        end
    end { callblock };
  
  procedure TakeResult(Representation: TypeRepresentation);
    visible;
    
    begin
      if CodeIsToBeGenerated 
      then TopStackEntry^.DataRep := Representation;
      with Representation do
        if Kind = ForReal
        then
           EstkResult(0, 2, MCRealSize * MCBytesPerWord)
        else
           EstkResult(0, 1, MCBytesPerWord)
    end { takeresult };
  
  {
  
   24.5 Block Entry and Exit Code
  
   All aspects of block entry concerning  stack  frame  creation  and
   initialisation  are  handled  by  the  appropriate 'block-call' P-
   codes. However, the diagnostics procedure StartOfBody is called to
   record  the  source-line number of  the start of the block body on
   the Codemap file. For procedures or  functions  taking  conformant
   array  parameters,  the  procedure AugmentSchema is called to gen-
   erate internal procedures for the implementation of value  confor-
   mant arrays.
  
   Stack house-keeping on block exit is likewise performed internally
   by  the 'block-exit' P-codes. Prior to leaving a function however,
   code is generated to load the function result and check that it is
   defined. P-codes EndFunction and EndMultiFunction are used depend-
   ing upon whether the function has a single or multi-word result.
  
                                                                       }

  procedure StartOfBody(Serial: SerialRange; SourceLine: Scalar);
    
    { No known function at present. }

    begin  end;
  
  procedure EnterProgram(ProgId: IdEntry; SourceLine: Scalar);
    visible;
    
    var Property, LabId: integer;
    
    begin
      with ProgId^ do
        begin
          Property := -maxint;
	  Property := 2;
	  LabId := ProgBody.LabelId;
          with TopFrameEntry^ do
            paseprc
              (ProgBody.Adid, ProgBody.BlockLevel, Property,
               0, 0, StackOffset, LabId);
          ProgBody.LabelId := LabId;
          StartOfBody(Serial, SourceLine)
        end
    end { EnterProgram };
  
  procedure EnterPfBody(PfId: IdEntry; SourceLine: Scalar);
    visible;
    
    var
      Property, LabId: integer;
    
    begin
      with Pfid^ do
        begin
          if BlockKind = VisibleBlock 
          then Property := 1 else Property := 0;
          LabId := CodeBody.LabelId;
          with TopFrameEntry^ do
            paseprc
             (CodeBody.Adid, CodeBody.BlockLevel, Property, 
              FSpace.Number, FSpace.Size, StackOffset, LabId);
          CodeBody.LabelId := LabId
        end
    end { enterpfbody };
  
  procedure ExitProgram;
    visible;
    
    begin
      if CodeIsToBeGenerated
      then
        with TopFrameEntry^ do
          Eprocend(StackOffset, 0, Next^.StackOffset)
    end { leaveprogram };
  
  procedure LeaveProcedure;
    visible;
    
    begin
      if CodeIsToBeGenerated
      then
        with TopFrameEntry^ do
          Eprocend(StackOffset, 0, Next^.StackOffset)
    end { leaveprocedure };
  
  procedure LeaveFunction(Result: RuntimeAddress;
                          Representation: TypeRepresentation);
    visible;
    
    var ResultEntry: StackEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          StackReference(false, Result);
          DeReference(Representation);
          Pop(ResultEntry);
          if UChecks in Requested then ResultEntry^.RunError := 48;
          Load(ResultEntry);
          FreeEntry(ResultEntry);
          with Representation do
            if Kind = ForReal
            then Eop(EREALRES) else Eop(EINTRES);
          with TopFrameEntry^ do
            Eprocend(StackOffset, 0, Next^.StackOffset);
        end
    end { leavefunction };
  
  begin 
  { end of module }
  end.