-- file DIUtils.Mesa
-- last modified by Bruce, May 30, 1980  7:01 PM

DIRECTORY
  ComData: FROM "comdata",
  ControlDefs: FROM "controldefs",
  Copier: FROM "copier",
  DebugOps: FROM "debugops",
  DI: FROM "DI",
  DIActions: FROM "DIActions",
  Gf: FROM "gf",
  InlineDefs,
  Lookup,
  MachineDefs: FROM "machinedefs",
  Mopcodes USING [zRFS, zWFS],
  PrincOps: FROM "princops",
  Storage: FROM "storage",
  String,
  Symbols: FROM "symbols",
  SymbolOps: FROM "symbolops",
  SymbolPack: FROM "symbolpack",
  SymbolTable: FROM "symboltable",
  Table: FROM "table" USING [Base, Notifier, AddNotify, DropNotify];

DIUtils: PROGRAM
    IMPORTS
	com: ComData, Copier, DebugOps, DIActions, Gf, InlineDefs,
	Lookup, Storage, SymbolOps, myBase: SymbolPack, String, Table
    EXPORTS DI, DIActions, Lookup
    SHARES Copier = 
  BEGIN
  OPEN DI, DIActions, SymbolOps, Symbols;

  NotAProcedure: PUBLIC ERROR [cl: MachineDefs.ControlLink] = CODE;
  NotAnArray: PUBLIC ERROR = CODE;
  NotHere: PUBLIC ERROR = CODE;
  SizeMismatch: PUBLIC ERROR = CODE;

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

-- tables defining the current symbol table

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

  Notify: Table.Notifier =
    BEGIN  -- called whenever the main symbol table is repacked
    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;


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

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

-- finding union and discriminated types

  VariantUnionType: PUBLIC PROC [type: SEIndex] RETURNS [vType: CSEIndex] =
    BEGIN
    rType: CSEIndex;
    Enter[];
    rType _ TypeForSe[type];
    vType _ WITH seb[rType] SELECT FROM
      record =>
	IF hints.variant
	  THEN UnderType[TypeForSe[UnionField[LOOPHOLE[rType]]]]
	  ELSE typeANY,
      ENDCASE => typeANY;
    Exit[];
    RETURN
    END;


  SelectVariantType: PUBLIC PROCEDURE [type: SEIndex, tag: HTIndex] RETURNS [sei: ISEIndex] =
    BEGIN
    vType: CSEIndex = VariantUnionType[type];
    Enter[];
    WITH seb[vType] SELECT FROM
      union => sei _ SearchCtxList[tag, caseCtx];
      ENDCASE => sei _ ISENull;
    Exit[];
    IF sei = ISENull THEN AbortWithError[unknownVariant, tag];
    RETURN
    END;


