{

                          MODULE 19


                       P-Code Assembly
                             and
                 Data Access Code Generation





 This chapter defines the code generation utilities on which subse-
 quent  code generation procedures depend.  The facilities provided
 include:

 (a)  basic P-code instruction assembly and storage;

 (b)  generation and fix-up of jump instructions;

 (c)  extended reference locking and release;

 (d)  generation of code to load the address implied by a reference
      held  as  an  access  list,  together  with the generation of
      ancillary access checks as described in Chapter 16;

 (e)  generation of code to load and check the value implied by  an
      expression tree, as described in Chapter 17;

 (f)  temporary value storage and re-loading.


 18.1  P-Code Instruction Assembly

 The procedures which create and store P-code instructions (in  the
 code  buffer  defined  in  Chapter 15) directly reflect the P-code
 formats dictated by the P-machine.  Thus  the  procedures  PCode0,
 PCode1,  and Pcode2 generate class 1 instructions with 0, 1, and 2
 operands respectively.  In the latter cases the procedures make an
 automatic choice between the byte-operand or word-operand versions
 of the instruction required, according to  the  magnitude  of  the
 (first) operand.

 Procedures PCode3 and PCode4 provide similar  facilities  for  the
 generation  of  class 2 instructions, none of which take more than
 one operand.

 The procedures InlineNumber, InlineReal  and  InlineWord  generate
 the  ConstX  instructions  which load literal values from the code
 itself.   The  procedure  InlineMultipleConst  is  used  to  embed
 multi-word  images  in ConstMultiple and ConstRefMultiple instruc-
 tions.

                                                                     }

program CodeUtilities;

#include "globals.x"
#include "statstore.pf"
#include "stdprocs.pf"
#include "ctlstructs.pf"
#include "varref.pf"
#include "pfcalls.pf"

{procedure Pcode0(Class1Instruction: Pcodes);

  begin CodeByte(Class1Instruction) end;

procedure PcodeAndWord (Class1Instruction: Pcodes; Operand: MCWord);

  var Buffer: MCWordForm;

  begin
    CodeByte(Class1Instruction);
    Buffer.WValue := Operand;
    WordOfBytes(Buffer)
  end; } { PcodeAndWord }

{procedure Pcode1(Class1Instruction: Pcodes; Operand: MCWord);

  var Buffer: MCWordForm;

  begin
    if (Operand > MCMaxByte) or (Operand < 0)
    then
      begin
        Class1Instruction := succ(Class1Instruction);
        CodeByte(Class1Instruction);
        Buffer.WValue := Operand;
        WordOfBytes(Buffer)
      end
    else
      begin
        CodeByte(Class1Instruction);
        CodeByte(Operand)
      end
  end; } { pcode1 }

{procedure Pcode2(Class1Instruction: Pcodes; Op1, Op2: MCWord);

  begin
    Pcode1(Class1Instruction, Op1);
    CodeByte(Op2)
  end; } { pcode2 }

{procedure Pcode3(Class2Instruction: Pcodes);

  begin
    CodeByte(Escape);
    CodeByte(Class2Instruction - 256)
  end; } { pcode3 }

{procedure Pcode4(Class2Instruction: Pcodes; Operand: MCWord);

  begin
    CodeByte(Escape);
    Pcode1(Class2Instruction - 256, Operand)
  end; } { pcode4 }

{procedure Pcode5 ( Class1Instruction: Pcodes ; Operand: MCHalfWord ) ;
 
  var Buffer: MCWordForm ; 
 
  begin 
    CodeByte(Class1Instruction) ; 
    Buffer.WValue := Operand ; 
    HalfWordOfBytes(Buffer)
  end; } { Pcode5 }
 
{procedure Pcode6 ( Class1Instruction: Pcodes ;
                   Op1: MCByte ; Op2: MCHalfWord ) ;  
 
  var Buffer: MCWordForm  ;
 
  begin
    Pcode1(Class1Instruction,Op1) ; 
    Buffer.WValue := Op2 ; 
    HalfWordOfBytes(Buffer)
  end; } { Pcode6 }
 
{procedure InlineNumber(Number: MCIntegerForm);

  var Magnitude: MCIntegerForm;

  begin
    Magnitude := abs(Number);
    if Magnitude > MCMaxByte
    then Pcode1(ConstWord, Number)
    else
      begin
        if Magnitude >= 32
        then Pcode1(ConstWord, Magnitude) else Pcode0(Magnitude);
        if Number < 0 then Pcode0(NegateInteger)
      end
  end; } { inlinenumber }

{procedure InLineReal(RealNumber: MCRealForm);

  var RealMap:
        record
          case Boolean of
            false: (RealValue: MCRealForm);
            true: (Words: array [1..MCRealSize] of MCWord)
        end;
      Buffer: MCWordForm;
      i: 1..MCRealSize;

  begin
    RealMap.RealValue := RealNumber;
    if MCRealSize = 1
    then
      begin
        Pcode0(succ(ConstWord));
        Buffer.WValue := RealMap.Words[1];
        WordOfBytes(Buffer)
      end
    else
      begin
        Pcode1(ConstMultiple, MCRealSize);
        Align;
        for i := 1 to MCRealSize do
          begin
            Buffer.WValue := RealMap.Words[i];
            WordOfBytes(Buffer)
          end
      end
  end; } { inlinereal }

