{

 History
 -------

 17/10/85 - Many changes: byte and half-word alignment for record
            fields allocated by AllocateLevel, canonical representation
            for set-types, AdjustRepresentationFor for ICL sub-types,
            CheckRepresentation for ICL cast variables, field allocation
            for record default variants, removal of redunant procedures
            and variables. (agh)
 17/10/85 - Outdated documentation removed. Reformatted. (agh)
 21/10/85 - Remove redundant procedure AugmentSchema. (agh)
 22/10/85 - Remove AugmentRepresentationFor and associated calls.
            Remove dependency on envelope.pf. (agh)
 24/10/85 - Correct storage allocation for arrays to handle arrays of
            char.
 20/11/85 - Fix bug to ensure unpacked record fields are correctly
            aligned. (agh)
 22/11/85 - Modify set and subrange representation logic to handle
            base and host-types that are word-types. (agh) 
 25/11/85 - Change comparison limit in Validate to MaxMemWord. (agh)
 01/12/85 - Many changes to handle dual bit and byte-level packing.
            (agh)
 09/12/85 - Add PrintRep and PrintField for Map option. (agh)
 --------------------------------------------------------------------
 12/12/85 - Add function ByteAligned for possible future use. (agh)
                                                                     } 
{+doc 13.0

                          MODULE 13


                     Data Representations


                                                                     }


program DataRepresentations;
  
#include "globals.x"
#include "source.pf"
#include "semantics.pf"
#include "generator.pf"
#include "objvalues.pf"

