{

                          MODULE 23


                      Control Structures





 This chapter implements the interface procedures for  the  genera-
 tion of control structures as defined in Section 5.1O.

 22.1  Code Labels and Jumps

 The representation of code labels, the nature of jump instructions
 on the P-machine, and the fix-up mechanism used for forward jumps,
 were defined in Chapter 18.  Using these, the interface procedures
 that  bind  code  labels  to corresponding points in the generated
 code stream, and generate the conditional and unconditional  jumps
 required  for  basic control operations, are easily implemented as
 follows:

                                                                     }

program ctlstructs;

#include "globals.x"
#include "varref.pf"
#include "codeutils.pf"
#include "generator.pf"
#include "interface.pf"

procedure NewCodeLabel (var L: CodeLabel);
visible;

  begin
   { with L do
      begin
        Linked := false;
        Expected := false;
        PCode0(JumpDest);
        Address := CodeCounter
      end }
  end { newcodelabel };

procedure FutureCodeLabel (var L: CodeLabel);
visible;

  begin
    { with L do
      begin
        Linked := false;
        Expected := true;
        LastReference := nil
      end }
  end { futurecodelabel };

procedure NxIsCodeLabel (var L: CodeLabel);
visible;

  begin
   { PCode0(JumpDest);
    FixUpJumps(L, CodeCounter);
    with L do
      begin
        Expected := false;
        Address := CodeCounter
      end }
  end { nextiscodelabel };

procedure JumpOnFalse (var Destination: CodeLabel);
visible;

  var BooleanEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(BooleanEntry);
        with BooleanEntry^ do
          if Kind = AConstant
          then
            if TheConst.Ival = ord(true)
            then { do nothing }
            else JumpTo(Destination, Absolute)
          else
            begin
              Load(BooleanEntry);
              JumpTo(Destination, IfFalse)
            end
      end
  end { jumponfalse };

procedure Jump (var Destination: CodeLabel);
visible;

  begin
    if CodeIsToBeGenerated then JumpTo(Destination, Absolute)
  end { jump };

{


 22.2  Code Generation for Case Statements

 For simple one-pass compilation, all case selection code  is  gen-
 erated  after  the  code  for  the  case limbs involved. OpenCase,
 therefore, merely generates an  unconditional  jump  to  a  future
 codelabel  which  is  pushed  with  the selector expression onto a
 stack  of  case  (statement)  records  to  be  recovered  by   the
 corresponding CloseCase.

 During analysis of the case limbs the topmost case entry  acts  as
 the  head  of  an  ordered list of case label entries built by the
 sequence of call to NextIsCase.  The case label entries record the
 code  offset  of the case limb corresponding to each case label in
 ascending case label order.

 This list, together with the selector expression tree, enables the
 procedure CloseCase to generate the necessary case selection code.
 However, because the  Pascal  standard  allows  no  limits  to  be
 imposed  on the range of case labels involved, a simple jump table
 cannot always  be used for  case  selection.  CloseCase  therefore
 partitions  the ordered list of case label entries into a sequence
 of one or more sublists, each of which is suitable  for  selection
 th  rough  a  corresponding  sub-table.   The  maximum gap allowed
 between consecutive label entries  in  a  subtable  is  chosen  to
 minimise the overall code length that results.
 This set of subtables is then built into a binary  decision  tree,
 by  the function BuildTree, to enable the necessary subtable to be
 located by the minimum number of <= tests on the  selector  value.
 The recursive procedure EmitCaseCode is then applied to this deci-
 sion tree to generate the combination of  comparisons  and  table-
 driven casejumps required.  Note that subtables consisting of sin-
 gle case labels may arise and need  special  treatment  to  obtain
 acceptable selection code.

 The procedure InitCase initialises the  stack  of  case  statement
 records during code generation initialisation.


                                                                     }

procedure OpenCase;
visible;

  var ThisCase: CaseEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        new(ThisCase);
        with ThisCase^ do
          begin
            Pop(Selector);
            Load(Selector);
            {PCode0(CaseStart);}
            FutureCodeLabel(CaseCode);
            JumpTo(CaseCode, Absolute);
            MinLabel := nil;
            MaxLabel := nil;
            Next := TopCaseEntry
          end;
        TopCaseEntry := ThisCase
      end
  end { opencase };