{procedure InlineWord(DataWord: WordEntry);

  var Buffer: MCWordForm;

  begin
    Buffer := DataWord^.Word;			}
    {recast(buffer,asvalue);}
    {Pcode0(succ(ConstWord));
    WordOfBytes(Buffer)
  end; } { inlineword }

{procedure InlineMultipleConst(TheConst: ObjectValue);

  var NextWord: WordEntry;

  begin
    with TheConst do
      begin
        Align;
        if Kind = SetValue
        then NextWord := Setval else NextWord := Stringval;
        while NextWord <> nil do
          begin
            WordOfBytes(NextWord^.Word);
            NextWord := NextWord^.Next
          end
      end
  end; } { inlinemultipleconst }

{

 18.2  Generating Jump Instructions

 All P-code jump instructions are two bytes long,  the  destination
 being   specified  either  as  a  one  byte  relative  offset,  or
 indirectly via a data word indexed by a one byte data offset.

 The interface type Codelabel has two variants:

 (a)  for expected code labels, i.e. those not yet sited, the  Las-
      tReference  field  points  to a chain of fix-up records which
      give the position and kind of forward jumps to the label;

 (b)  for code labels already sited the  field  Address  gives  the
      byte position of the label within the current code block.

 A label which is not reachable by a one-byte offset from all jumps
 that reference it is 'linked', i.e. it is allocated a data word to
 hold its offset within the code block, for use by  indirect  'jump
 via' instructions.

 The following procedures enable the generation and fix-up of  jump
 instructions which reference code labels held in this way.

                                                                     }

{procedure LinkLabel(var TheLabel: CodeLabel;
                    LabelAddress: CodeByteRange);

  var DataEntry: MCWordForm;

  begin
    DataEntry.Linked := true;
    DataEntry.Address := LabelAddress;
    TheLabel.LinkIndex := DataCounter - CurrentBlock^.DataBase + 1;
    TheLabel.Linked := true;
    DataWord(DataEntry)
  end; } { linklabel }

{procedure PlantJump(var TheLabel: CodeLabel;
                    JumpAddress, LabelAddress: CodeByteRange;
                    Condition: JumpType);

  var OpCode: Pcodes;
      Operand: MCByte;
      Stride: integer;
      Buffer: MCWordForm ; 

  begin
    Stride := LabelAddress - JumpAddress - 3;
    if abs(Stride) > MCMaxHalfWord
    then
      begin
        if Condition in [IfFalseConditional, IfTrueConditional]
        then SystemError(5)
        else
          begin
            if not TheLabel.Linked
            then LinkLabel(TheLabel, LabelAddress);
            Operand := TheLabel.LinkIndex;
            if Condition = IfFalse
            then OpCode := FJumpVia else OpCode := JumpVia
          end
      end
    else
      begin
        if Stride < 0
        then
          if Condition = IfFalse
          then OpCode := FJumpBack else OpCode := JumpBack
        else
          case Condition of
            IfFalse : OpCode := FJumpForward;
            IfFalseConditional : OpCode := FJumpConditional;
            IfTrueConditional : OpCode := TJumpConditional;
            Absolute : OpCode := JumpForward
          end;
        Operand := abs(Stride)
      end;
    Buffer.WValue := Operand ;
    FillByte(JumpAddress, OpCode);
    FillByte(JumpAddress + 1, Buffer.WBytes[0]) ;
    FillByte(JumpAddress + 2, Buffer.WBytes[1])
  end; } { plantjump }

{procedure FixUpJumps(var ThisLabel: CodeLabel;
                     LabelSite: CodeByteRange);

  var ThisRef: FixUpEntry;

  begin
    with ThisLabel do
      while LastReference <> nil do
        begin
          ThisRef := LastReference;
          with ThisRef^ do
            PlantJump(ThisLabel, JumpAddress, LabelSite, JumpKind);
          LastReference := ThisRef^.Next;
          dispose(ThisRef)
        end
  end; } { fixupjumps }

procedure JumpTo(var TheLabel: CodeLabel; Condition: JumpType);

{  var Fixup: FixUpEntry;
      Base: CodeByteRange;
}

  begin
    {Base := CodeCounter;
    CodeByte(0);
    CodeByte(0);
    CodeByte(0);
    with TheLabel do
      if Expected
      then
        begin
          new(Fixup);
          with Fixup^ do
            begin
              JumpKind := Condition;
              JumpAddress := Base;
              Next := LastReference
            end;
          LastReference := Fixup
        end
      else PlantJump(TheLabel, Base, Address, Condition)	}
  end; { jumpto }