{+doc 13.1 Representation Utilities }

  procedure Validate(var DataSize: Scalar);
    
    begin
      if DataSize > MCMaxMemWord
      then
        begin
          SystemError(2);
          DataSize := MCBytesPerWord
        end
    end { validate };
  
  function WordsFor(Units, UnitsPerWord: Scalar): Scalar;
    visible;
    
    var Words: Scalar;
    
    begin
      Words := Units div UnitsPerWord;
      if (Units mod UnitsPerWord) <> 0
      then WordsFor := Words + 1 else WordsFor := Words
    end { wordsfor };
  
  function BytesFor(MaxVal: MCScalar): MCByteRange;
    
    begin
      if MaxVal > MCMaxHalfWord
      then BytesFor := MCBytesPerWord
      else 
        if MaxVal > MCMaxByte
        then BytesFor := MCBytesPerHalfWord
        else BytesFor := 1
    end { bytesfor };

  function BitsFor(MaxVal: MCScalar): MCBitRange;
   
    var Bits: MCBitRange;

    begin
      Bits := 0;
      repeat
        Bits := Bits + 1;
        MaxVal := MaxVal div 2
      until MaxVal = 0;
      BitsFor := Bits
    end { BitsFor };

  function DataBytes(Representation: TypeRepresentation): Scalar;
    visible;

    { This function returns the unpacked byte-size for the }
    { given representation.                                }

    begin
      with Representation do
        if Kind = ForChar 
        then DataBytes := 1 else DataBytes := WordSize * MCBytesPerWord
    end { DataBytes };

  function DataSize(Representation: TypeRepresentation): Scalar;
    visible;

    { This function returns the byte-size of a value for the }
    { given representation.                                  }

    begin
      with Representation do
        if Kind = ForChar
        then DataSize := 1 else DataSize := WordSize * MCBytesPerWord
    end { DataSize };

  procedure Align(var Offset: Scalar; Amount: ByteRange);
    visible;
  
    procedure Adjust(Delta: MCByteRange);

      begin
         Offset := ((Offset + Delta - 1) div Delta) * Delta
      end { Adjust };

    begin
      if Amount >= MCBytesPerWord
      then Adjust(MCBytesPerWord)
      else
        if Amount >= MCBytesPerHalfWord
        then Adjust(MCBytesPerHalfWord)
    end { Align };
  
  function Cardinality(OrdinalType: TypEntry): integer;
    visible;
    
    var TypeMin, TypeMax: ObjectValue;
    
    begin
      GetBounds(OrdinalType, TypeMin, TypeMax);
      Cardinality := Range(TypeMin, TypeMax)
    end { cardinality };

  function IndexUnit(PackedArray: Boolean;
                     ElementRep: TypeRepresentation): AccessUnit;
    visible;

    begin
      with ElementRep do
        if Kind = ForChar
        then IndexUnit := Bytes
        else
          if PackedArray and (BitsPacked in Requested) and
             (BitSize <= MCBitsPerHalfWord)
          then IndexUnit := Bits
          else
            if PackedArray and not (BitsPacked in Requested) and 
               (ByteSize <= MCBytesPerHalfWord)
            then IndexUnit := Bytes
            else IndexUnit := Words
    end { IndexUnit };

  function FieldUnit(PackedRecord: Boolean; 
                     FieldRep: TypeRepresentation): AccessUnit;
    visible;
  
    begin
      with FieldRep do
        if not PackedRecord and (Kind = ForChar)
        then FieldUnit := Bytes
        else
          if PackedRecord and (BitsPacked in Requested) and
             (BitSize < MCBitsPerWord)
          then FieldUnit := Bits
          else
            if PackedRecord and not (BitsPacked in Requested) and
               (ByteSize <= MCBytesPerHalfWord)
            then FieldUnit := Bytes
            else FieldUnit := Words
    end { FieldUnit };

  function ByteAligned(TheType: TypEntry): Boolean;

    function AlignedFields(FixedPart: IdEntry; VarPart: TypEntry): Boolean;

      var 
        Aligned: Boolean;
        Variant: TypEntry;

      begin
        if FixedPart <> nil
        then AlignedFields := ByteAligned(FixedPart^.IdType)
        else
          if VarPart <> nil
          then
            with VarPart^ do
              if TagField <> nil
              then AlignedFields := ByteAligned(TagField^.IdType)
              else
                begin
                  Aligned := false;
                  Variant := FirstVariant;
                  while not Aligned and (Variant <> nil) do
                    if ByteAligned(Variant)
                    then Aligned := true
                    else Variant := Variant^.NextVariant;
                  if not Aligned and (DefaultVariant <> nil)
                  then Aligned := ByteAligned(DefaultVariant);
                  AlignedFields := Aligned
                end
           else AlignedFields := false
      end { AlignedFields };

    begin
      with TheType^ do
        case Form of
          Scalars : ByteAligned := (TheType = CharType);
          SubRanges : ByteAligned := (RangeType = CharType);
          Sets : ByteAligned := true;
          Arrays : ByteAligned := ByteAligned(AelType);
          Records : ByteAligned := AlignedFields(FixedPart, VarPart);
          Variant : ByteAligned := AlignedFields(SubFixedPart, SubVarPart);
          Pointers, Files, CAPSchema, VariantPart : ByteAligned := false
        end
    end { ByteAligned };
         

