{

                          CHAPTER 23


                     Generating Code For
                 Procedure and Function Calls





 23.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.

                                                                     }

procedure StackActualBlock {var Body: BlockLabel};

  var BlockEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        GetEntry(BlockEntry);
        with BlockEntry^ do
          begin
            Kind := BlockRef;
            CallToBeGenerated := true;
            First := nil;
            Last := nil;
            BlockKind := Actual;
            BlockBase := Body
          end;
        Push(BlockEntry)
      end
  end { stackactualblock };

procedure StackFormalBlock {FAddress: RuntimeAddress};

  var BlockEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        GetEntry(BlockEntry);
        with BlockEntry^ do
          begin
            Kind := BlockRef;
            CallToBeGenerated := true;
            First := nil;
            Last := nil;
            BlockKind := Formal;
            FormalAddress := FAddress
          end;
        Push(BlockEntry)
      end
  end { stackformalblock };

{

 23.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 23.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 OpenParameterList {ClassOfCall: IdClass};

  begin
    if CodeIsToBeGenerated
    then
      if ClassOfCall = Func
      then TopStackEntry^.CallToBeGenerated := false
  end { openparameterlist };

procedure ExtendActualList(ThisParam: StackEntry;
                           ThisKind: ActualKind);

  var ThisEntry: ActualEntry;

  begin
    new(ThisEntry);
    with ThisEntry^ do
      begin
        Next := nil;
        Kind := ThisKind;
        case ThisKind of
          IsValue, IsRef, IsVar, IsBlock : ActualParam := ThisParam;
          IsBounds : BpList := nil
        end
      end;
    with TopStackEntry^ do
      begin
        if First = nil
        then First := ThisEntry else Last^.Next := ThisEntry;
        Last := ThisEntry
      end
  end { extendactuallist };

procedure PassValue {RepRequired: TypeRepresentation};

  var ActualParam: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(ActualParam);
        if Checks in Requested
        then
          if RepRequired.Kind = ForSet
          then SelectCheck(ActualParam, 8)
          else SelectCheck(ActualParam, 7);
        ExtendActualList(ActualParam, IsValue);
        TopStackEntry^.Last^.FormalRep := RepRequired
      end
  end { passvalue };

procedure PassReference {RefStatus: RefSecurity};

  var ActualParam: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(ActualParam);
        case RefStatus of
          Secure : ExtendActualList(ActualParam, IsRef);
          MayBeInsecure : ExtendActualList(ActualParam, IsVar)
        end
      end
  end { passreference };

procedure PassBlock;

  var BlockEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(BlockEntry);
        ExtendActualList(BlockEntry, IsBlock)
      end
  end { passblock };

procedure CloseParameterList;

  begin  end;

{

 23.3  Conformant Array Parameters

 Within the above scheme each conformant array parameter is  passed
 as a reference, but the bound pairs are passed 'before' the actual
 parameters corresponding to  any  conformant  array  schema  (i.e.
 after  the first actual reference has been created, but before the
 corresponding call to PassReference).  The sequence of bound pairs
 passed  are  represented  on the actual parameter list by a header
 for a secondary list of bound pairs, created by the interface pro-
 cedure StartBoundPairs.

 The procedure AppendBounds is used to extend this  list,  by  each
 subsequent call to PassArrayBoundPair or PassCAPBoundPair.

                                                                     }

procedure StartBoundPairs;

  begin
    if CodeIsToBeGenerated then ExtendActualList(nil, IsBounds)
  end { startboundpairs };

procedure AppendBound(BoundPair: BpEntry);

  var LastBound: BpEntry;

  begin
    with TopStackEntry^.NextNode^.Last^ do
      if BpList = nil
      then BpList := BoundPair
      else
        begin
          LastBound := BpList;
          while LastBound^.Next <> nil do
            LastBound := LastBound^.Next;
          LastBound^.Next := BoundPair
        end
  end { appendbound };

procedure DisposeBounds(var Head: BpEntry);

  var ThisPair: BpEntry;

  begin
    while Head <> nil do
      begin
        ThisPair := Head;
        Head := ThisPair^.Next;
        dispose(ThisPair)
      end
  end { disposebounds };

procedure PassArrayBoundPair {ActualLowBound, ActualHighBound,
                              SchemaLowBound, SchemaHighBound:
                                ObjectValue;
                              Element: TypeRepresentation;
                              ArrayPacked: Boolean};

  var ElementsPacked: Boolean;
      Words,Members: Scalar;
      ElsPerWord: MCBitRange;
      BoundPair: BpEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        if Checks in Requested then
          if OrderedValues(ActualLowBound,SchemaLowBound) or
             OrderedValues(SchemaHighBound,ActualHighBound)
          then PredictedError(59);
        if CodeIsToBeGenerated
        then
          begin
            Members := Range(ActualLowBound,ActualHighBound);
            with Element do
              if WordSize>1
              then ElementsPacked := false
              else ElementsPacked := ArrayPacked and
                                     (BitSize<=MCBitsPerWord div 2);
            if ElementsPacked
            then
              begin
                ElsPerWord := MCBitsPerWord div Element.BitSize;
                Words := WordsFor(Members,ElsPerWord)
              end
            else
              Words := Element.WordSize;
            new(BoundPair);
            with BoundPair^ do
              begin
                Next := nil;
                CAPBounds := false;
                Lower := ActualLowBound.Ival;
                Upper := ActualHighBound.Ival;
                Size := Words
              end;
            AppendBound(BoundPair)
          end
      end
  end { passarrayboundpair };

procedure PassCAPBoundPair {LowBoundAddress,
                            HighBoundAddress: RuntimeAddress;
                            SchemaLowBound,
                            SchemaHighBound : ObjectValue;
                            BoundPairRep: TypeRepresentation};

  var BoundPair: BpEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        new(BoundPair);
        with BoundPair^ do
          begin
            Next := nil;
            Lower := SchemaLowBound.Ival;
            Upper := SchemaHighBound.Ival;
            CAPBounds := true;
            BpAddress := LowBoundAddress;
            Size := BoundPairRep.WordSize
          end;
        AppendBound(BoundPair)
      end
  end { passcapboundpair };

procedure MakeAuxiliary {RepRequired: TypeRepresentation};

  begin  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.

 23.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 LoadActuals(ThisActual: ActualEntry);

  var NextActual: ActualEntry;
      ActualSize: WordRange;
      BoundPair: BpEntry;

  begin
    while ThisActual <> nil do
      begin
        with ThisActual^ do
          begin
            case Kind of
              IsValue :
                begin
                  ActualSize := ActualParam^.DataRep.WordSize;
                  with FormalRep do
                    if Kind = ForSet
                    then
                      begin
                        Load(ActualParam);
                        Pcode1(SetExpand, WordSize);

                      end
                    else Load(ActualParam)
                end;
              IsRef : LoadAddress(ActualParam);
              IsVar :
                begin
                  ExtendReferences(ActualParam);
                  LoadAddress(ActualParam)
                end;
              IsBlock :
                with ActualParam^ do
                  if BlockKind = Actual
                  then
                    begin { load static link }
                       PCode1(LoadFmlP,BlockBase.BlockLevel);
{                      AccessWord(BlockBase.BlockLevel, 0, LoadRefOp);}
                      Pcode1(ConstWord, BlockBase.EntryOffset)
                    end
                  else
                    with FormalAddress do
                      begin
                        AccessWord(BlockLevel, WordOffset, LoadRefOp);
                        Pcode1(LoadMultiple, 2)
                      end;
              IsBounds :
                begin
                  BoundPair := BpList;
                  while BoundPair <> nil do
                    begin
                      with BoundPair^ do
                        if CAPBounds
                        then
                          if Checks in Requested
                          then
                            begin
                              with BpAddress do
                                AccessWord
                                  (BlockLevel, WordOffset, LoadOp);
                              InlineNumber(Lower);
                              Pcode1(CheckLower, 59);
                              with BpAddress do
                                AccessWord
                                  (BlockLevel, WordOffset + 1,
                                     LoadOp);
                              InlineNumber(Upper);
                              Pcode1(CheckUpper, 59);
                              with BpAddress do
                                AccessWord
                                  (BlockLevel, WordOffset + 2, LoadOp)
                            end
                          else
                            begin
                              with BpAddress do
                                AccessWord
                                  (BlockLevel, WordOffset, LoadRefOp);
                              Pcode1(LoadMultiple, Size);
                              DisposeBounds(Next)
                            end
                        else
                          begin
                            InlineNumber(Lower);
                            InlineNumber(Upper);
                            InlineNumber(Size)
                          end;
                      BoundPair := BoundPair^.Next
                    end
                end
            end;
            if Kind = IsBounds
            then DisposeBounds(BpList)
            else FreeEntry(ActualParam);
            NextActual := Next
          end;
        dispose(ThisActual);
        ThisActual := NextActual
      end
  end { loadactuals };

procedure CallBlock;

  var CallEntry, BlockEntry: StackEntry;
      OldDepth: Scalar;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(BlockEntry);
        if BlockEntry^.CallToBeGenerated
        then
          begin
            Pcode0(MarkStack);
            with BlockEntry^ do
              begin
                OldDepth := TopFrameEntry^.LockDepth;
                LoadActuals(First);
                if BlockKind = Actual
                then EmitCall(BlockBase)
                else
                  with FormalAddress do
                    begin
                      AccessWord(BlockLevel, WordOffset, LoadRefOp);
                      Pcode0(CallForml)
                    end;
                DiscardReferences(OldDepth)
              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};

  begin
    if CodeIsToBeGenerated
    then TopStackEntry^.DataRep := Representation
  end { takeresult };