{

 18.3 Extended Reference Protection

 A reference made to an actual variable parameter or  to  a  record
 variable appearing in a with-statement is 'extended' for the dura-
 tion of the procedure call or the body of the  with-statement.  In
 most  cases,  the extension is conceptual, but references extended
 to file buffer variables, record-variant fields, or dynamic  vari-
 ables,  require  actual  protection  to  guard against intervening
 motion on the  file,  variant  reselection,  or  dynamic  variable
 disposal.  This is achieved by associating each such variable with
 a 'lock' which may  be  set  whenever  a  reference  is  extended.
 Thereafter,  code  is  generated  to  check  the lock prior to any
 operation which could potentially destroy the reference.  In  par-
 ticular:

 (1)  Every file variable has a lock-bit embedded in the associated
      5  word memory block. All code sequences generated from calls
      to reset, rewrite, put, and get, include a check  that  flags
      runtime error D6 if the lock-bit is set.

 (2)  Every dynamic variable has a lock-bit embedded  in  the  heap
      storage  associated  with  the variable. All calls to dispose
      result in a check made  internally  by  the  P-machine,  that
      flags runtime error D5 if the lock-bit is set.

 (3)  Every record variant part has a lock-bit embedded in the con-
      trol  word.  All  variant  reselections  include a check that
      flags runtime error D2 if the lock-bit is set.

 Locks are set by appending  entries  to  the  ancillary  CheckList
 associated  with the reference. In the case of a reference made to
 a (nested) variant field, the  CheckList  will  already  have  one
 entry  per  level  of  nesting  to  check  or set selector fields.
 Correspondingly,  each  active  variant  is  locked  by  appending
 entries  to  set  the appropriate control word flags. Thereafter a
 single lock is applied to the dynamic variable or the  file  vari-
 able as appropriate.

 Each entry on the access list defines a base  address  from  which
 the  offset  of the appropriate lock word is measured. Entries are
 made on the CheckList by procedure ExtendReferences but code  gen-
 eration  is  delayed until the reference is evaluated by procedure
 LoadAddress.

 Multiple references extended to the same variable are  handled  by
 stacking  each lock in turn on the lock-stack allocated within the
 current stack frame.  When a lock is set,  code  is  generated  to
 push  the  current lock setting on the lock stack and then set the
 lock-bit.  When an extended reference is discarded, code  is  gen-
 erated to pop the lock stack, and restore the lock to its original
 setting.

 Throughout program analysis, a compile-time record of the  current
 lock  stack  depth  is  kept in the field LockDepth of the current
 FrameRecord.  Prior  to  processing  a  with-statement  or  actual
 parameter-list,  the value of LockDepth is saved and used when the
 context is closed to generate code to restore the  lock  stack  to
 its  original  depth.  The  call to procedure PopLocks updates the
 compile-time record of the lock stack depth accordingly.

                                                                     }

procedure ExtendReferences(Entry: StackEntry);
visible;

{  var LockCount, LockingLevel: Scalar;
      ThisCheck: AncillaryEntry;

  procedure ApplyLock(LWord: Offsets; Lbit: MCBitIndex);

    var CheckEntry: AncillaryEntry;

    begin
      new(CheckEntry);
      with CheckEntry^ do
        begin
          Next := nil;
          WhichOp := SetALock;
          LockWord := LWord;
          LockBit := Lbit
        end;
      AppendEntry(Entry^.CheckList, CheckEntry);
      PushLock
    end;} { applylock }

  begin
{    if Checks in Requested
    then
      repeat
        if Entry^.Vulnerable
        then
          with Entry^ do
            begin
              LockCount := CheckCount(CheckList);
              if LockCount > 0
              then
                for LockingLevel := 0 to LockCount - 1 do
                  ApplyLock(0, 3 * LockingLevel)
              else
                if Kind = Reference
                then
                  if Class = PnterRef
                  then ApplyLock(HeapLockOffset, HeapLockBit)
                  else
                    if Class = FileRef
                    then ApplyLock(FileLockOffset, FileLockBit)
            end;
        Entry := Entry^.AccessList
      until Entry = nil						}
  end; { extendreferences }

procedure DiscardReferences(OldDepth: Scalar);
visible;

  begin
{    if Checks in Requested
    then
      with TopFrameEntry^ do
        begin
          if LockDepth > OldDepth then Pcode1(DiscardLocks, OldDepth);
          PopLocks(OldDepth)
        end							}
  end; { discardreferences }

{

 18.4  Stack Access and Block Calling Utilities

 The following utilities are  used  to  determine  the  appropriate
 method   for   accessing  global,  local  and  intermediate  stack
 addresses and blocks, and enable the generation of code to address
 load, or store stack words, and to call code blocks.

                                                                     }

procedure AdjustAddress(Delta: Offsets);

  begin
{    if Delta <> 0
    then
      if Delta < 0
      then
        if Delta = -1
        then Pcode0(AdjustM1) else Pcode1(AdjustMinus, -Delta)
      else
        if Delta = 1
        then Pcode0(AdjustP1) else Pcode1(AdjustPlus, Delta)		}
  end; { adjustaddress }

procedure AdjustLoad(Delta: Offsets);

  begin
{    if Delta > 7
    then Pcode1(Index, Delta)
    else
      if Delta = 0
      then Pcode0(LoadIndirect) else Pcode0(IndexShort + Delta - 1)	}
  end; { adjustload }

procedure ModifyValue(Delta: MCIntegerForm);

  begin
{    if Delta <> 0
    then
      if Delta < 0
      then
        if Delta = -1 then Pcode0(Dec1) else Pcode1(Decrement, -Delta)
      else
        if Delta = 1 then Pcode0(Inc1) else Pcode1(Increment, Delta)	}
  end; { modifyvalue }

