-- file UtilsHot.Mesa
-- last modified by Bruce, October 28, 1980  12:17 PM
-- last modified by Johnsson,  July 18, 1980  8:57 AM

DIRECTORY
  ComData USING [typeCARDINAL, typeStringBody],
  Copier USING [SearchFileCtx],
  DContext USING [GetGlobal],
  DebugOps USING [BitAddress, LongCopyREAD],
  DI USING [Foo, SearchCtxForVal, UnionSEIndex, ValFormat, VType],
  DSyms USING [GFHandle, GFrameHti],
  Gf USING [],
  Init USING [],
  Inline USING [COPY, LowHalf],
  LiteralOps USING [DescriptorValue, StringValue],
  Literals USING [LitDescriptor, LitRecord, ltType],
  Lookup USING [HTIndex, HtiToString, MakeFoo],
  MachineDefs USING [FieldDescriptor, GFHandle, LCOPY, WordLength],
  Mopcodes USING [zRFS],
  Storage USING [CopyString, Node],
  String USING [WordsForString],
  Strings USING [AppendSubString, SubString, SubStringDescriptor],
  SymbolOps USING [BitsForType, EnterString, SearchContext, SubStringForHash, UnderType],
  SymbolPack,
  Symbols USING [codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex, CTXNull, ctxType, HTIndex, ISEIndex, ISENull, mdType, RecordSEIndex, SEIndex, seType, TypeClass, typeTYPE],
  Table USING [AddNotify, Base, DropNotify, Notifier];

UtilsHot: PROGRAM
    IMPORTS
	com: ComData, Copier, DContext, DebugOps, DI, Strings, DSyms, Inline,
	LiteralOps, Lookup, MachineDefs, Storage, SymbolOps,
        myBase: SymbolPack, String, Table
    EXPORTS DI, Gf, Init, Lookup
    SHARES Copier = 
  BEGIN
  OPEN DI, SymbolOps, Symbols;

  LiteralProblem: ERROR = CODE;
  StrangeRecord: ERROR = CODE;
  WrongTypeClass: ERROR [f: Foo] = CODE;

  DefaultOutputFormat: PUBLIC ValFormat _ [card[]];

