{

 History
 -------

 12/09/85 - change procedure Jump to procedure JumpAbs.
 25/09/85 - include eput.pf, new procedure InitPlabels,
            define FutureCodeLabel & NxIsCodeLabel.
 04/11/85 - change calls of AccessArea and AddressArea to
            match new parameter lists. (agh)
 05/11/85 - add e-code calls supporting for-statements and
            statement-labels. (agh)
 15/11/85 - add EmitCondition to emit short-circuit code for
            compound-Boolean conditions. (agh)
 15/11/85 - implement case-statement with label-ranges and
            otherwise clause. (agh)
 18/11/85 - add warning(5) indicating case-limbs that can
            never be executed. (agh)
 26/11/85 - extend case-statement implementation to permit
            word-valued labels. (agh)
 26/11/85 - extend for-statement implementation to permit
            word-valued limits. (agh)
 04/12/85 - remove references to CHKLWD, CHKUPD, UCHKLWD,
            UCHKUPD from CheckLimit and CheckWlimit. (agh)
 -------------------------------------------------------------------
 06/02/86 - Call ECaseJump & ECaseEntry from EmitCaseCode &
	    EmitWCaseCode. Call Egjump from LabelJump.
	    New include file impint.pf
                                                                    }
{


                          MODULE 23


                      Control Structures





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

 23.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 "source.pf"
#include "varref.pf"
#include "codeutils.pf"
#include "generator.pf"
#include "eput.pf"
#include "impint.pf"

  procedure MakeLabel(var L: Codelabel);
    
    begin
      L := PlabelId;
      PlabelId := PlabelId - 1
    end { MakeLabel };
  
  procedure InitPlabels;
    visible;
    
    begin PlabelId := -1 end;
  
  procedure NewCodeLabel(var L: CodeLabel);
    visible;
    
    begin
      MakeLabel(L);
      Elabel(L)
    end { NewCodeLabel };
  
  procedure FutureCodeLabel(var L: CodeLabel);
    visible;
    
    begin MakeLabel(L) end;
  
  procedure NxIsCodeLabel(var L: CodeLabel);
    visible;
    
    begin Elabel(L) end;
  
  {+doc 23.2 Jumps }

  function NestedCondition(Entry: StackEntry): Boolean;
    
    begin
      with Entry^ do
        if Kind <> Operation
        then NestedCondition := false
        else NestedCondition := (OpForm = Condition)
    end { NestedCondition };
  
  procedure ExitToFalse(Entry: StackEntry; FalseLabel: CodeLabel);
    forward;
  
  procedure ExitToTrue(Entry: StackEntry; TrueLabel: CodeLabel);
    
    var
      FalseLabel: CodeLabel;
      ThisEntry, NextEntry: StackEntry;
    
    begin
      with Entry^ do
        begin
          if BooleanOp = AndOp then FutureCodeLabel(FalseLabel);
          ThisEntry := OpList;
          while ThisEntry <> nil do
            begin
              NextEntry := ThisEntry^.NextNode;
              if NestedCondition(ThisEntry)
              then
                if NextEntry <> nil
                then
                  if BooleanOp = OrOp
                  then ExitToTrue(ThisEntry, TrueLabel)
                  else ExitToFalse(ThisEntry, FalseLabel)
                else ExitToTrue(ThisEntry, TrueLabel)
              else
                begin
                  Load(ThisEntry);
                  if NextEntry <> nil
                  then
                    if BooleanOp = OrOp
                    then JumpTo(TrueLabel, IfTrue)
                    else JumpTo(FalseLabel, IfFalse)
                  else JumpTo(TrueLabel, IfTrue)
                end;
              ThisEntry := NextEntry
            end;
          if BooleanOp = AndOp then NxIsCodeLabel(FalseLabel)
        end
    end { ExitToTrue };
  
  procedure ExitToFalse {Entry: StackEntry; FalseLabel: CodeLabel};
    
    var
      TrueLabel: CodeLabel;
      ThisEntry, NextEntry: StackEntry;
    
    begin
      with Entry^ do
        begin
          if BooleanOp = OrOp then FutureCodeLabel(TrueLabel);
          ThisEntry := OpList;
          while ThisEntry <> nil do
            begin
              NextEntry := ThisEntry^.NextNode;
              if NestedCondition(ThisEntry)
              then
                if NextEntry <> nil
                then
                  if BooleanOp = OrOp
                  then ExitToTrue(ThisEntry, TrueLabel)
                  else ExitToFalse(ThisEntry, FalseLabel)
                else ExitToFalse(ThisEntry, Falselabel)
              else
                begin
                  Load(ThisEntry);
                  if NextEntry <> nil
                  then
                    if BooleanOp = OrOp
                    then JumpTo(TrueLabel, IfTrue)
                    else JumpTo(FalseLabel, IfFalse)
                  else JumpTo(FalseLabel, IfFalse)
                end;
              ThisEntry := NextEntry
            end;
          if BooleanOp = OrOp then NxIsCodeLabel(TrueLabel)
        end
    end { ExitToFalse };
  
  procedure JumpOnFalse(var Destination: CodeLabel);
    visible;
    
    var
      BooleanEntry: StackEntry;
      Folded: Boolean;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          Pop(BooleanEntry);
          Folded := false;
          with BooleanEntry^ do
            if Kind = AConstant
            then
              begin
                if TheConst.Ival = ord(true)
                then { do nothing }
                else JumpTo(Destination, Absolute);
                Folded := true
              end
            else
              if Kind = Operation
              then
                begin
                  if (OpForm = Condition) and
                     (ShortCircuit in Requested)
                  then
                    begin
                      ExitToFalse(BooleanEntry, Destination);
                      Folded := true
                    end
                end;
          if not Folded
          then
            begin
              Load(BooleanEntry);
              JumpTo(Destination, IfFalse)
            end;
          FreeEntry(BooleanEntry)
        end
    end { jumponfalse };
  
  procedure JumpAbs(var Destination: CodeLabel);
    visible;
    
    begin
      if CodeIsToBeGenerated then JumpTo(Destination, Absolute)
    end { jump };
  
  {
  
  
   23.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);
              WordLabels := (Selector^.DataRep.Kind = ForWord);
              FutureCodeLabel(CaseCode);
              JumpTo(CaseCode, Absolute);
              MinLabel := nil;
              MaxLabel := nil;
              HasOtherwiseLimb := false;
              Next := TopCaseEntry
            end;
          TopCaseEntry := ThisCase
        end
    end { opencase };
  
  function MinOf(Entry: CaseLabelEntry): MCIntegerForm;
    
    begin
      with Entry^ do
        if IsRange then MinOf := MinValue else MinOf := LabelValue
    end { MinOf };
  
  function MaxOf(Entry: CaseLabelEntry): MCIntegerForm;
    
    begin
      with Entry^ do
        if IsRange then MaxOf := MaxValue else MaxOf := LabelValue
    end { MaxOf };
  
  procedure ExtendCaseList(NewLabel: CaseLabelEntry);
    
    label 9;
    
    var PreviousLabel, FollowingLabel: CaseLabelEntry;
    
    begin
      with TopCaseEntry^ do
        begin
          with Selector^.DataRep do
            if (MaxOf(NewLabel) < Min) or (MinOf(NewLabel) > Max)
            then WarningError(5); 
          if MinLabel = nil
          then
            begin
              MinLabel := NewLabel;
              MaxLabel := NewLabel
            end
          else
            begin
              PreviousLabel := nil;
              FollowingLabel := MinLabel;
              while FollowingLabel <> nil do
                begin
                  if MinOf(FollowingLabel) > MaxOf(NewLabel)
                  then goto 9;
                  PreviousLabel := FollowingLabel;
                  FollowingLabel := FollowingLabel^.NextLabel
                end;
              9 :
                if PreviousLabel = nil
                then
                  begin
                    NewLabel^.NextLabel := MinLabel;
                    MinLabel := NewLabel
                  end
                else
                  begin
                    NewLabel^.NextLabel := FollowingLabel;
                    PreviousLabel^.NextLabel := NewLabel;
                    if MinOf(NewLabel) >= MaxOf(MaxLabel)
                    then MaxLabel := NewLabel
                  end
            end
        end
    end { ExtendCaseList };
  
  procedure ExtendWCaseList(NewLabel: CaseLabelEntry);
    
    label 9;
    
    var PreviousLabel, FollowingLabel: CaseLabelEntry;
    
    begin
      with TopCaseEntry^ do
        begin
          with Selector^.DataRep do
            if (wrd(MaxOf(NewLabel)) < WMin) or 
               (wrd(MinOf(NewLabel)) > WMax)
            then WarningError(5); 
          if MinLabel = nil
          then
            begin
              MinLabel := NewLabel;
              MaxLabel := NewLabel
            end
          else
            begin
              PreviousLabel := nil;
              FollowingLabel := MinLabel;
              while FollowingLabel <> nil do
                begin
                  if wrd(MinOf(FollowingLabel)) > wrd(MaxOf(NewLabel))
                  then goto 9;
                  PreviousLabel := FollowingLabel;
                  FollowingLabel := FollowingLabel^.NextLabel
                end;
              9 :
                if PreviousLabel = nil
                then
                  begin
                    NewLabel^.NextLabel := MinLabel;
                    MinLabel := NewLabel
                  end
                else
                  begin
                    NewLabel^.NextLabel := FollowingLabel;
                    PreviousLabel^.NextLabel := NewLabel;
                    if wrd(MinOf(NewLabel)) >= wrd(MaxOf(MaxLabel))
                    then MaxLabel := NewLabel
                  end
            end
        end
    end { ExtendWCaseList };

  procedure NxIsCase(CaseConst: ObjectValue);
    visible;
    
    var NewLabel: CaseLabelEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          new(NewLabel);
          with NewLabel^ do
            begin
              NextLabel := nil;
              NewCodeLabel(LimbLabel);
              IsRange := false;
              LabelValue := CaseConst.Ival
            end;
          if TopCaseEntry^.WordLabels
          then ExtendWCaseList(NewLabel)
          else ExtendCaseList(NewLabel)
        end
    end { nextiscase };
  
  procedure NextIsRange(CaseConst1, CaseConst2: ObjectValue);
    visible;
    
    var NewLabel: CaseLabelEntry;
    
    begin
      if CodeIsToBeGenerated
      then
        begin
          new(NewLabel);
          with NewLabel^ do
            begin
              NextLabel := nil;
              NewCodeLabel(LimbLabel);
              IsRange := true;
              MinValue := CaseConst1.Ival;
              MaxValue := CaseConst2.Ival
            end;
          if TopCaseEntry^.WordLabels
          then ExtendWCaseList(NewLabel) 
          else ExtendCaseList(NewLabel)
        end
    end { NextIsRange };
  
  procedure OtherCases;
    visible;
    
    begin
      if CodeIsToBeGenerated
      then
        with TopCaseEntry^ do
          begin
            HasOtherwiseLimb := true;
            NewCodeLabel(OtherwiseLabel)
          end
    end { OtherCases };
  
  procedure CloseCase;
    visible;
    
    type
      DecPtr = ^Decision;
      DecList = record
                  First, Last: DecPtr;
                  Length: Scalar
                end;
      DecKinds = (Test, Table, Range);
      Decision = record
                   NextInList: DecPtr;
                   case Kind: DecKinds of
                     Test:
                       (TestValue: MCIntegerForm;
                        LePath, GtPath: DecPtr);
                     Table: (MinLabel, MaxLabel: CaseLabelEntry);
                     Range: (LabelRange: 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 DegenerateCase(DecNode: DecPtr): Boolean;
      
      begin
        with DecNode^ do
          if Kind = Test
          then DegenerateCase := false
          else
            if Kind = Range
            then DegenerateCase := true
            else DegenerateCase := (MinLabel^.NextLabel = nil)
      end { degeneratecase };

    function WLabelGap(MinLab, MaxLab: integer): integer;

      var Finite: Boolean;

      begin
        if wrd(MaxLab) < wrd(maxint)
        then Finite := true
        else Finite := (wrd(MaxLab) - wrd(maxint)) < wrd(MinLab);
        if Finite
        then WLabelGap := int(wrd(MaxLab) - wrd(MinLab))
        else WLabelGap := maxint
      end { WLabelGap };

    function LabelGap(MinLab, MaxLab: integer): integer;
      
      var Finite: Boolean;
      
      begin
        if MaxLab < 0
        then Finite := true else Finite := (MaxLab - maxint) < MinLab;
        if Finite
        then LabelGap := MaxLab - MinLab else LabelGap := maxint
      end { LabelGap };
    
    procedure PartitionCases
                (LabelList: CaseLabelEntry;
                 var TableList: DecList;
                 function GapTest(MinLab, MaxLab: integer): integer);
      
      var
        ThisLabel, FollowingLabel: CaseLabelEntry;
        SubTable: DecPtr;
        BreakFound: Boolean;
      
      begin
        Start(TableList);
        ThisLabel := LabelList;
        while ThisLabel <> nil do
          begin
            FollowingLabel := ThisLabel^.NextLabel;
            new(SubTable);
            if ThisLabel^.IsRange
            then
              with SubTable^ do
                begin
                  Kind := Range;
                  LabelRange := ThisLabel
                end
            else
              begin
                with SubTable^ do
                  begin
                    Kind := Table;
                    MinLabel := ThisLabel
                  end;
                BreakFound := false;
                while (FollowingLabel <> nil) and (not BreakFound) do
                  if (GapTest(MaxOf(ThisLabel), MinOf(FollowingLabel))
                      > MaxCaseGap)
                     or (FollowingLabel^.IsRange)
                  then BreakFound := true
                  else
                    begin
                      ThisLabel := FollowingLabel;
                      FollowingLabel := ThisLabel^.NextLabel
                    end;
                ThisLabel^.NextLabel := nil;
                SubTable^.MaxLabel := ThisLabel
              end;
            Append(TableList, SubTable);
            ThisLabel := FollowingLabel
          end;
        TrapNeeded := DegenerateCase(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
              if Kind = Range
              then MaxValue := MaxOf(LabelRange)
              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, DefaultLabel: CodeLabel;
        CaseLabel, ThisLabel: CaseLabelEntry;
        LabelIndex: MCIntegerForm;
      
      begin { emitcasecode }
        with DecNode^ do
          case Kind of
            Test :
              begin
                FutureCodeLabel(FailLabel);
                if not DegenerateCase(LePath)
                then
                  begin
                    LoadValue(TopCaseEntry^.Selector);
                    Estklit(TestValue);
                    Ejump(IGT, FailLabel)
                  end;
                EmitCaseCode(LePath);
                NxIsCodeLabel(FailLabel);
                EmitCaseCode(GtPath);
                dispose(LePath);
                dispose(GtPath)
              end;
            Table :
              begin
                LoadValue(TopCaseEntry^.Selector);
                if DegenerateCase(DecNode)
                then
                  begin
                    Estklit(MinLabel^.LabelValue);
                    Ejump(IEQ, MinLabel^.LimbLabel)
                  end
                else
                  begin
                    if TopCaseEntry^.HasOtherwiseLimb
                    then DefaultLabel := TopCaseEntry^.OtherwiseLabel
                    else DefaultLabel := -1;
                     ECaseJump
                       (MinLabel^.LabelValue, MaxLabel^.LabelValue,
                        DefaultLabel, 0);
                    CaseLabel := MinLabel;
                    for LabelIndex :=
                          MinLabel^.LabelValue to
                            MaxLabel^.LabelValue do
                      if LabelIndex = CaseLabel^.LabelValue
                      then
                        begin
                          ECaseEntry
                            (LabelIndex, CaseLabel^.LimbLabel);
                          ThisLabel := CaseLabel;
                          CaseLabel := CaseLabel^.NextLabel;
                          dispose(ThisLabel)
                        end
                      else ECaseEntry(LabelIndex, -1) 
                  end
              end;
            Range :
              begin
                FutureCodeLabel(FailLabel);
                LoadValue(TopCaseEntry^.Selector);
                Estklit(MinOf(LabelRange));
                Ejump(ILT, FailLabel);
                LoadValue(TopCaseEntry^.Selector);
                Estklit(MaxOf(LabelRange));
                Ejump(ILE, LabelRange^.LimbLabel);
                dispose(LabelRange);
                NxIsCodeLabel(FailLabel)
              end
          end
      end { emitcasecode };
    
    procedure EmitWCaseCode(DecNode: DecPtr);
      
      var
        FailLabel, DefaultLabel: CodeLabel;
        CaseLabel, ThisLabel: CaseLabelEntry;
        LabelIndex: word;
      
      begin { emitcasecode }
        with DecNode^ do
          case Kind of
            Test :
              begin
                FutureCodeLabel(FailLabel);
                if not DegenerateCase(LePath)
                then
                  begin
                    LoadValue(TopCaseEntry^.Selector);
                    Estklit(TestValue);
                    Ejump(UGT, FailLabel)
                  end;
                EmitCaseCode(LePath);
                NxIsCodeLabel(FailLabel);
                EmitCaseCode(GtPath);
                dispose(LePath);
                dispose(GtPath)
              end;
            Table :
              begin
                LoadValue(TopCaseEntry^.Selector);
                if DegenerateCase(DecNode)
                then
                  begin
                    Estklit(MinLabel^.LabelValue);
                    Ejump(UEQ, MinLabel^.LimbLabel)
                  end
                else
                  begin
                    if TopCaseEntry^.HasOtherwiseLimb
                    then DefaultLabel := TopCaseEntry^.OtherwiseLabel
                    else DefaultLabel := -1;
                     ECaseJump
                       (MinLabel^.LabelValue, MaxLabel^.LabelValue,
                        DefaultLabel, 1);
                    CaseLabel := MinLabel;
                    for LabelIndex :=
                          wrd(MinLabel^.LabelValue) to
                            wrd(MaxLabel^.LabelValue) do
                      if LabelIndex = wrd(CaseLabel^.LabelValue)
                      then
                        begin
                          ECaseEntry
                            (int(LabelIndex), CaseLabel^.LimbLabel);
                          ThisLabel := CaseLabel;
                          CaseLabel := CaseLabel^.NextLabel;
                          dispose(ThisLabel)
                        end
                      else ECaseEntry(int(LabelIndex), -1) 
                  end
              end;
            Range :
              begin
                FutureCodeLabel(FailLabel);
                LoadValue(TopCaseEntry^.Selector);
                Estklit(MinOf(LabelRange));
                Ejump(ULT, FailLabel);
                LoadValue(TopCaseEntry^.Selector);
                Estklit(MaxOf(LabelRange));
                Ejump(ULE, LabelRange^.LimbLabel);
                dispose(LabelRange);
                NxIsCodeLabel(FailLabel)
              end
          end
      end { emitwcasecode };

    begin { closecase }
      if CodeIsToBeGenerated
      then
        begin
          with TopCaseEntry^ do
            begin
              NxIsCodeLabel(CaseCode);
              if WordLabels
              then PartitionCases(MinLabel, SubCases, WLabelGap)
              else PartitionCases(MinLabel, SubCases, LabelGap);
              DecisionTree := BuildTree(SubCases);
              if not ((Selector^.Kind = AConstant) or
                      SimpleReference(Selector))
              then
                begin
                  Load(Selector);
                  SaveValue(Selector)
                end;
              if WordLabels
              then EmitWCaseCode(DecisionTree)
              else EmitCaseCode(DecisionTree);
              
              { last case was degenerate - ie an }
              { isolated value or label range    }
              if TrapNeeded
              then
                if HasOtherwiseLimb
                then Ejump(JUMP, OtherwiseLabel)
                else
                  begin
                    Estklit(51);
                    Epasop(TRAP)
                  end;
              dispose(DecisionTree);
              FreeEntry(Selector)
            end;
          ThisCase := TopCaseEntry;
          TopCaseEntry := TopCaseEntry^.Next;
          dispose(ThisCase)
        end
    end { closecase };
  
  procedure InitCase;
    visible;
    
    begin TopCaseEntry := nil end;
  
  {


   23.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)  Exploiting the fact that range-checks are only necessary when
        the for-loop is entered to reduce each check to a single test
        on the appropriate limiting value of  the  initial  or  final
        expressions.  These checks are performed by P-codes CheckFor-
        Lower and CheckForUpper.
  
   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;
      EntryCode: (NoneNeeded, TestNeeded, JumpNeeded);
    
    procedure CheckEntryCode(Low, High: StackEntry);
      
      begin
        if Increasing
        then
          if Low^.DataRep.Min > High^.DataRep.Max
          then EntryCode := JumpNeeded
          else
            if Low^.DataRep.Max > High^.DataRep.Min
            then EntryCode := TestNeeded else EntryCode := NoneNeeded
        else
          if Low^.DataRep.Max < High^.DataRep.Min
          then EntryCode := JumpNeeded
          else
            if Low^.DataRep.Min < High^.DataRep.Max
            then EntryCode := TestNeeded else EntryCode := NoneNeeded
      end { CheckEntryCode };
    
    procedure CheckWEntryCode(Low, High: StackEntry);
      
      begin
        if Increasing
        then
          if Low^.DataRep.WMin > High^.DataRep.WMax
          then EntryCode := JumpNeeded
          else
            if Low^.DataRep.WMax > High^.DataRep.WMin
            then EntryCode := TestNeeded else EntryCode := NoneNeeded
        else
          if Low^.DataRep.WMax < High^.DataRep.WMin
          then EntryCode := JumpNeeded
          else
            if Low^.DataRep.WMin < High^.DataRep.WMax
            then EntryCode := TestNeeded else EntryCode := NoneNeeded
      end { CheckWEntryCode };

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

      begin
        if Kind = Upper
        then
          begin
            if Limit^.DataRep.Min > ControlMax.Ival
            then
              begin
                PredictedError(Error);
                Estklit(Error);
                Epasop(TRAP)
              end
            else
              if Limit^.DataRep.Max > ControlMax.Ival
              then
                begin
                  LoadValue(Limit);
                  Estklit(ControlMax.Ival);
                  { Etrap(IGT, Error) }
                end
          end
        else
          begin
            if Limit^.DataRep.Max < ControlMin.Ival
            then
              begin
                PredictedError(Error);
                Estklit(Error);
                Epasop(TRAP)
              end
            else
              if Limit^.DataRep.Min < ControlMin.Ival
              then
                begin
                  LoadValue(Limit);
                  Estklit(ControlMin.Ival);
                  { Etrap(ILT, Error) }
                end
          end
      end { checklimit };
    
    procedure CheckWLimit(Limit: StackEntry; Kind: LimitKinds;
                          Error: Scalar);
      
      begin
        if Kind = Upper
        then
          begin
            if Limit^.DataRep.WMin > ControlMax.Wval
            then
              begin
                PredictedError(Error);
                Estklit(Error);
                Epasop(TRAP)
              end
            else
              if Limit^.DataRep.WMax > ControlMax.Wval
              then
                begin
                  LoadValue(Limit);
                  { recast(ControlMax, AsWord) }
                  Estklit(ControlMax.Ival);
                  { Etrap(UGT, Error) }
                end
          end
        else
          begin
            if Limit^.DataRep.WMax < ControlMin.Wval
            then
              begin
                PredictedError(Error);
                Estklit(Error);
                Epasop(TRAP)
              end
            else
              if Limit^.DataRep.WMin < ControlMin.Wval
              then
                begin
                  LoadValue(Limit);
                  { recast(ControlMin, AsWord) }
                  Estklit(ControlMin.Ival);
                  { Etrap(ULT, Error) }
                end
          end
      end { checklimit };
    begin
      if CodeIsToBeGenerated
      then
        begin
          new(ThisFor);
          with ThisFor^ do
            begin
              Incrementing := Increasing;
              Pop(FinalEntry);
              Pop(InitialEntry);
              Pop(ControlVar);
              WordLimits := (ControlMin.Kind = BaseValue);
              if InitialEntry^.Kind <> AConstant
              then
                begin
                  Load(InitialEntry);
                  SaveValue(InitialEntry)
                end;
              if FinalEntry^.Kind <> AConstant
              then
                begin
                  Load(FinalEntry);
                  SaveValue(FinalEntry)
                end;
              if WordLimits
              then CheckWEntryCode(InitialEntry, FinalEntry)
              else CheckEntryCode(InitialEntry, FinalEntry);
              FutureCodeLabel(EndOfLoop);
              case EntryCode of
                JumpNeeded : JumpTo(EndOfLoop, Absolute);
                TestNeeded :
                  begin
                    if Increasing
                    then
                      begin
                        LoadValue(InitialEntry);
                        LoadValue(FinalEntry)
                      end
                    else
                      begin
                        LoadValue(FinalEntry);
                        LoadValue(InitialEntry)
                      end;
                    if WordLimits then Eop(ULE) else Eop(ILE);
                    JumpTo(EndOfLoop, IfFalse)
                  end;
                NoneNeeded : 
              end;
              if EntryCode <> JumpNeeded
              then
                begin
                  if RChecks in Requested
                  then
                    if Increasing
                    then
                      if WordLimits
                      then
                        begin
                          CheckWLimit(InitialEntry, Lower, 52);
                          CheckWLimit(FinalEntry, Upper, 53)
                        end
                      else
                        begin
                          CheckLimit(InitialEntry, Lower, 52);
                          CheckLimit(FinalEntry, Upper, 53)
                        end
                    else
                      if WordLimits
                      then
                        begin
                          CheckWLimit(InitialEntry, Upper, 52);
                          CheckWLimit(FinalEntry, Lower, 53)
                        end
                      else
                        begin
                          CheckLimit(InitialEntry, Upper, 52);
                          CheckLimit(FinalEntry, Lower, 53)
                        end;
                  LoadValue(InitialEntry);
                  with ControlVar^ do
                    AddressArea(BaseAddress, 0, MCBytesPerWord);
                  Eop(ESTORE)
                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);
              if WordLimits then Eop(UEQ) else Eop(IEQ);
              JumpTo(EndOfLoop, IfTrue);
              LoadValue(ControlVar);
              if Incrementing
              then 
                if WordLimits then Epasop(USUCC) else Epasop(ISUCC)
              else 
                if WordLimits then Epasop(UPRED) else Epasop(IPRED);
              with ControlVar^ do
                AddressArea(BaseAddress, 0, MCBytesPerWord);
              Eop(ESTORE);
              JumpTo(StartOfLoop, Absolute);
              NxIsCodeLabel(EndOfLoop);
              if UChecks in Requested
              then
                begin
                  with ControlVar^ do
                    AddressArea(BaseAddress, 0, MCBytesPerWord);
                  Epasop(SETUNDEF)
                end;
              FreeEntry(FinalEntry);
              FreeEntry(ControlVar)
            end;
          ThisFor := TopForEntry;
          TopForEntry := TopForEntry^.Next;
          dispose(ThisFor)
        end
    end { closefor };
  
  procedure InitFor;
    visible;
    
    begin TopForEntry := nil end;
  
  {
  
  
   23.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 MakeLabel(L) end;
  
  procedure NextIsStatementLabel(var L: StatementLabel);
    visible;
    
    begin Elabel(L) end ;
  
  procedure LabelJump(var Destination: StatementLabel;
                      LabelLevel: DispRange);
    visible;
    
    begin
      if CodeIsToBeGenerated
      then
        if LabelLevel = FrameLevel 
        then Ejump(JUMP, Destination)
        else Egjump(JUMP, FrameLevel - LabelLevel, Destination) 
    end { labeljump };
  
  begin 
  { end of module }
  end.