procedure NxIsCase (CaseConst: ObjectValue);
visible;

  label 9;

  var PreviousLabel, ThisLabel, FollowingLabel: CaseLabelEntry;
      NewLabel: MCIntegerForm;

  begin
    if CodeIsToBeGenerated
    then
      begin
        {PCode1(CaseLab,CaseConst.IVal);}
        NewLabel := CaseConst.Ival;
        new(ThisLabel);
        with ThisLabel^ do
          begin
            LabelValue := NewLabel;
            LimbAddress := CodeCounter;
            NextLabel := nil
          end;
        with TopCaseEntry^ do
          begin
            if MinLabel = nil
            then
              begin
                MinLabel := ThisLabel;
                MaxLabel := ThisLabel
              end
            else
              begin
                PreviousLabel := nil;
                FollowingLabel := MinLabel;
                while FollowingLabel <> nil do
                  begin
                    if FollowingLabel^.LabelValue > NewLabel
                    then goto 9;
                    PreviousLabel := FollowingLabel;
                    FollowingLabel := FollowingLabel^.NextLabel
                  end;
                9:
                  if PreviousLabel = nil
                  then
                    begin
                      ThisLabel^.NextLabel := MinLabel;
                      MinLabel := ThisLabel
                    end
                  else
                    begin
                      ThisLabel^.NextLabel := FollowingLabel;
                      PreviousLabel^.NextLabel := ThisLabel;
                      if NewLabel >= MaxLabel^.LabelValue
                      then MaxLabel := ThisLabel
                    end
              end
          end
      end
  end { nextiscase };