{+doc 13.2 Type Representations }
  
  procedure SetRepresentationFor(TheType: TypEntry);
    visible;
    
    var
      TheMax, TheMin: ObjectValue;
      ElsPerWord, BitsNeeded: MCBitRange;
      BytesNeeded, WordsNeeded: Scalar;
      Members: MCScalar;
      Packing: Boolean;
      StoreUnit: AccessUnit;
    
    procedure AllocateLevel
                (FixedPart: IdEntry; VariantPart: TypEntry;
                 StartByte: Scalar; StartBits: MCBitRange;
                 var MaxByteSize: Scalar; var MaxBitSize: MCBitRange);      
      var
        ByteFree, ThisVarByteSize: Scalar;
        BitsFree, ThisVarBitSize: MCBitRange;
        ThisField, LastField: IdEntry;
        LastVariant, ThisVariant: TypEntry;
        SelectorValue: MCIntegerForm;

      procedure SpreadLastField;

        begin
          if LastField <> nil
          then
            begin
              with LastField^.Offset do
                if BitOffset = 0
                then
                  begin
                    FieldKind := Words;
                    WordSize := 1
                  end
                else BitSize := MCBitsPerWord - BitOffset;
              ByteFree := ByteFree + MCBytesPerWord;
              BitsFree := MCBitsPerWord;
              LastField := nil
            end
          else
            if BitsFree <> MCBitsPerWord
            then
              begin
                ByteFree := ByteFree + MCBytesPerWord;
                BitsFree := MCBitsPerWord
              end
        end { SpreadLastField };

      procedure Allocate(FieldEntry: IdEntry);
        
        var
          WordsNeeded: Scalar;
          BytesNeeded: Scalar;
          BitsNeeded: MCBitRange;
        
        begin
          with FieldEntry^ do
            begin
              StoreUnit := FieldUnit(Packing, IdType^.Representation); 
              case StoreUnit of
                Bits :
                  begin
                    BitsNeeded := IdType^.Representation.BitSize;
                    if BitsNeeded > BitsFree then SpreadLastField;
                    with Offset do
                      begin
                        ByteOffset := ByteFree;
                        FieldKind := Bits;
                        BitSize := BitsNeeded;
                        BitOffset := MCBitsPerWord - BitsFree
                      end;
                    BitsFree := BitsFree - BitsNeeded;
                    if BitsFree = 0
                    then
                      begin
                        ByteFree := ByteFree + MCBytesPerWord;
                        BitsFree := MCBitsPerWord;
                        LastField := nil
                      end
                    else LastField := FieldEntry
                  end;
                Bytes :
                  begin
                    BytesNeeded := IdType^.Representation.ByteSize;
                    Align(ByteFree, BytesNeeded);
                    with Offset do
                      begin
                        ByteOffset := ByteFree;
                        FieldKind := Bytes;
                        ByteSize := BytesNeeded
                      end;
                    ByteFree := ByteFree + BytesNeeded
                  end;
                Words :
                  begin
                    WordsNeeded := IdType^.Representation.WordSize;
                    BytesNeeded := WordsNeeded * MCBytesPerWord;
                    if (BitsPacked in Requested) and Packing
                    then SpreadLastField
                    else Align(ByteFree, BytesNeeded);
                    with Offset do
                      begin
                        ByteOffset := ByteFree;
                        FieldKind := Words;
                        WordSize := WordsNeeded
                      end;
                    ByteFree := ByteFree + BytesNeeded;
                    LastField := nil
                  end
              end
            end
        end { allocate };

      procedure SpreadSelector;
        
        var
          SelectorMustSpread: Boolean;
          FirstActualField: IdEntry;
        
        begin
          with VariantPart^ do
            begin
              SelectorMustSpread := true;
              ThisVariant := FirstVariant;
              while (ThisVariant <> nil) and SelectorMustSpread do
                with ThisVariant^ do
                  begin
                    if SubFixedPart <> nil
                    then FirstActualField := SubFixedPart
                    else
                      if SubVarPart = nil
                      then FirstActualField := nil
                      else FirstActualField := SubVarPart^.TagField;
                    if FirstActualField <> nil
                    then
                      with FirstActualField^.IdType^ do
                        if FieldUnit(Packing, Representation) <> Words
                        then SelectorMustSpread := false;
                    ThisVariant := NextVariant
                  end;
              if SelectorMustSpread
              then
                if BitsPacked in Requested
                then SpreadLastField
                else Align(ByteFree, MCBytesPerWord)
            end
        end { spreadselector };

      procedure FixVarRepresentation(ThisVariant: TypEntry);

        begin
          with ThisVariant^.Representation do
            begin
              WordSize := WordsFor(ThisVarByteSize, MCBytesPerWord);
              if WordSize = 1
              then 
                begin
                  ByteSize := ThisVarByteSize;
                  BitSize := ThisVarBitSize
                end;
              Kind := ForVariant
            end
        end { FixVarRepresentation };

    procedure FixMaxRepresentation;

      begin
        if ThisVarByteSize > MaxByteSize
        then 
          begin
            MaxByteSize := ThisVarByteSize;
            MaxBitSize := ThisVarBitSize
          end
        else
          if ThisVarByteSize = MaxByteSize
          then
            if ThisVarBitSize > MaxBitSize
            then MaxBitSize := ThisVarBitSize
      end { FixMaxRepresentation };
      
      begin { allocatelevel }
        ByteFree := StartByte;
        BitsFree := StartBits;
        LastField := nil;
        ThisField := FixedPart;
        while ThisField <> nil do
          begin
            Allocate(ThisField);
            ThisField := ThisField^.NextField
          end;
        if VariantPart <> nil
        then
          begin
            with VariantPart^ do
              if TagField <> nil then Allocate(TagField);
            if Packing then SpreadSelector;
            if BitsFree = MCBitsPerWord
            then
              begin
                MaxByteSize := ByteFree;
                MaxBitSize := MCBitsPerWord
              end
            else
              begin
                MaxByteSize := ByteFree + MCBytesPerWord;
                MaxBitSize := MCBitsPerWord - BitsFree
             end;
            LastVariant := Unknown;
            ThisVariant := VariantPart^.FirstVariant;
            while ThisVariant <> nil do
              with ThisVariant^ do
                begin
                  if Distinct
                  then
                    begin
                      AllocateLevel
                        (SubFixedPart, SubVarPart, ByteFree, BitsFree, 
                         ThisVarByteSize, ThisVarBitSize);
                      FixVarRepresentation(ThisVariant);
                      FixMaxRepresentation;
                      LastVariant := ThisVariant
                    end
                  else Representation := LastVariant^.Representation;
                  ThisVariant := NextVariant
                end;
             with VariantPart^ do
               if DefaultVariant <> nil
               then
                 with DefaultVariant^ do
                   begin
                     AllocateLevel
                      (SubFixedPart, SubVarPart, ByteFree, BitsFree, 
                       ThisVarByteSize, ThisVarBitSize);
                     FixVarRepresentation(DefaultVariant);
                     FixMaxRepresentation
                   end
          end
        else
          begin
            if Packing and (BitsPacked in Requested) and (ByteFree > 0)
            then SpreadLastField;
            if BitsFree = MCBitsPerWord
            then
              begin
                MaxByteSize := ByteFree;
                if MaxByteSize > 0
                then MaxBitSize := MCBitsPerWord else MaxBitSize := 0
              end
            else
              begin
                MaxByteSize := ByteFree + MCBytesPerWord;
                MaxBitSize := MCBitsPerWord - BitsFree
              end
          end
      end { allocatelevel };
    
    begin
      if TheType <> Unknown
      then
        with TheType^ do
          case Form of
            Scalars :
              if ScalarKind = Declared
              then
                with Representation do
                  begin
                    Kind := ForScalar;
                    GetBounds(TheType, TheMin, TheMax);
                    ByteSize := BytesFor(TheMax.Ival);
                    BitSize := BitsFor(TheMax.Ival);
                    Max := TheMax.Ival
                  end;
            SubRanges :
              with Representation do
                if RangeType = WordType
                then
                  begin
                    Kind := ForWord;
                    WMin := TheType^.Min.Wval;
                    WMax := TheType^.Max.Wval;
                    if WMax < wrd(MCMaxint)
                    then 
                      begin
                        ByteSize := BytesFor(int(WMax));
                        BitSize := BitsFor(int(WMax))
                      end
                  end
                else
                  begin
                    Kind := ForScalar;
                    Min := TheType^.Min.Ival;
                    Max := TheType^.Max.Ival;
                    if Min >= 0 
                    then 
                      begin
                        ByteSize := BytesFor(Max);
                        BitSize := BitsFor(Max)
                      end
                  end;
            Pointers : Representation := PtrRepresentation;
            Sets :
              if BaseType <> Unknown
              then
                with Representation do
                  begin
                    Kind := ForSet;
                    if (FormOfSet = Constructed) and 
                       ((BaseType = IntType) or (BaseType = WordType))
                    then 
                      begin
                        Min := 0;
                        Max := MCMaxSet - 1;
                        Members := MCMaxSet
                      end
                    else
                      begin
                        GetBounds(BaseType, TheMin, TheMax);
                        if (TheMin.Ival < 0) or (TheMin.Ival >= MCMaxSet) 
                        then SystemError(3) else Min := TheMin.Ival;
                        if (TheMax.Ival < 0) or (TheMax.Ival >= MCMaxSet)
                        then SystemError(3) else Max := TheMax.Ival;
                        if BaseType^.Form = SubRanges
                        then GetBounds(BaseType^.RangeType, TheMin, TheMax);
                        Members := HostInt(TheMax);
                        if Members >= MCMaxSet - 1 
                        then Members := MCMaxSet 
                        else Members := Members + 1
                      end;
                    WordSize := WordsFor(Members, MCWordSetBits)
                  end;
            Arrays :
              if (AelType <> Unknown) and (InxType <> Unknown)
              then
                begin
                  Members := Cardinality(InxType);
                  StoreUnit := 
                    IndexUnit(PackedArray, AelType^.Representation);
                  case StoreUnit of
                    Bits :
                      begin
                        ElsPerWord := 
                          MCBitsPerWord div 
                            AelType^.Representation.BitSize;
                        WordsNeeded := WordsFor(Members, ElsPerWord)
                      end;
                    Bytes :
                      begin
                        ElsPerWord := 
                          MCBytesPerWord div 
                            AelType^.Representation.ByteSize;
                        WordsNeeded := WordsFor(Members, ElsPerWord)
                      end;
                    Words :
                      WordsNeeded := 
                        Members * AelType^.Representation.WordSize
                  end;
                  Validate(WordsNeeded);
                  with Representation do
                    begin
                      Kind := ForArray;
                      WordSize := WordsNeeded
                    end
                end;
            CAPSchema :
              with Representation do
                begin
                  Kind := ForCAP;
                  if CompType^.Form = CAPSchema
                  then
                    WordSize :=
                      CompType^.Representation.ByteSize + MCCAPBpSize
                  else WordSize := MCCAPBpSize
                end;
            Records :
              begin
                Packing := PackedRecord;
		AllocateLevel
                  (FixedPart, VarPart, 0, MCBitsPerWord, 
                   BytesNeeded, BitsNeeded);
                WordsNeeded := WordsFor(BytesNeeded, MCBytesPerWord);
                Validate(WordsNeeded);
                with Representation do
                  begin
                    Kind := ForARecord;
                    WordSize := WordsNeeded;
                    if WordsNeeded = 1 
                    then
                      begin
                        ByteSize := BytesNeeded;
                        BitSize := BitsNeeded
                      end
                  end
              end;
            Files :
              with Representation do
                begin
                  Kind := ForFile;
                  WordSize := MCFCBSize div MCBytesPerWord
                end
          end { case }
    end { setrepresentationfor };
  