function AccessMethod(Level: AddressLevel): Accesses;

  begin
    if Level = GlobalLevel
    then AccessMethod := Global
    else
      if Level = FrameLevel
      then AccessMethod := Local
      else
        if Level = FrameLevel - 1
        then AccessMethod := Enclosing
        else AccessMethod := Intermediate
  end; { accessmethod }

procedure AccessWord(WordLevel: AddressLevel; Delta: Offsets;
                     Operation: AccessOps);
visible;

{  var Adjustment: Offsets;
      OpCode: Pcodes;
      Negative: Boolean;
      Access: Accesses;
}

  begin
{    if Delta < 0
    then
      begin
        Adjustment := Delta;
        Delta := 0;
        Negative := true;

      end
    else Negative := false;
    Access := AccessMethod(WordLevel);
    OpCode := AccessCodes[Operation, Access];
    if Access = Intermediate
    then Pcode2(OpCode, Delta, FrameLevel - WordLevel)
    else
      if (Access = Local) and (Delta < 8)
      then Pcode0(OpCode - 8 + Delta) else Pcode1(OpCode, Delta);
    if Negative then AdjustAddress(Adjustment)				}
  end; { accessword }

procedure EmitCall(BlockBase: BlockLabel);
visible;

{  var CalledLevel, LevelOffset: AddressLevel;
      EntryPoint: MCHalfWord;
}

  begin
{    EntryPoint := BlockBase.EntryOffset;
    CalledLevel := BlockBase.BlockLevel;
    LevelOffset := FrameLevel - CalledLevel;
    if CalledLevel = GlobalLevel
    then Pcode5(CallGlobal, EntryPoint)
    else
      if LevelOffset > 1
      then Pcode6(CallOuter, LevelOffset, EntryPoint)
      else
        if LevelOffset = 1
        then Pcode5(Callevel, EntryPoint)
        else Pcode5(CallLocal, EntryPoint)			}
  end; { emitcall }

{

 18.5  Loading and Saving Addresses

 The procedure LoadAddress is used to generate the code required to
 load  the address implied by an access list, as defined in Chapter
 16, and to carry out any ancillary access checks required at  each
 access step.

 The logic used by LoadAddress follows directly from  the  form  of
 access lists defined in Chapter 13, and from the P-codes available
 for access operations.  The procedure  CheckAccess  generates  the
 code to apply any access checks required at each step.

 The procedure SaveAddress is used to preserve an address for  sub-
 sequent  re-use  if  necessary, by acquiring temporary stack frame
 locations and generating code to store the address there.

 An address saved in this way is represented by a stack  record  of
 variant Address.

                                                                     }

procedure Load(Entry: StackEntry);
visible;  forward;

procedure CheckAccess(var CheckList: AncillaryList);

{  var CheckEntry, OldEntry: AncillaryEntry;		}

  begin
{    CheckEntry := CheckList.FirstEntry;
    while CheckEntry <> nil do
      begin
        with CheckEntry^ do
          case WhichOp of
            CheckSelector :
              begin
                Pcode0(DuplicateStack);
                with SelectorField do
                  if PartWord
                  then
                    begin
                      AdjustAddress(WordOffset);
                      InlineNumber(BitSize);
                      InlineNumber(BitOffset);
                      Pcode0(LoadPacked)
                    end
                  else AdjustLoad(WordOffset);
                InlineNumber(SelectorValue);
                Pcode1(CheckVntField, SelectorField.Level)
              end;
            SetSelector :
              begin
                Pcode0(MarkStack);
                Pcode1(LoadStack, FrameSize);
                InlineNumber(TagValue);
                EmitCall(Selector)
              end;
            CheckIfActive :
              begin
                Pcode0(DuplicateStack);
                Pcode1(LoadBit, 3 * SelectorLevel + 2);
                Pcode1(TrapIfFalse, 43)
              end;
            CheckIfNew :
              begin
                Pcode0(DuplicateStack);
                Pcode0(CheckNew1)
              end;
            SetALock :
              begin
                Pcode0(DuplicateStack);
                AdjustAddress(LockWord);
                Pcode1(SetLock, LockBit)
              end
          end; } { case }
{        OldEntry := CheckEntry;
        CheckEntry := CheckEntry^.Next;
        dispose(OldEntry)
      end;
    StartAncillaries(CheckList)			}
  end; { checkaccess }