{

 23.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);
  forward;

procedure EnterProgram {ProgId: IdEntry; SourceLine: Scalar};

  begin StartOfBody(ProgId^.Serial, SourceLine) end;

procedure EnterPfBody {PfId: IdEntry; SourceLine: Scalar};

  var ThisFormal: FormalEntry;

  begin
    with Pfid^ do
      begin
        ThisFormal := Formals;
        while ThisFormal <> nil do
          with ThisFormal^ do
            begin
              if Parm = BoundParm then AugmentSchema(FormalType);
              ThisFormal := Next
            end;
        StartOfBody(Serial, SourceLine)
      end
  end { enterpfbody };

procedure LeaveProgram;

  begin
    if CodeIsToBeGenerated then Pcode0(HaltProgram)
  end { leaveprogram };

procedure LeaveProcedure;

  begin
    if CodeIsToBeGenerated then Pcode0(EndProcedure)
  end { leaveprocedure };

procedure LeaveFunction {Result: RuntimeAddress;
                         Representation: TypeRepresentation};

  var ResultEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        StackReference(false, Result);
        DeReference(Representation);
        Pop(ResultEntry);
        if Checks in Requested then ResultEntry^.RunError := 48;
        Load(ResultEntry);
        FreeEntry(ResultEntry);
        with Representation do
          if WordSize = 1
          then Pcode0(EndFunction)
          else Pcode1(EndMultiFunction, WordSize)
      end
  end { leavefunction };