{+doc 13.3 Representation Predicates }

  function OrderedReps(Rep1, Rep2: TypeRepresentation): Boolean;

    begin
      if Rep1.WordSize < Rep2.WordSize
      then OrderedReps := true
      else
        if (Rep1.WordSize = Rep2.WordSize)
        then
          if BitsPacked in Requested
          then OrderedReps := (Rep1.BitSize <= Rep2.BitSize)
          else OrderedReps := (Rep1.ByteSize <= Rep2.ByteSize)
        else OrderedReps := false
    end { OrderedReps };

  function SameReps(Rep1, Rep2: TypeRepresentation): Boolean;

    begin
      if BitsPacked in Requested
      then
        SameReps := (Rep1.WordSize = Rep2.WordSize) and
                    (Rep1.BitSize = Rep2.BitSize)
      else
        SameReps := (Rep1.WordSize = Rep2.WordSize) and
                    (Rep1.ByteSize = Rep2.ByteSize)
    end { SameReps };

  procedure AdjustRepresentationFor(TheType: TypEntry);
    visible;
    
    begin
      with TheType^ do
        if Occupying <> Unknown
        then
          if not OrderedReps(Representation, Occupying^.Representation)
          then SemanticError(282)
          else 
            begin
              Representation.WordSize := Occupying^.Representation.WordSize;
              Representation.ByteSize := Occupying^.Representation.ByteSize;
              Representation.BitSize := Occupying^.Representation.BitSize
            end
    end { AdjustRepresentationFor };

  procedure CheckRepresentation(Rep1, Rep2: TypeRepresentation);
    visible;

    begin
      if not SameReps(Rep1, Rep2) then WarningError(4)
    end { CheckRepresentation };