procedure LoadAddress(Entry: StackEntry);
visible;

  var StackedPartWord: Boolean;
      OpCode: Pcodes;
      NextIndex, ThisIndex: IndexEntry;

  begin
    with Entry^ do
      begin
        case Kind of
          Reference :
            begin
              StackedPartWord := false;

              { load base word address }
              if AccessList <> nil
              then
                begin
                  with AccessList^ do
                    if ((Kind = Reference) and PartOfWord) or
                       ((Kind = Address) and (not Loaded) and
                        APartWord)
                    then StackedPartWord := true;
                  LoadAddress(AccessList);
{                  if Indirect
                  then
                    if (Class = PnterRef) and (Checks in Requested)
                    then Pcode0(LoadPointer)
                    else Pcode0(LoadIndirect);				}
                  AdjustAddress(Adjustment);
                  FreeEntry(AccessList);
                  AccessList := nil
                end
              else
                with BaseAddress do
                  if Indirect
                  then
                    begin
                      if (Class = PnterRef) and (Checks in Requested)
                      then
                        begin
                          AccessWord
                            (BlockLevel, WordOffset, LoadRefOp);
                          {Pcode0(LoadPointer)			}
                        end
                      else AccessWord(BlockLevel, WordOffset, LoadOp);
                      AdjustAddress(Adjustment)
                    end
                  else
                    AccessWord
                      (BlockLevel, WordOffset + Adjustment,
                         LoadRefOp);
              if PartOfWord
              then
                if IndexedPartWord
                then
                  begin
                    with Index^ do
                      begin
                        if CAPIndex
                        then
                          with BpAddress do
                            AccessWord
                              (BlockLevel, WordOffset, LoadRefOp);
                        Load(TheIndex);
                        {if CAPIndex
                        then Pcode0(IndexPackdCAP)
                        else ModifyValue(-Lower);
                        if StackedPartWord
                        then Pcode1(IndexSubWord, Factor)
                        else
                          if OnByteBoundary
                          then Pcode0(IndexByteRef)
                          else Pcode1(IndexPackedRef, Factor);		}
                        ModifyValue(BitOffset);
                        FreeEntry(TheIndex);

                      end;
                    dispose(Index)
                  end
                else
                  begin
                    {InlineNumber(BitSize);
                    InlineNumber(BitOffset);
                    if StackedPartWord then Pcode0(AdjustPackedRef)	}
                  end
              else
                if Indexed
                then
                  begin
                    NextIndex := Indices;
                    repeat
                      ThisIndex := NextIndex;
                      with ThisIndex^ do
                        begin
                          if CAPIndex
                          then
                            with BpAddress do
                              AccessWord
                                (BlockLevel, WordOffset, LoadRefOp);
                          Load(TheIndex);
                          {if CAPIndex
                          then Pcode0(IndexCAP)
                          else
                            if Factor = 1
                            then Pcode0(AddAddress)
                            else Pcode1(IndexRef, Factor);		}
                          NextIndex := Next;
                          FreeEntry(TheIndex)
                        end;
                      dispose(ThisIndex)
                    until NextIndex = nil
                  end
            end;
          AConstant :
            begin
              {Pcode1(ConstRefMultiple, TheConst.WordSize);
              InlineMultipleConst(TheConst)			}
            end;
          Address :
            if not Loaded
            then
              with TempAddress do
                if APartWord
                then
                  begin
                    AccessWord(BlockLevel, WordOffset, LoadRefOp);
                    {Pcode1(LoadMultiple, 3)				}
                  end
                else AccessWord(BlockLevel, WordOffset, LoadOp)
        end;
        {if CheckList.FirstEntry <> nil then CheckAccess(CheckList);	}
        Kind := Address;
        Vulnerable := false;
        Loaded := true
      end
  end { loadaddress };

procedure SaveAddress(LocalBase: StackEntry);
visible;

  var SavedPartWord, IndexedRef: Boolean;

  begin
    with LocalBase^ do
      begin
        SavedPartWord := PartOfWord;
        if SavedPartWord
        then IndexedRef := IndexedPartWord else IndexedRef := Indexed;
        if (Indirect and (Class = PnterRef)) or (AccessList <> nil)
           or IndexedRef
        then
          begin
            LoadAddress(LocalBase);
            Loaded := false;
            if SavedPartWord
            then
              begin
                Acquire(3, TempAddress) {for packed-field pointer};
                with TempAddress do
                  AccessWord(BlockLevel, WordOffset, LoadRefOp);
                {Pcode1(StoreMultiple, 3)				}
              end
            else
              begin
                Acquire(1, TempAddress);
                with TempAddress do
                  AccessWord(BlockLevel, WordOffset, StoreOp)
              end;
            APartWord := SavedPartWord
          end
      end
  end { saveaddress };

{

 18.6  Evaluating Expressions

 The procedure Load is used to generate the code required  to  load
 the result of evaluating an expression tree, as defined in Chapter
 17.

 The logic usd by Load follows directly from the form of expression
 trees,  the operations that they represent, and the P-codes avail-
 able for their implementation.  Range checks applicable to  inter-
 mediate and final values are handled as explicit operations within
 the tree evaluation logic but the implicit undefined value  checks
 applicable  when a variable value is loaded are implemented by the
 auxiliary procedure CheckValue.

 Because code generation for the file functions eof and  eoln,  and
 for numeric read operations, are included within expression trees,
 the following procedures are declared forward at this  point,  and
 implemented  in  Chapter  21  where  the overall strategy for file
 manipulation is described.

                                                                     }

{procedure RestoreFile(IOFile: IOFileEntry);
  forward;

procedure LoadFileDescriptor;
  forward;

procedure DoFileChecks(FileOp: StdProcFuncs);
  forward;

procedure PostsetBuffer(FileOp: StdProcFuncs);
  forward;

procedure LoadCAPSize(ForPackedCAP: Boolean;
                      BoundPairBlock: RuntimeAddress);
  forward;
}