-- tables defining the current symbol table

  seb: Table.Base;		-- se table
  mdb: Table.Base;		-- module table
  ltb: Table.Base;
  ctxb: Table.Base;		-- context table

  Notify: Table.Notifier =
    BEGIN
    ltb _ base[Literals.ltType];
    seb _ base[seType]; ctxb _ base[ctxType]; mdb _ base[mdType]
    END;

  entryDepth: CARDINAL _ 0;

  Enter: PROCEDURE =
    BEGIN
    IF entryDepth = 0 THEN Table.AddNotify[Notify];
    entryDepth _ entryDepth + 1;
    END;

  Exit: PROCEDURE =
    BEGIN
    IF (entryDepth _ entryDepth-1) = 0 THEN Table.DropNotify[Notify];
    END;

  Name: PUBLIC PROCEDURE [name: STRING, gf: MachineDefs.GFHandle _ NIL] =
    BEGIN
    hti: Symbols.HTIndex = DSyms.GFrameHti[IF gf = NIL THEN DContext.GetGlobal[] ELSE gf];
    Lookup.HtiToString[hti,name];
    END;
  
  CopyLiteral: PUBLIC PROCEDURE [info: Literals.LitRecord]
    RETURNS [p: POINTER, length: CARDINAL] =
    BEGIN
    Enter[];
    WITH info SELECT FROM
      word =>
	BEGIN
	lit: Literals.LitDescriptor _ LiteralOps.DescriptorValue[index];
	length _ lit.length;
	p _ Storage.Node[length];
	MachineDefs.LCOPY[from: @ltb[lit.offset], to: p, nwords: length];
	END;
      string =>
	BEGIN
	s: STRING _
	  Storage.CopyString[LiteralOps.StringValue[index]];
	length _ String.WordsForString[s.length];
	p _ s;
	END;
      ENDCASE => ERROR LiteralProblem;
    Exit[];
    END;

  StringToHti: PUBLIC PROC [s: STRING] RETURNS [HTIndex] =
    BEGIN
    desc: Strings.SubStringDescriptor _ [base: s, offset: 0, length: s.length];
    RETURN[SymbolOps.EnterString[@desc]];
    END;

  HtiToString: PUBLIC PROC [hti: HTIndex, s: STRING] =
    BEGIN
    desc: Strings.SubStringDescriptor;
    ss: Strings.SubString _ @desc;
    SymbolOps.SubStringForHash[ss,hti];
    Strings.AppendSubString[s,ss];
    END;

  SearchCtxList: PUBLIC PROC [hti: HTIndex, ctx: CTXIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN
    found: BOOLEAN _ TRUE;
    IF ctx = CTXNull THEN RETURN [ISENull];
    IF (sei _ SymbolOps.SearchContext[hti,ctx]) # ISENull THEN RETURN;
    Enter[];
    WITH ctxb[ctx] SELECT FROM
      included => IF ~complete THEN 
	[found, sei] _ Copier.SearchFileCtx[hti, LOOPHOLE[ctx]];
      imported => sei _ SearchCtxList[hti,includeLink];
      simple => NULL;
      ENDCASE => sei _ ISENull;
    Exit[];
    IF ~found THEN sei _ ISENull;
    RETURN;
    END;

  CheckClass: PUBLIC PROC [tc: TypeClass, f: Foo] RETURNS [UNSPECIFIED] =
    BEGIN
    csei: CSEIndex _ TypeForSe[f.tsei];
    Enter[];
    IF seb[csei].typeTag # tc THEN ERROR WrongTypeClass[f];
    Exit[];
    RETURN[csei];
    END;

  FindField: PUBLIC PROC [f: Foo, pad: CARDINAL, isei: ISEIndex]
      RETURNS [field: Foo] =
    BEGIN
    IF f.addr.useStack THEN field _ Lookup.MakeFoo[isei,f.addr]
    ELSE
      BEGIN
      Enter[];
      field _ Find[f,pad,isei];
      Exit[];
      END;
    IF field = NIL THEN RETURN;
    field.there _ f.there; field.xfer _ f.xfer; field.indent _ f.indent;
    IF ~f.there THEN FixupHeap[f,field];
    END;

  FixupHeap: PROC [old, new: Foo] = {
    OPEN Inline;
    words: CARDINAL _ old.words + (IF old.bits = 0 THEN 0 ELSE 1);
    new.addr.base _ Storage.Node[words];
    COPY[from: LowHalf[old.addr.base], nwords: words, to: LowHalf[new.addr.base]]};

  Find: PROC [f: Foo, pad: CARDINAL, isei: ISEIndex]
      RETURNS [field: Foo] = INLINE
    BEGIN
    ba: DebugOps.BitAddress _ f.addr;
    notNested: BOOLEAN = ba.offset = 0;
    first: BOOLEAN = seb[isei].idValue = 0;
    sizeInc: CARDINAL;
    IF first AND notNested THEN {sizeInc _ pad; ba.offset _ 0}
    ELSE {sizeInc _ 0; ba.offset _ pad};
    field _ Lookup.MakeFoo[isei, ba, sizeInc]
    END;

  Pad: PUBLIC PROC [f: Foo, rsei: RecordSEIndex] RETURNS [pad: CARDINAL] =
    BEGIN
    size: CARDINAL _ SymbolOps.BitsForType[rsei];
    pad _ 0;
    IF size > 0 AND size < 16 THEN
      BEGIN
      available: CARDINAL _ IF f.bits # 0 THEN f.bits ELSE 16;
      IF available < size THEN ERROR StrangeRecord;
      pad _ f.addr.offset + available - size;
      END;
    END;

  VariantType: PUBLIC PROC [usei: UnionSEIndex] RETURNS [v: VType] =
    BEGIN OPEN seb[usei];
    Enter[];
    IF ~controlled THEN v _ IF overlaid THEN overlaid ELSE computed
    ELSE v _ controlled;
    Exit[];
    END;

  TagIsei: PUBLIC PROC [f: Foo, pad: CARDINAL, usei: UnionSEIndex]
    RETURNS [isei: ISEIndex] =
    BEGIN OPEN SymbolOps;
    tag: Foo;
    val: CARDINAL;
    ictx: CTXIndex;
    Enter[];
    tag _ FindField[f,pad,seb[usei].tagSei];
    ictx _ seb[usei].caseCtx;
    Exit[];
    IF tag.bits + tag.addr.offset > MachineDefs.WordLength THEN
      ERROR StrangeRecord;
    GetValue[tag];
    val _ tag.addr.base^;
    isei _ DI.SearchCtxForVal[val,ictx,none];
    END;

  TypeForSe: PUBLIC PROC [sei: SEIndex] RETURNS [type: CSEIndex] = 
    BEGIN
    Enter[];
    DO
      WITH seb[sei] SELECT FROM
	id => IF idType # typeTYPE THEN sei _ idType ELSE EXIT;
	ENDCASE => EXIT;
      ENDLOOP;
    Exit[];
    RETURN[UnderType[sei]];
    END;

  RFS: PROC [POINTER, MachineDefs.FieldDescriptor] RETURNS [UNSPECIFIED] =
    MACHINE CODE BEGIN Mopcodes.zRFS END;

  ReadField: PROCEDURE [f: Foo] =
    BEGIN OPEN f;
    fd: MachineDefs.FieldDescriptor _
      [offset: 0, posn: addr.offset, size: bits];
    p: POINTER _ Inline.LowHalf[addr.base];
    p^ _ RFS[p,fd];
    END;

  GetValue: PUBLIC PROCEDURE [f: Foo] =
    BEGIN OPEN f;
    p: LONG POINTER;
    cnt: CARDINAL _ words + (IF bits = 0 THEN 0 ELSE 1);
    IF there THEN {
      p _ Storage.Node[cnt];
      DebugOps.LongCopyREAD[from: addr.base, to: p, nwords: cnt];
      addr.base _ p;
      there _ FALSE};
    IF bits # 0 THEN ReadField[f];
    END;

Format: PUBLIC PROCEDURE [sei: SEIndex]
    RETURNS [vf: ValFormat, intSub: BOOLEAN] =
  BEGIN
  inSubrange: BOOLEAN _ FALSE;
  csei: CSEIndex;
  vf _ [none[]];
  intSub _ FALSE;
  csei _ TypeForSe[sei];
  Enter[];
  DO
    WITH seb[csei] SELECT FROM
      basic => 
	BEGIN
	SELECT code FROM
	  codeANY => vf _ DefaultOutputFormat;
	  codeINT => BEGIN intSub _ inSubrange; vf _ [int[]] END;
	  codeCHAR => vf _ [char[]];
	  ENDCASE;
	GOTO exit;
	END;
      subrange =>
	BEGIN
	IF csei = com.typeCARDINAL THEN { vf _ DefaultOutputFormat; GOTO exit };
	csei _ UnderType[rangeType];
	inSubrange _ TRUE
	END;
      enumerated =>
	BEGIN
	intSub _ FALSE;
	vf _ [enum[LOOPHOLE[csei]]];
	GOTO exit
	END;
      ref =>
	BEGIN
	IF UnderType[refType] = com.typeStringBody THEN vf _ [string[]]
	ELSE vf _ [pointer[]];
	GOTO exit
	END;
      relative => BEGIN vf _ [relative[]]; GOTO exit END;
      ENDCASE => GOTO exit;
    ENDLOOP;
  EXITS exit => {Exit[]; RETURN};
  END;

  END.