procedure CloseCase;
visible;

  type DecPtr = ^Decision;
       DecList =
         record
           First, Last: DecPtr;
           Length: Scalar
         end;
       DecKinds = (Test, Table);
       Decision =
         record
           NextInList: DecPtr;
           case Kind: DecKinds of
             Test:
               (TestValue: MCIntegerForm;
                LePath, GtPath: DecPtr);
             Table: (MinLabel, MaxLabel: CaseLabelEntry)
         end;

  var ThisCase: CaseEntry;
      SubCases: DecList;
      DecisionTree: DecPtr;
      TrapNeeded: Boolean;

  procedure Start(var List: DecList);

    begin
      with List do
        begin
          First := nil;
          Last := nil;
          Length := 0
        end
    end { start };

  procedure Append(var List: DecList; Dec: DecPtr);

    begin
      with List do
        begin
          if First = nil
          then First := Dec else Last^.NextInList := Dec;
          Last := Dec;
          Last^.NextInList := nil;
          Length := Length + 1
        end
    end { append };

  procedure Remove(var List: DecList; var Dec: DecPtr);

    begin
      with List do
        begin
          Dec := First;
          First := Dec^.NextInList;
          Dec^.NextInList := nil;
          Length := Length - 1
        end
    end { remove };

  function SingleCase(DecNode: DecPtr): Boolean;

    begin
      with DecNode^ do
        if Kind <> Table
        then SingleCase := false
        else SingleCase := (MinLabel^.NextLabel = nil)
    end { singlecase };

  procedure PartitionCases(LabelList: CaseLabelEntry;
                           var TableList: DecList);

    var NextOne, ThisLabel: CaseLabelEntry;
        SubTable: DecPtr;
        MaxFound: Boolean;

    begin
      Start(TableList);
      ThisLabel := LabelList;
      while ThisLabel <> nil do
        begin
          new(SubTable);
          with SubTable^ do
            begin
              Kind := Table;
              MinLabel := ThisLabel
            end;
          MaxFound := false;
          NextOne := ThisLabel^.NextLabel;
          while (NextOne <> nil) and not MaxFound do
            if NextOne^.LabelValue - ThisLabel^.LabelValue >
                 MaxCaseGap
            then MaxFound := true
            else
              begin
                ThisLabel := NextOne;
                NextOne := ThisLabel^.NextLabel
              end;
          with ThisLabel^ do
            begin
              NextLabel := nil;
              SubTable^.MaxLabel := ThisLabel
            end;
          Append(TableList, SubTable);
          ThisLabel := NextOne
        end;
      TrapNeeded := SingleCase(SubTable)
    end { partitioncases };

  function BuildTree(List: DecList): DecPtr;

    var SubList: DecList;
        SubTest, LastDec: DecPtr;

    function MaxValue(Dec: DecPtr): MCIntegerForm;

      begin
        with Dec^ do
          if Kind = Table
          then MaxValue := MaxLabel^.LabelValue
          else MaxValue := MaxValue(GtPath)
      end { maxvalue };

    begin
      if List.Length = 1
      then BuildTree := List.First
      else
        begin
          Start(SubList);
          while List.Length > 1 do
            begin
              new(SubTest);
              with SubTest^ do
                begin
                  Kind := Test;
                  Remove(List, LePath);
                  Remove(List, GtPath);
                  TestValue := MaxValue(LePath)
                end;
              Append(SubList, SubTest)
            end;
          if List.Length <> 0
          then
            begin
              Remove(List, LastDec);
              Append(SubList, LastDec)
            end;
          BuildTree := BuildTree(SubList)
        end
    end { buildtree };

  procedure EmitCaseCode(DecNode: DecPtr);

    var FailLabel: CodeLabel;
        CaseLabel, ThisLabel: CaseLabelEntry;
        LabelIndex: MCIntegerForm;

    procedure JumpToLimb(Destination: CodeByteRange;
                         Condition: JumpType);

      var LimbLabel: CodeLabel;

      begin
       { with LimbLabel do
          begin
            Linked := false;
            Expected := false;
            Address := Destination
          end; }
        JumpTo(LimbLabel, Condition)
      end { jumptolimb };

    procedure TableWord(Datum: MCIntegerForm);

      var Buffer: MCWordForm;

      begin
        Buffer.WValue := Datum;
       { WordOfBytes(Buffer) }
      end { tableword };

    begin { emitcasecode }
      with DecNode^ do
        case Kind of
          Test :
            begin
              FutureCodeLabel(FailLabel);
              if not SingleCase(LePath)
              then
                begin
                  LoadValue(TopCaseEntry^.Selector);
                  {InlineNumber(TestValue);
                  Pcode0(TestILtOrEqual); }
                  JumpTo(FailLabel, IfFalse)
                end;
              EmitCaseCode(LePath);
              NxIsCodeLabel(FailLabel);
              EmitCaseCode(GtPath);
              dispose(LePath);
              dispose(GtPath)
            end;
          Table :
            begin
              {LoadValue(TopCaseEntry^.Selector);}
              if SingleCase(DecNode)
              then
                begin
                  {InlineNumber(MinLabel^.LabelValue);
                  Pcode0(TestIUnequal); }
                  JumpToLimb(MinLabel^.LimbAddress, IfFalse)
                end
              else
                begin
                  {Pcode0(CaseJump);
                  Align; }
                  TableWord(MinLabel^.LabelValue);
                  TableWord(MaxLabel^.LabelValue);
                  CaseLabel := MinLabel;
{                  for LabelIndex :=}
{                        MinLabel^.LabelValue to}
{                          MaxLabel^.LabelValue do}
{                    if LabelIndex = CaseLabel^.LabelValue}
{                    then}
{                      begin}
{                        TableWord}
{                          (CaseLabel^.LimbAddress - CodeCounter);}
{                        ThisLabel := CaseLabel;}
{                        CaseLabel := CaseLabel^.NextLabel;}
{                        dispose(ThisLabel)}
{                      end}
{                    else TableWord(0)}
                end
            end
        end
    end { emitcasecode };

  begin { closecase }
    if CodeIsToBeGenerated
    then
      begin
        with TopCaseEntry^ do
          begin
            NxIsCodeLabel(CaseCode);
            PartitionCases(MinLabel, SubCases);
            DecisionTree := BuildTree(SubCases);
            if not ((Selector^.Kind = AConstant) or
                    SimpleReference(Selector))
            then
              begin
                {Load(Selector);}
                {SaveValue(Selector)}
              end;
            EmitCaseCode(DecisionTree);
            {if TrapNeeded then Pcode1(TrapError, 51); }
            dispose(DecisionTree);
            FreeEntry(Selector)
          end;
        ThisCase := TopCaseEntry;
        TopCaseEntry := TopCaseEntry^.Next;
        dispose(ThisCase)
      end
  end { closecase };