-- auxiliary procedures 

  UnionField: PROCEDURE [rSei: RecordSEIndex] RETURNS [ISEIndex] = INLINE
    BEGIN
    sei, root, next: ISEIndex;
    ctx: CTXIndex = seb[rSei].fieldCtx;
    repeated: BOOLEAN;
    IF ctxb[ctx].ctxType = simple
      THEN
	FOR sei _ ctxb[ctx].seList, next UNTIL sei = ISENull
	  DO
	  next _ NextSe[sei];
	  IF next = ISENull THEN RETURN [sei];
	  ENDLOOP
      ELSE
	BEGIN	-- defined elsewhere, UnderType is safe
	repeated _ FALSE;
	  DO
	  sei _ root _ ctxb[ctx].seList;
	    DO
	    IF sei = ISENull THEN EXIT;
	    IF TypeForm[seb[sei].idType] = union THEN RETURN [sei];
	    IF (sei _ NextSe[sei]) = root THEN EXIT;
	    ENDLOOP;
	  IF repeated THEN EXIT;
	  Copier.CopyUnion[seb[rSei].fieldCtx];  repeated _ TRUE;
	  ENDLOOP;
	END;
    RETURN [com.seAnon]
    END;

  MapCtx: PUBLIC PROC [mdi: MDIndex, ctx: CTXIndex]
      RETURNS [ictx: IncludedCTXIndex] =
    BEGIN
    IF mdi = MDNull OR ctx = CTXNull THEN RETURN[IncludedCTXNull];
    Enter[];
    FOR ictx _ mdb[mdi].ctx, ctxb[ictx].chain UNTIL ictx = IncludedCTXNull DO
      IF ctxb[ictx].map = ctx THEN EXIT;
      REPEAT FINISHED => ictx _ Copier.FindExternalCtx[mdi,ctx];
      ENDLOOP;
    Exit[];
    END;

  SearchValContext: PROCEDURE [val: UNSPECIFIED, ctx: CTXIndex]
      RETURNS [ISEIndex] =
    BEGIN
    sei: ISEIndex;
    root: ISEIndex _ ctxb[ctx].seList;
    sei _ root;
    DO
      IF sei = SENull THEN EXIT;
      IF seb[sei].idValue = val THEN RETURN [sei];
      WITH id: seb[sei] SELECT FROM
        sequential =>  sei _ sei + SIZE[sequential id SERecord];
        linked =>  IF (sei _ id.link) = root THEN EXIT;
        ENDCASE => EXIT;
      ENDLOOP;
    RETURN [ISENull]
    END;

  SearchCtxForProc: PUBLIC PROC [val: UNSPECIFIED, ctx: CTXIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN RETURN[SearchCtxForVal[val,ctx,proc]] END;

  SearchCtxForSignal: PUBLIC PROC [val: UNSPECIFIED, ctx: CTXIndex]
      RETURNS [sei: ISEIndex] =
    BEGIN RETURN[SearchCtxForVal[val,ctx,signal]] END;

  SearchCtxForVal: PUBLIC PROC [
    val: UNSPECIFIED, ctx: CTXIndex, tm: TransferMode]
      RETURNS [sei: ISEIndex] =
    BEGIN
    IF ctx = CTXNull THEN RETURN [ISENull];
    IF (sei _ SearchValContext[val,ctx]) # ISENull
      AND CheckIsei[myBase,sei,tm] THEN RETURN;
    Enter[];
    WITH ctxb[ctx] SELECT FROM
      included => IF ~complete THEN 
	sei _ Copier.TokenSymbol[ctx, Generator[module,map,val,tm]];
      imported => sei _ SearchCtxForVal[val,includeLink,tm];
      simple => NULL;
      ENDCASE => sei _ ISENull;
    Exit[];
    RETURN;
    END;

  Generator: PROC [
    mdi: MDIndex, ctx: CTXIndex, val: UNSPECIFIED, tm: TransferMode]
      RETURNS [token: Copier.SEToken] =
    BEGIN
    Search: PROC [iBase: SymbolTable.Base] =
      BEGIN
      isei: ISEIndex;
      FOR isei _ iBase.FirstCtxSe[ctx], iBase.NextSe[isei] UNTIL
		isei = ISENull DO
	IF (iBase.seb[isei].idValue = val) AND CheckIsei[iBase,isei,tm] THEN
	  EXIT;
	ENDLOOP;
      token _ [isei];
      END;
    Copier.Outer[mdi,Search];
    END;

  CheckIsei: PROC [base: SymbolTable.Base, isei: ISEIndex, tm: TransferMode]
    RETURNS [BOOLEAN] =
    BEGIN
    SELECT base.XferMode[base.seb[isei].idType] FROM
      tm => RETURN[base.seb[isei].constant];
      signal => IF tm = error THEN RETURN[base.seb[isei].constant];
      error => IF tm = signal THEN RETURN[base.seb[isei].constant];
      ENDCASE;
    RETURN[FALSE];
    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;
    field.there _ f.there; field.xfer _ f.xfer; field.indent _ f.indent;
    END;

  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 < 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;

  ArraySei: PROC [sei: SEIndex] RETURNS [asei: ArraySEIndex, desc, long: BOOLEAN] =
    BEGIN
    csei: CSEIndex _ TypeForSe[sei];
    desc _ long _ FALSE;
    DO
      WITH seb[csei] SELECT FROM
	array => {asei _ LOOPHOLE[csei]; EXIT};
	arraydesc =>
	  BEGIN
	  asei _ LOOPHOLE[SymbolOps.UnderType[describedType]];
	  desc _ TRUE;
	  EXIT;
	  END;
	long => {long _ TRUE; csei _ TypeForSe[rangeType]};
	ENDCASE => NotAnArray;
      ENDLOOP;
    END;

  GetDesc: PUBLIC PROC [f: Foo] RETURNS [d: Desc, asei: ArraySEIndex] =
    BEGIN
    desc: BOOLEAN;
    long: BOOLEAN;
    lp: LONG POINTER TO Desc;
    Enter[];
    [asei:asei, desc:desc, long:long] _ ArraySei[f.tsei ! UNWIND => Exit[]];
    IF long THEN {Exit[]; ERROR SizeMismatch};
    IF ~desc THEN
      BEGIN
      IF ~f.there THEN ERROR NotHere;
      d.base _ InlineDefs.LowHalf[f.addr.base];
      d.length _ SymbolOps.Cardinality[seb[asei].indexType];
      END
    ELSE
      BEGIN
      GetValue[f];
      lp _ f.addr.base;
      d _ lp^;
      END;
    Exit[];
    END;

  GetLongDesc: PUBLIC PROC [f: Foo] RETURNS [ld: LongDesc, asei: ArraySEIndex] =
    BEGIN
    desc: BOOLEAN;
    long: BOOLEAN;
    lp: LONG POINTER TO LongDesc;
    Enter[];
    [asei:asei, desc:desc, long:long] _ ArraySei[f.tsei ! UNWIND => Exit[]];
    IF ~long THEN {Exit[]; ERROR SizeMismatch};
    IF ~desc THEN
      BEGIN
      IF ~f.there THEN ERROR NotHere;
      ld.base _ f.addr.base;
      ld.length _ SymbolOps.Cardinality[seb[asei].indexType];
      END
    ELSE
      BEGIN
      GetValue[f];
      lp _ f.addr.base;
      ld _ lp^;
      END;
    Exit[];
    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 _ Copier.TokenSymbol[ictx,Copier.CtxValue[ictx,val]];
    END;

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

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

  ReadField: PROCEDURE [f: Foo] =
    BEGIN OPEN f;
    fd: ControlDefs.FieldDescriptor _
      [offset: 0, posn: addr.offset, size: bits];
    p: POINTER _ InlineDefs.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 RETURN;
    there _ FALSE;
    p _ Storage.Node[cnt];
    DebugOps.LongCopyREAD[from: addr.base, to: p, nwords: cnt];
    addr.base _ p;
    IF bits # 0 THEN ReadField[f];
    END;

  WFS: PROC [UNSPECIFIED, POINTER, ControlDefs.FieldDescriptor] =
    MACHINE CODE BEGIN Mopcodes.zWFS END;

  PutValue: PUBLIC PROC [lhs: Foo, from: LONG POINTER] =
    BEGIN
    to: LONG POINTER = lhs.addr.base;
    IF ~lhs.there THEN ERROR CantAssignInDebuggerImage;
    IF lhs.addr.offset # 0 OR lhs.bits # 0 THEN
      BEGIN
      val: UNSPECIFIED _ DebugOps.LongREAD[to];
      fd: ControlDefs.FieldDescriptor _
	[offset: 0, posn: lhs.addr.offset, size: lhs.bits];
      WFS[from^,@val,fd];
      DebugOps.LongWRITE[to,val];
      END
    ELSE DebugOps.LongCopyWRITE[from: from, nwords: lhs.words, to: to];
    END;

  GetControlLink: PUBLIC PROC [f: Foo] RETURNS [PrincOps.ControlLink] =
    BEGIN
    IF f.there THEN {GetValue[f]; f.addr.base^ _ Gf.NewLink[f.addr.base^]};
    RETURN[f.addr.base^];
    END;

  DerefProcDesc: PUBLIC PROC [cl: PrincOps.ControlLink]
    RETURNS [PrincOps.ControlLink] =
    BEGIN
    DO
      IF cl.gfi = 0 THEN EXIT;
      SELECT TRUE FROM
  	cl.gfi = 0 => ERROR NotAProcedure[Gf.OldLink[cl]];
	cl.proc => EXIT;
	cl.indirect => cl _ Gf.NewLink[DebugOps.ShortREAD[LOOPHOLE[cl]]];
	ENDCASE => ERROR NotAProcedure[Gf.OldLink[cl]];
      ENDLOOP;
    RETURN[cl]
    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 _ [card[]];
	  codeINT => BEGIN intSub _ inSubrange; vf _ [int[]] END;
	  codeCHAR => vf _ [char[]];
	  ENDCASE;
	GOTO exit;
	END;
      subrange =>
	BEGIN
	IF csei = com.typeCARDINAL THEN { vf _ [card[]]; 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.