procedure CheckLoadedValue(Entry: StackEntry);
visible;

{  procedure InLineCheck(DataSize: WordRange; ErrorCode: Scalar);

    begin
      if DataSize = 1
      then Pcode1(CheckTopDefined, ErrorCode)
      else
        begin
          Pcode0(DuplicateStack);
          InlineNumber(DataSize);
          Pcode1(CheckRepeated, ErrorCode)
        end
    end; } { inlinecheck }

  begin
{    with Entry^.DataRep do
      if WordSize = 0
      then Pcode1(TrapError, 43)
      else
        case Kind of
          ForScalar, ForReal :
            if Entry^.PartOfWord
            then
              begin
                InlineNumber(CheckValue.Magnitude);
                Pcode1(CheckTopValue, Entry^.RunError)
              end
            else InLineCheck(WordSize, Entry^.RunError);
          ForPnter : InLineCheck(WordSize, Entry^.RunError);
          ForArray, ForARecord, ForVntRecord :
            if CheckCode.EntryOffset <> 0
            then
              begin
                Pcode0(MarkStack);
                Pcode1(LoadStack, FrameSize);
                EmitCall(CheckCode)
              end
            else InLineCheck(WordSize, Entry^.RunError);
          ForCAP :
            if CheckCode.EntryOffset <> 0
            then
              begin
                Pcode0(MarkStack);
                Pcode1(LoadStack, FrameSize + 1);
                EmitCall(CheckCode)
              end
            else Pcode1(CheckCAP, Entry^.RunError);
          ForSet :
            if WordSize = 1
            then Pcode1(CheckTopDefined, Entry^.RunError)
            else
              begin
                Pcode0(DuplicateStack);
                Pcode1(CheckWord, Entry^.RunError)
              end
        end							}
  end; { checkloadedvalue }