procedure InitCase;
visible;

  begin TopCaseEntry := nil end;

{


 22.3  Code Generation for For-Statements

 Entry and exit code sequences for for-statements are generated  by
 procedures  OpenFor  and  CloseFor and communication between these
 two phases is achieved by embedding all necessary  information  in
 the  fields  of  a ForRecord. Nested for-statements are handled by
 building a stack of such records referenced by the  variable  Top-
 ForEntry.

 This  version  of  the  Model  Compiler  generates  minimal  entry
 sequences by:

 (1)  Exploiting the results of  range-analysis  to  eliminate  the
      entry-check  and  assignment compatibility range-checks wher-
      ever possible.

 (2)  Reversing the order of these so that range  checks  are  gen-
      erated  before then entry check. Whilst this approach is more
      convenient for stack machines, it  has  the  side  effect  of
      rejecting:

         for i := m to n do S ;     when m > n > upper bound of i
         for i := u downto l do S ; when u < l < lower bound of i

      which are in fact legal since the body of  the  for-statement
      is never entered.

 Minimal exit code sequences are generated by  ensuring  the  final
 control  variable  value  is  available as a known constant, or by
 direct reference to a storage location containing the value.  When
 the final value is  computed by expression evaluation, a temporary
 storage location is reserved to hold the result. The P-codes  Inc1
 and  Dec1  are used to increment or decrement the control variable
 accordingly. Prior to exiting then for-statement,  extra  code  is
 generated  when  checks have been selected, to postset the control
 variable to the 'undefined' value.

                                                                     }

procedure OpenFor (Increasing: Boolean;
                   ControlMin, ControlMax: ObjectValue);
visible;

  type LimitKinds = (Lower, Upper);

  var ThisFor: ForEntry;
      InitialEntry: StackEntry;
      TempNeeded, EntryTest: Boolean;

  procedure CheckLimit(Limit: StackEntry; Kind: LimitKinds);

    begin
      if Kind = Upper
      then
        begin
          if (ControlMax.Ival < Limit^.DataRep.Min)
          then PredictedError(53)
          else
            if (ControlMax.Ival < Limit^.DataRep.Max)
            then
              begin
                {InlineNumber(ControlMax.Ival);
                Pcode1(CheckUpper, 53)		}
              end
        end
      else
        begin
          if (Limit^.DataRep.Max < ControlMin.Ival)
          then PredictedError(52)
          else
            if (Limit^.DataRep.Min < ControlMin.Ival)
            then
              begin
                {InlineNumber(ControlMin.Ival);
                Pcode1(CheckLower, 52)		}
              end
        end
    end { checklimit };

  begin
    if CodeIsToBeGenerated
    then
      begin
        new(ThisFor);
        with ThisFor^ do
          begin
            Incrementing := Increasing;
            Pop(FinalEntry);
            Pop(InitialEntry);
            Pop(ControlVar);
            if Increasing
            then
              EntryTest :=
                (FinalEntry^.DataRep.Min < InitialEntry^.DataRep.Max)
            else
              EntryTest :=
                (InitialEntry^.DataRep.Min < FinalEntry^.DataRep.Max);
            Load(InitialEntry);
            if Checks in Requested
            then CheckLimit(InitialEntry, Lower);
            if Checks in Requested
            then
              if FinalEntry^.Kind = AConstant
              then CheckLimit(FinalEntry, Upper)
              else
                begin
                  TempNeeded := not SimpleReference(FinalEntry);
                  Load(FinalEntry);
                  CheckLimit(FinalEntry, Upper);
                  {if TempNeeded
                  then SaveValue(FinalEntry) else Pcode0(PopStack)}
                end
            else
              if (FinalEntry^.Kind <> AConstant) and
                 not SimpleReference(FinalEntry)
              then
                begin
                  Load(FinalEntry);
                  SaveValue(FinalEntry)
                end;
            with ControlVar^.BaseAddress do
              AccessWord(BlockLevel, WordOffset, StoreOp);
            FutureCodeLabel(EndOfLoop);
            if EntryTest
            then
              begin
                if Increasing
                then
                  begin
                    LoadValue(ControlVar);
                    LoadValue(FinalEntry)
                  end
                else
                  begin
                    LoadValue(FinalEntry);
                    LoadValue(ControlVar)
                  end;
                {Pcode0(TestILtOrEqual);	}
                JumpTo(EndOfLoop, IfFalse)
              end;
            NewCodeLabel(StartOfLoop);
            FreeEntry(InitialEntry);
            Next := TopForEntry
          end;
        TopForEntry := ThisFor
      end
  end { openfor };