{+doc 13.5 SetBaseLimits }
  
  procedure SetBaseLimits(var SetRep: TypeRepresentation;
                          SetConstant: ObjectValue);
    visible;
    
    var SetWord: WordEntry;
    
    function ZeroBits(SetWord: MCWordForm; Delta, BitIndex: integer):
               integer;
      
      var
        BitValue: MCBit;
        Count: integer;
      
      begin
        Count := 0;
        repeat
          MCGetBit(SetWord, BitIndex, BitValue);
          if BitValue = 0 then Count := Count + 1;
          BitIndex := BitIndex + Delta
        until BitValue <> 0;
        ZeroBits := Count
      end { ZeroBits };
    
    begin
      with SetRep do
        begin
          Min := 0;
          Max := 0;
          SetWord := SetConstant.Setval;
          if SetWord <> nil
          then
            begin
              while SetWord^.Word.WValue = 0 do
                begin
                  Min := Min + MCWordSetBits;
                  SetWord := SetWord^.Next
                end;
              Max := Min + MCMaxSetBit;
              Min := Min + ZeroBits(SetWord^.Word, +1, 0);
              while SetWord^.Next <> nil do
                begin
                  Max := Max + MCWordSetBits;
                  SetWord := SetWord^.Next
                end;
              Max := Max + ZeroBits(SetWord^.Word, -1, MCMaxSetBit)
            end
        end
    end { setbaselimits };