procedure Load {Entry : StackEntry};

  var CheckNeeded: Boolean;

  procedure DoBooleanOp;

    var ExitLabel: CodeLabel;
        ThisEntry, NextEntry: StackEntry;

    begin
      FutureCodeLabel(ExitLabel);
      with Entry^ do
        begin
          ThisEntry := OpList;
          while ThisEntry <> nil do
            begin
              NextEntry := ThisEntry^.NextNode;
              Load(ThisEntry);
              if NextEntry <> nil then JumpTo(ExitLabel, Jump);
              FreeEntry(ThisEntry);
              ThisEntry := NextEntry
            end
        end;
      NxIsCodeLabel(ExitLabel)
    end { dobooleanop };

  procedure DoUnaryOp;

    var OpCode: Pcodes;

    begin
      with Entry^ do
        begin
          Load(UnaryEntry);
          case OpGroup of
            AnInteger :
              {if UnaryOp = NegateOp
              then OpCode := NegateInteger else OpCode := Float };
            AReal : {OpCode := NegateReal };
            ABoolean : {OpCode := NotOperation };
            ASet : {OpCode := MakeSingletonSet				}
          end;
          {Pcode0(OpCode);						}
          FreeEntry(UnaryEntry)
        end
    end { dounaryop };

  procedure DoBinaryOp;

    var Folded: Boolean;

    begin
      with Entry^ do
        begin
          case OpGroup of
            AnInteger :
              begin
                Folded := false;
                if BinaryOp = Plus
                then
                  if RightEntry^.Kind = AConstant
                  then
                    begin
                      Load(LeftEntry);
                      ModifyValue(RightEntry^.TheConst.Ival);
                      Folded := true
                    end
                  else
                    if LeftEntry^.Kind = AConstant
                    then
                      begin
                        Load(RightEntry);
                        ModifyValue(LeftEntry^.TheConst.Ival);
                        Folded := true
                      end
                    else
                      if BinaryOp = Minus
                      then
                        if RightEntry^.Kind = AConstant
                        then
                          begin
                            Load(LeftEntry);
                            ModifyValue(-RightEntry^.TheConst.Ival);
                            Folded := true
                          end;
                if not Folded
                then
                  begin
                    Load(LeftEntry);
                    Load(RightEntry);
                    {Pcode0(IntCodes[BinaryOp])				}
                  end
              end;
            AReal :
              begin
                Load(LeftEntry);
                Load(RightEntry);
                {Pcode0(RealCodes[BinaryOp])				}
              end;
            APointer :
              begin
                Load(LeftEntry);
                Load(RightEntry);
                {if Checks in Requested
                then Pcode0(PtrCodes[BinaryOp])
                else Pcode0(IntCodes[BinaryOp])				}
              end;
            AString :
              begin
                Load(LeftEntry);
                Load(RightEntry);
                {PcodeAndWord(StringCodes[BinaryOp],
                               LeftEntry^.DataBytes)			}
              end;
            ASet :
              begin
                Load(LeftEntry);
                Load(RightEntry);
                {Pcode0(SetCodes[BinaryOp])				}
              end
          end;
          FreeEntry(LeftEntry);
          FreeEntry(RightEntry)
        end
    end { dobinaryop };

  procedure DoBlockCall;

    var ActualList: ActualEntry;

    begin
      with Entry^ do
        begin
          FnBlockEntry^.CallToBeGenerated := true;
          Push(FnBlockEntry);
          CallBlock
        end
    end { doblockcall };

  procedure DoSubrangeChecks;

    var MinTestNeeded, MaxTestNeeded: Boolean;
        Instruction: Pcodes;

    begin
{      with Entry^ do
        begin
          Load(EntryToCheck);
          with RequiredRange^ do
            if CAPBounds
            then
              with BpAddress do
                begin
                  AccessWord(BlockLevel, WordOffset, LoadOp);
                  AccessWord(BlockLevel, WordOffset + 1, LoadOp);
                  Instruction := CheckLimits
                end
            else
              begin
                if EntryToCheck^.DataRep.Min < Lower
                then
                  begin
                    InlineNumber(Lower);
                    MinTestNeeded := true
                  end
                else MinTestNeeded := false;
                if Upper < EntryToCheck^.DataRep.Max
                then
                  begin
                    InlineNumber(Upper);
                    MaxTestNeeded := true
                  end
                else MaxTestNeeded := false;
                Instruction :=
                  CheckCodes[MinTestNeeded, MaxTestNeeded]
              end;
          if Instruction <> NoOperation
          then Pcode1(Instruction, RunError);
          FreeEntry(EntryToCheck)
        end							}
    end { dorangecheck };

  procedure DoTransferChecks;

    begin
      with Entry^ do
        begin
          Load(EntryToCheck);
          with RequiredRange^ do
            if CAPBounds
            then
              with BpAddress do
                AccessWord(BlockLevel, WordOffset + 1, LoadOp)
            {else InlineNumber(Upper)};
          with TransferRange^ do
            if CAPBounds
            then
              with BpAddress do
                begin
                  AccessWord(BlockLevel, WordOffset + 1, LoadOp);
                  AccessWord(BlockLevel, WordOffset, LoadOp);
                  {Pcode0(SubInteger)					}
                end
            {else InlineNumber(Upper - Lower)};
          {Pcode0(SubInteger);
          Pcode1(CheckUpper, RunError);					}
          FreeEntry(EntryToCheck)
        end
    end { dotransferchecks };

  procedure DoMembershipChecks;

    begin
      with Entry^ do
        begin
          Load(EntryToCheck);
          with RequiredRange^ do
            if Lower <> 0
            then
              begin
                {InlineNumber(Lower);
                InlineNumber(Upper);
                Pcode1(CheckSetLimits, RunError)		}
              end
            else
              begin
                {InlineNumber(Upper);
                Pcode1(CheckSetUpper, RunError)			}
              end;
          FreeEntry(EntryToCheck)
        end
    end { domembershipchecks };

  procedure DoReadOp;

    begin
      with Entry^ do
        begin
          if Checks in Requested then DoFileChecks(Readp);
          LoadFileDescriptor;
          {case Mode of
            IntKind : Pcode3(ReadInteger);
            RealKind : Pcode3(ReadReal)
          end;							}
          if Checks in Requested then PostsetBuffer(Readp)
        end
    end { doreadop };

  procedure DoCAPLoad;

    begin
      with Entry^ do
        begin
          CheckNeeded := (CAPEntry^.RunError <> 0);
          LoadAddress(CAPEntry);
          LoadCAPSize(CAPPacked,BpAddress);
          {if CheckNeeded then CheckLoadedValue(Entry);		}
          FreeEntry(CAPEntry)
        end
    end { docapload };

  procedure DoStandardOp;

    begin
      with Entry^ do
        begin
          case OpGroup of
            AnInteger :
              begin
                Load(StdEntry);
                case StdOp of
                  Absf : {Pcode0(AbsInteger)};
                  Sqrf : {Pcode0(SquareInteger)};
                  Oddf : {Pcode0(OddInteger)};
                  Succf : {Pcode0(Inc1)};
                  Predf : {Pcode0(Dec1)};
                  Ordf, Chrf :
                end;
                FreeEntry(StdEntry)
              end;
            AReal :
              begin
                Load(StdEntry);
                case StdOp of
                  Absf : {Pcode0(AbsReal)};
                  Sqrf : {Pcode0(SquareReal)};
                  Truncf : {Pcode0(TruncateReal)};
                  Roundf : {Pcode0(RoundReal)};
                  Sinf : {Pcode3(Sine)};
                  Cosf : {Pcode3(Cosine)};
                  Expf : {Pcode3(NaturalExp)};
                  Lnf : {Pcode3(NaturalLog)};
                  Sqrtf : {Pcode3(SquareRoot)};
                  Arctanf : {Pcode3(ArcTangent)}
                end;
                FreeEntry(StdEntry)
              end;
            AFile :
              begin
                RestoreFile(IOEntry);
                if Checks in Requested then DoFileChecks(StdOp);
                LoadFileDescriptor;
                case StdOp of
                  Eolnf : {Pcode3(EndOfLine)};
                  Eoff : {Pcode3(EndOfFile)}
                end;
                DiscardFile
              end
          end
        end
    end { dostandardop };

  begin { load }
    with Entry^ do
      case Kind of
        Reference :
          begin
            CheckNeeded := (Entry^.RunError <> 0);
            if PartOfWord
            then
              begin
                LoadAddress(Entry);
                {if OnByteBoundary
                then Pcode0(LoadByte)
                else Pcode0(LoadPacked);			}
                if CheckNeeded then CheckLoadedValue(Entry)
              end
            else
              if DataRep.WordSize > 1
              then
                begin
                  LoadAddress(Entry);
                  if CheckNeeded then CheckLoadedValue(Entry);
                  {with DataRep do
                    if Kind = ForSet
                    then Pcode1(LoadSet, WordSize)
                    else
                      if (Kind = ForVntRecord) and
                         (Checks in Requested)
                      then
                        begin
                          Pcode0(PurgeLocks);
                          Pcode1(LoadMultiple, WordSize - 1)
                        end
                      else Pcode1(LoadMultiple, WordSize)		}
                end
              else
                begin
                  if Indexed
                  then
                    begin
                      LoadAddress(Entry);
                      {Pcode0(LoadIndirect)		}
                    end
                  else
                    if AccessList <> nil
                    then
                      begin
                        LoadAddress(AccessList);
                        if Indirect
                        then
                          {if (Class = PnterRef) and
                             (Checks in Requested)
                          then Pcode0(LoadPointer)
                          else Pcode0(LoadIndirect);	}
                        AdjustLoad(Adjustment);
                        FreeEntry(AccessList)
                      end
                    else
                      with BaseAddress do
                        if Indirect
                        then
                          begin
                            if (Class = PnterRef) and
                               (Checks in Requested)
                            then
                              begin
                                AccessWord
                                  (BlockLevel, WordOffset, LoadRefOp);
                                {Pcode0(LoadPointer)			}
                              end
                            else
                              AccessWord
                                (BlockLevel, WordOffset, LoadOp);
                            AdjustLoad(Adjustment)
                          end
                        else
                          AccessWord
                            (BlockLevel, WordOffset + Adjustment,
                               LoadOp);
                  if CheckNeeded then CheckLoadedValue(Entry)
                end
          end;
        BlockRef : ;
        Result : ;
        Address :
          begin
            if not Loaded then LoadAddress(Entry);
            {Pcode0(LoadIndirect)			}
          end;
        AConstant :
          with TheConst do
            case Kind of
              IntValue, BoolValue, CharValue :
                {InlineNumber(TheConst.Ival)};
              RealValue : {InLineReal(TheConst.Rval)};
              StringValue :
                {if WordSize > 1
                then
                  begin
                    Pcode1(ConstMultiple, WordSize);
                    InlineMultipleConst(TheConst)
                  end
                else InlineWord(TheConst.Stringval)};
              SetValue :
                {if WordSize = 0
                then InlineNumber(0)
                else
                  if WordSize > 1
                  then
                    begin
                      Pcode1(ConstSet, WordSize);
                      InlineMultipleConst(TheConst)
                    end
                  else InlineWord(TheConst.Setval)};
              PntrValue :
                begin
                  {InlineNumber(0);
                  if Checks in Requested then InlineNumber(0)	}
                end
            end;
        Operation :
          case OpForm of
            Unary : DoUnaryOp;
            Binary : DoBinaryOp;
            Condition : DoBooleanOp;
            BlockCall : DoBlockCall;
            RangeChk :
              case CheckKind of
                SubrangeChecks : DoSubrangeChecks;
                TransferChecks : DoTransferChecks;
                MemberChecks : DoMembershipChecks
              end;
            ReadOp : DoReadOp;
            CAPLoad : DoCAPLoad;
            Stdrd : DoStandardOp
          end
      end;
    Entry^.Kind := Result
  end { load };