procedure CloseFor;
visible;

  var ThisFor: ForEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        with TopForEntry^ do
          begin
            LoadValue(ControlVar);
            LoadValue(FinalEntry);
            {Pcode0(TestIUnequal);	}
            JumpTo(EndOfLoop, IfFalse);
            LoadValue(ControlVar);
            {if Incrementing then Pcode0(Inc1) else Pcode0(Dec1); }
            with ControlVar^.BaseAddress do
              AccessWord(BlockLevel, WordOffset, StoreOp);
            JumpTo(StartOfLoop, Absolute);
            NxIsCodeLabel(EndOfLoop);
            if Checks in Requested
            then
              begin
                with ControlVar^.BaseAddress do
                  AccessWord(BlockLevel, WordOffset, LoadRefOp);
                {Pcode0(PresetWord)}
              end;
            FreeEntry(FinalEntry);
            FreeEntry(ControlVar)
          end;
        ThisFor := TopForEntry;
        TopForEntry := TopForEntry^.Next;
        dispose(ThisFor)
      end
  end { closefor };

procedure InitFor;
visible;

  begin TopForEntry := nil end;

{


 22.4 Statement Labels

 The  procedures  FutureStatementLabel,  NextIsStatementLabel,  and
 LabelJump   respectively   handle   the  definition,  siting,  and
 referencing of all declared statement labels. Each such  label  is
 assigned a location in the data table which is subsequently filled
 with the appropriate branch address by  NextIsStatementlabel.  The
 data  table  location  and  the  current  block  nesting level are
 recorded in the  fields  BlockLevel  and  EntryOffset  of  a  Sta-
 tementLabel  record.  Thereafter, all jumps to this label are made
 indirectly via this data-table entry using the JumpVia P-code  for
 a local goto, or the JumpOut P-code for a non-local goto.

 Note that whenever a label is sited, extra code  is  generated  to
 discard  dangling  extended references that may result if the goto
 statement was situated in the body of a with-statement, or  within
 a  nested  procedure.   The  P-code  DiscardLocks  is  used to pop
 unwanted entries off the lock-stack until its depth coincides with
 that  determined  by  the textual position of the statement label.
 This mechanism is also  used  to  void  the  lock-stack  prior  to
 block-exit  by  defining  an  internal statement label to mark the
 start of a block finalisation code-sequence.


                                                                     }

procedure FutureStatementLabel (var L: StatementLabel);
visible;

  begin FutureBlockLabel(L) end;

procedure NextIsStatementLabel (var L: StatementLabel);
visible;

  var DataEntry: MCWordForm;

  begin
    {if CodeistobeGenerated then PCode0(JumpDest);	}
    DataEntry.Linked := true;
    DataEntry.Address := CodeCounter;
    {with L do FillWord(EntryOffset - 1, DataEntry);
    if CodeIsToBeGenerated then
    begin
        if (Checks in Requested) then
            Pcode1(DiscardLocks, TopFrameEntry^.LockDepth)
      end;							}
  end { nextisstatementlabel };

procedure LabelJump (var Destination: StatementLabel;
                     LabelLevel: DispRange);
visible;

  begin
    {if CodeIsToBeGenerated
    then
      if LabelLevel = FrameLevel
      then Pcode5(JumpVia, Destination.EntryOffset)
      else
        Pcode6
          (JumpOut, FrameLevel - LabelLevel, Destination.EntryOffset)	}
  end { labeljump };


begin
{ end of module}
end.