{+doc 13.6 Diagnostics }

  procedure PrintField(Offset: FieldOffset; var f: text);
    visible;

    begin
      with Offset do
        begin
          write(f, '[ Offset = ', ByteOffset:1);
          case FieldKind of
            Words: write(f, ' Words = ', WordSize:1);
            Bytes: write(f, ' Bytes = ', ByteSize:1);
            Bits: 
              write(f, ' Bits = ', BitSize:1, ' BitOffset = ', BitOffset:1)
          end;
          write(f, ' ]');
        end
    end { PrintField };

  procedure PrintRep(Representation: TypeRepresentation; var f: text);
    visible;

    begin
      with Representation do
        begin
          write
            (f, '[ ', 'Words = ', WordSize:1, ' Bytes = ', ByteSize:1,
             ' Bits = ', BitSize:1, ' ]')
        end
    end { PrintRep };
          

{+doc 13.7 Standard Representations }

  procedure InitRepresentations;
    visible;
    
    begin
      
      { set the default representation }
      with DefaultRepresentation do
        begin
          WordSize := 1;
          ByteSize := MCBytesPerWord;
          BitSize := MCBitsPerWord;
          Kind := ForOther
        end;
      
      { set the standard representations }
      with EmptyRepresentation do
        begin
          WordSize := 0;
          ByteSize := 0;
          BitSize := 0;
          Kind := ForSet;
          Min := 0;
          Max := 0
        end;
      with RealRepresentation do
        begin
          WordSize := MCRealSize;
          ByteSize := MCBytesPerWord;
          BitSize := MCBitsPerWord;
          Kind := ForReal
        end;
      with BooleanRepresentation do
        begin
          WordSize := 1;
          ByteSize := 1;
          BitSize := 1;
          Kind := ForScalar;
          Min := 0;
          Max := 1
        end;
      with CharRepresentation do
        begin
          WordSize := 1;
          ByteSize := 1;
          BitSize := MCBitsPerByte;
          Kind := ForChar;
          Min := 0;
          Max := MCMaxChar
        end;
      with IntegerRepresentation do
        begin
          WordSize := 1;
          ByteSize := MCBytesPerWord;
          BitSize := MCBitsPerWord;
          Kind := ForScalar;
          Max := MCMaxint;
          Min := -MCMaxint
        end;
      with PtrRepresentation do
        begin
          WordSize := 1;
          ByteSize := MCBytesPerWord;
          BitSize := MCBitsPerWord;
          Kind := ForPnter
        end;
      with WordRepresentation do
        begin
          WordSize := 1;
          ByteSize := MCBytesPerWord;
          BitSize := MCBitsPerWord;
          Kind := ForWord;
          WMin := 10#0;
          WMax := MCMaxWord
        end
    end { initrepresentations };
  
  begin 
  { end of module }
  end.