{

 18.6  Saving and Reloading Values

 The procedure SaveValue is used to save a loaded expression result
 for  subsequent  re-use,  in a temporary location acquired for the
 purpose, and to create a reference record for the temporary.   The
 procedure  LoadValue is used to reload a result saved in this way,
 or to load the value of a constant expression (which would not  be
 saved).   LoadValue does not alter the stack record describing the
 value to be loaded, so that multiple (re-) loading operations  may
 be applied.

                                                                     }

procedure SaveValue(ExpValue: StackEntry);
visible;

  begin
    with ExpValue^ do
      begin
        Kind := Reference;
        Indirect := false;
        Class := VarRef;
        AccessList := nil;
        Acquire(1, BaseAddress);
        Adjustment := 0;
        PartOfWord := false;
        Indexed := false;
        with BaseAddress do
          AccessWord(BlockLevel, WordOffset, StoreOp)
      end
  end { savevalue };

procedure LoadValue(TempEntry: StackEntry);
visible;

  begin
    with TempEntry^ do
      if Kind = AConstant
      then {InlineNumber(TheConst.Ival)		}
      else
        with BaseAddress do
          if Indirect
          then
            begin
              AccessWord(BlockLevel, WordOffset, LoadOp);
              AdjustLoad(Adjustment)
            end
          else AccessWord(BlockLevel, WordOffset + Adjustment, LoadOp)
  end { loadvalue };

begin
{end of module}
end.