-- DIHot.mesa  last edit:
  -- Bruce   October 28, 1980  12:14 PM
  -- Sandman  July 18, 1980  8:05 AM
  
DIRECTORY
  BP USING [Condition],
  ComData USING [typeCARDINAL, typeCHAR, typeINT, typeSTRING],
  CompilerUtil USING [PrintTree],
  DebugFormat USING [Foo, Fob, NullFob],
  DebugOps USING [
    DisplayFoo, Foo, FooProc, Lengthen, SyntaxError],
  DebugUsefulDefs USING [],
  DI USING [
    AbortWithError, CSEIndex, CTXIndex, DerefProcDesc, Err, Error, FindField, Foo,
    GetControlLink, GetValue, HTIndex, ISEIndex, MakeLongType, NotAProcedure, Number,
    NumberType, Pad, PutValue, RecordSEIndex, SearchCtxList, SEIndex,
    TagIsei, TypeForSe, UnionSEIndex, VariantType, Words],
  DIActions USING [
    Abs, Assignable, Base, DoApply, DumpArray, DumpMemory,
    FoldExpr, GetSize, Interval, Length, LengthenFob, Long,
    MakePointerType, MakeXferType, Max, Memory, Min, nullError, nullProc, nullSig,
    PushNil, PutLongReps, PutReps, SelectVariantType, Size, TotalWords, TreeType,
    VariantUnionType,
    exp, memoryInt, arrayInt, conditionalBreak, eol, frameDollar, fileDollar, typeDollar,
    card, lcard, int, lint, bang, memory, reps],
  DOutput USING [EOL, NewLine],
  DSyms USING [GFHandle, GFrameHti, Shared],
  Frames USING [Type],
  Gf USING [FrameGfi, Handle, NewLink, Validate],
  DHeap USING [AllocFob, FreeLong],
  Inline USING [HighHalf, LowHalf],
  Lf USING [GF],
  Literals USING [LitRecord],
  Lookup USING [
    Complete, CopyLiteral, HTIndex, InCtx, InLF, InMod, Mode, OnStack, Proc, Signal],
  MachineDefs USING [GFHandle],
  P1 USING [DParse, PrintNodeName],
  PrincOps USING [SignalDesc],
  State USING [Get, GetGS, GSHandle, Handle, Stack, top],
  Storage USING [Free, FreeString, Node, String],
  String USING [AppendChar, AppendString],
  SymbolOps USING [FirstCtxSe, NextSe, TypeRoot, UnderType, WordsForType],
  Symbols USING [
    ArraySEIndex, CSEIndex, CTXIndex, HTIndex, HTNull, ISEIndex, ISENull,
    SEIndex, seType, typeANY],
  SymbolTable USING [Missing],
  Table USING [AddNotify, Base, DropNotify, Notifier],
  Tree USING [Index, Link, NodeName, Null, Scan, treeType],
  TreeOps USING [FreeTree, OpName, PopTree, ScanList];
  
DIHot: PROGRAM
  IMPORTS BP, com: ComData, CompilerUtil, DebugOps, DI, DIActions,
    DOutput, DSyms, Frames, Gf, DHeap, Inline, Lf, Lookup, P1, State, Storage, 
    String, SymbolOps, SymbolTable, Table, TreeOps
  EXPORTS DebugOps, DebugUsefulDefs, DI, DIActions =
  BEGIN OPEN DI, DIActions;
  
  Underflow: PUBLIC ERROR = CODE;
  StackNotEmptyAtStatement: PUBLIC ERROR = CODE;
  NotImplemented: PUBLIC SIGNAL [msg: STRING] = CODE;
  DIAbort: PUBLIC ERROR = CODE;
  
  BadTree: ERROR = CODE;
  WhosBeenScanningMyTree: ERROR = CODE;
  CantAssignInDebuggerImage: ERROR = CODE;
  
  data: State.GSHandle _ State.GetGS[];
  dereferenced: PUBLIC BOOLEAN;
  target: Symbols.CSEIndex;
  
  Interpreter: PUBLIC PROC [exp: STRING] = {Interpret[exp,NIL]};
  
  Interpret: PUBLIC PROC [
    exp: STRING, results: DebugOps.FooProc _ DebugOps.DisplayFoo,
    targetType: Symbols.CSEIndex _ Symbols.typeANY] =
    BEGIN
    t: Tree.Link;
    copy: BOOLEAN = exp.length = exp.maxlength;
    temp: STRING _ IF copy THEN Storage.String[exp.length+1] ELSE NIL;
    CleanupString: PROC = 
      BEGIN
      IF copy THEN Storage.FreeString[temp] 
      ELSE exp.length _ exp.length - 1;
      END;
    Cleanup: PROC =
      BEGIN
      Drop[];
      [] _ TreeOps.FreeTree[t];
      ResetStack[];
      CleanupString[];
      END;
    IF copy THEN {String.AppendString[temp,exp]; exp _ temp};
    String.AppendChar[exp,'\];
    IF ~P1.DParse[exp !UNWIND => CleanupString[]] THEN
      BEGIN CleanupString[]; SIGNAL DebugOps.SyntaxError[0] END;
    t _ TreeOps.PopTree[];
    IF data.tree THEN CompilerUtil.PrintTree[t];
    Add[];
    State.Get[].h.proc _ results;
    target _ targetType;
    ProcessTree[t ! UNWIND => Cleanup[]];
    Cleanup[];
    END;
    
  ProcessTree: Tree.Scan =
    BEGIN OPEN TreeOps;
    IF t = Tree.Null THEN RETURN;
    t _ CheckNode[t,eol];
    t _ CheckNode[t,block];
    ScanList[t,Exp];
    CheckForStackEmpty[];
    END;
    
  CheckNode: PUBLIC PROCEDURE [t: Tree.Link, name: Tree.NodeName]
    RETURNS [son1: Tree.Link] =
    BEGIN
    IF TreeOps.OpName[t] # name THEN ERROR BadTree;
    Add[];
    WITH t SELECT FROM
      subtree => son1 _ tb[index].son[1];
      ENDCASE => {Drop[]; ERROR BadTree};
    Drop[];
    END;
    
  CheckLink: PUBLIC PROC [t: Tree.Link, type: TreeType] RETURNS [UNSPECIFIED] =
    BEGIN
    WITH t SELECT FROM
      subtree => IF type = subtree THEN RETURN[index];
      hash => IF type = hash THEN RETURN[index];
      symbol => IF type = symbol THEN RETURN[index];
      literal => IF type = literal THEN RETURN[info];
      ENDCASE => ERROR BadTree;
    ERROR WhosBeenScanningMyTree;
    END;
    
  seb: Table.Base;
  tb: Table.Base;
  hot: PUBLIC CARDINAL _ 0;
  
  Notify: Table.Notifier =
    BEGIN
    tb _ base[Tree.treeType];
    seb _ base[Symbols.seType];
    END;
    
  Add: PROCEDURE =
    BEGIN
    IF hot = 0 THEN Table.AddNotify[Notify];
    hot _ hot + 1;
    END;
    
  Drop: PROCEDURE =
    BEGIN
    IF (hot _ hot-1) = 0 THEN Table.DropNotify[Notify];
    END;
    
  Exp: Tree.Scan =
    BEGIN ENABLE {DIAbort => GOTO cleanExit; UNWIND => Drop[]};
    son1: Foo;
    IF t = Tree.Null THEN RETURN;
    Add[];
    WITH t SELECT FROM
      subtree =>
	BEGIN OPEN TreeOps;
	SELECT tb[index].name FROM
	  exp =>
	    BEGIN
	    son1 _ FirstSon[index, target];
	    IF son1^ # DebugFormat.NullFob THEN State.Get[].h.proc[son1];
	    END;
	  memoryInt =>
	    BEGIN
	    son1 _ FirstSon[index, MakeLongType[com.typeCARDINAL]];
	    DumpMemory[son1];
	    END;
	  arrayInt =>
	    BEGIN
	    son1 _ FirstSon[index, target];
	    Work[tb[index].son[2], seb[ArraySei[son1]].indexType];
	    DumpArray[son1];
	    END;
	  reps =>
	    BEGIN
	    n: Number;
	    son1 _ FirstSon[index, target];
	    n _ GetNumber[son1];
	    SELECT n.type FROM
	      one => PutReps[n.u];
	      two => PutLongReps[n.lu];
	      ENDCASE;
	    END;
	  assign =>
	    BEGIN
	    rhs: Foo;
	    son1 _ FirstSon[index, target];
	    TargetTypeWork[tb[index].son[2], son1.tsei];
	    rhs _ Pop[];
	    PutValue[son1,rhs.addr.base]
	    END;
	  eol => {
	    IF ~DOutput.NewLine[] THEN DOutput.EOL[];
	    Exp[tb[index].son[1]];
	    DOutput.EOL[]; CheckForStackEmpty[]};
	  conditionalBreak => {
	    IF State.Get[].h.howSet # break THEN AbortWithError[relation];
	    dereferenced _ FALSE;
	    Work[tb[index].son[1]]};
	  ENDCASE => ERROR WhosBeenScanningMyTree;
	END;
      ENDCASE => ERROR BadTree;
    Drop[];
    EXITS
      cleanExit => {ResetStack[]; RETURN};
    END;
    
  ArraySei: PROC [f: Foo] RETURNS [asei: Symbols.ArraySEIndex] =
    BEGIN
    csei: CSEIndex _ TypeForSe[f.tsei];
    DO
      WITH seb[csei] SELECT FROM
	array => {asei _ LOOPHOLE[csei]; EXIT};
	arraydesc => {asei _ LOOPHOLE[SymbolOps.UnderType[describedType]]; EXIT};
	ref => csei _ TypeForSe[refType];
	long => csei _ TypeForSe[rangeType];
	ENDCASE => AbortWithError[notArray,f.hti];
      ENDLOOP;
    END;
    
  FirstSon: PUBLIC PROC [index: Tree.Index, type: SEIndex _ Symbols.typeANY]
      RETURNS [f: Foo] =
    BEGIN
    son: Tree.Link;
    Add[];
    son _ tb[index].son[1];
    Work[son, type ! UNWIND => Drop[]];
    Drop[];
    f _ IF son # Tree.Null THEN Pop[] ELSE NIL;
    END;
    
  Son: PUBLIC PROC [t: Tree.Link, target: Symbols.SEIndex] RETURNS [Foo] =
    BEGIN
    IF t = Tree.Null THEN ERROR WhosBeenScanningMyTree;
    Work[t, target];
    RETURN[Tos[]];
    END;
    
  NumberWork: PUBLIC PROC [t: Tree.Link, number, target: Symbols.SEIndex] =
    BEGIN
    csei: Symbols.SEIndex;
    target _ TypeForSe[target];
    csei _ SELECT TRUE FROM 
	target = Symbols.typeANY => number,
	SymbolOps.WordsForType[target] # 1 => number,
	ENDCASE => target;
    TargetTypeWork[t, csei];
    END;
    
  Work: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex _ Symbols.typeANY] =
    BEGIN
    IF t = Tree.Null THEN RETURN;
    WITH t SELECT FROM
      subtree => SubtreeWork[index,type];
      hash => Push[HashWork[index,type]];
      symbol => Push[SymbolWork[index]];
      literal => Push[FindLiteral[info]];
      ENDCASE => ERROR BadTree;
    END;
    
  LoopHoleWork: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex] =
    BEGIN
    f: Foo _ NIL;
    literal: BOOLEAN _ FALSE;
    IF t = Tree.Null THEN RETURN;
    WITH t SELECT FROM
      subtree => {
	SubtreeWork[index,type];
	f _ Pop[];
	SELECT tb[index].name FROM
	  int, card => literal _ TRUE;
	  ENDCASE};
      hash => f _ HashWork[index,type];
      literal => {literal _ TRUE; f _ FindLiteral[info]};
      ENDCASE => ERROR BadTree;
    IF literal AND
      (SELECT type FROM nullProc, nullSig, nullError => TRUE, ENDCASE => FALSE)
      THEN f.addr.base^ _ Gf.NewLink[f.addr.base^];
    LoopHole[f,type,TRUE];
    Push[f];
    END;
    
  TargetTypeWork: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex] =
    BEGIN
    f: Foo _ NIL;
    IF t = Tree.Null THEN RETURN;
    WITH t SELECT FROM
      subtree => {SubtreeWork[index,type]; f _ Pop[]};
      hash => f _ HashWork[index,type];
      literal => {f _ FindLiteral[info]; FixupLiteral[f,type]};
      ENDCASE => ERROR BadTree;
    Assignable[f,TypeForSe[type]];
    Push[f];
    END;
    
  FixupLiteral: PROC [f: Foo, type: Symbols.SEIndex] = {
    csei: Symbols.CSEIndex _ TypeForSe[type];
    f.tsei _ csei;
    SELECT csei FROM
      com.typeCARDINAL, Symbols.typeANY, com.typeINT => NULL;
      ENDCASE => {
	WITH seb[csei] SELECT FROM
	  long => IF NumberLength[f] = one THEN Long[f, rangeType = com.typeINT];
	  ENDCASE } };
	  
  SymbolWork: PROC [index: Symbols.SEIndex] RETURNS [f: Foo] = INLINE
    BEGIN
    f _ DHeap.AllocFob[];
    f.tsei _ index;
    f.typeOnly _ TRUE;
    END;
    
  HashWork: PROC [index: Symbols.HTIndex, hint: Symbols.SEIndex] 
      RETURNS [f: Foo] =
    BEGIN
    f _ NIL;
    IF hint # Symbols.typeANY THEN {
      csei: Symbols.CSEIndex _ TypeForSe[hint];
      DO
	WITH seb[csei] SELECT FROM
	  enumerated => f _ Lookup.InCtx[index, valueCtx];
	  subrange => {csei _ TypeForSe[rangeType]; LOOP};
	  ENDCASE;
	IF f # NIL THEN RETURN ELSE EXIT;
	ENDLOOP};
    f _ Lookup.OnStack[index];
    IF f = NIL THEN AbortWithError[notFound, index];
    END;
    
  SubtreeWork: PROC [index: Tree.Index, type: Symbols.SEIndex] =
    BEGIN OPEN TreeOps;
    SELECT tb[index].name FROM
      plus, minus, times, div, mod =>
	BEGIN
	f: Foo _ FirstSon[index, type];
	LoopHoleWork[tb[index].son[2], type];
	Push[f];
	FoldExpr[tb[index].name];
	END;
      relE, relN, relL, relLE, relG, relGE =>
	BEGIN
	f: Foo _ FirstSon[index];
	TargetTypeWork[tb[index].son[2],TypeForSe[f.tsei]];
	BP.Condition[left: f, rel: tb[index].name, right: Pop[]];
	END;
      uminus =>
	BEGIN
	Work[tb[index].son[1]];
	FoldExpr[uminus];
	END;
      base => Base[FirstSon[index],type];
      length => Length[FirstSon[index], type];
      size => Size[FirstSon[index]];
      clit =>
	BEGIN
	f: Foo _ FindLiteral[CheckLink[tb[index].son[1], literal]];
	f.tsei _ com.typeCHAR;
	f.addr.offset _ 8;
	Push[f];
	END;
      mwconst =>
	BEGIN
	f: Foo _ FindLiteral[CheckLink[tb[index].son[1], literal]];
	f.tsei _ type;
	Push[f];
	END;
      lint => Work[tb[index].son[1], MakeLongType[com.typeINT]];
      lcard => Work[tb[index].son[1], MakeLongType[com.typeCARDINAL]];
      int => NumberWork[tb[index].son[1], com.typeINT, type];
      card => NumberWork[tb[index].son[1], com.typeCARDINAL, type];
      typeDollar =>
	BEGIN
	id: Symbols.HTIndex _ CheckLink[tb[index].son[2], hash];
	mod: Symbols.HTIndex _ CheckLink[tb[index].son[1], hash];
	f: Foo _ Lookup.InMod[id,mod ! DSyms.Shared => AbortWithError[wrongDollar,mod]];
	IF f = NIL THEN AbortWithError[notFound,id];
	IF ~f.typeOnly THEN Error[notType, id];
	Push[f];
	END;
      addr => TakeAddress[FirstSon[index,type]];
      uparrow =>
	BEGIN
	f: Foo _ Son[tb[index].son[1],type];
	IF ~Deref[f] THEN AbortWithError[invalidPointer, f.hti];
	END;
      dot => Qualify[FirstSon[index],CheckLink[tb[index].son[2], hash]];
      apply => DoApply[tb[index].son[2], FirstSon[index]];
      loophole => {
	f: Foo;
	IF tb[index].son[2] = Tree.Null THEN {
	  Work[tb[index].son[1], type];
	  f _ Tos[];
	  LoopHole[f, type]}
	ELSE
	  BEGIN
	  Work[tb[index].son[2],type];
	  f _ Pop[];
	  IF ~f.typeOnly THEN Error[notType, f.hti];
	  LoopHoleWork[tb[index].son[1],f.tsei];
	  END  };
      fileDollar =>
	BEGIN
	id: Symbols.HTIndex _ CheckLink[tb[index].son[2], hash];
	mod: Symbols.HTIndex _ CheckLink[tb[index].son[1], hash];
	f: Foo _ Lookup.InMod[id,mod ! DSyms.Shared => AbortWithError[wrongDollar,mod]];
	IF f = NIL THEN AbortWithError[notFound,id];
	Push[f];
	END;
      frameDollar =>
	BEGIN
	id: Symbols.HTIndex _ CheckLink[tb[index].son[2], hash];
	f: Foo _ FindLiteral[CheckLink[tb[index].son[1], literal]];
	f _ Lookup.InLF[id,f.addr.base^];
	IF f = NIL THEN AbortWithError[notFound,id];
	Push[f];
	END;
      memory => Memory[tb[index].son[1],type];
      nil => PushNil[FirstSon[index,type]];
      procTC => 
	BEGIN
	f: Foo _ DHeap.AllocFob[];
	f.tsei _ MakeXferType[proc];
	f.typeOnly _ TRUE;
	Push[f];
	END;
      errorTC => 
	BEGIN
	f: Foo _ DHeap.AllocFob[];
	f.tsei _ MakeXferType[error];
	f.typeOnly _ TRUE;
	Push[f];
	END;
      signalTC => 
	BEGIN
	f: Foo _ DHeap.AllocFob[];
	f.tsei _ MakeXferType[signal];
	f.typeOnly _ TRUE;
	Push[f];
	END;
      longTC =>
	BEGIN
	f: Foo _ Son[tb[index].son[1],type];
	f.tsei _ MakeLongType[f.tsei];
	END;
      pointerTC =>
	BEGIN
	f: Foo _ Son[tb[index].son[1],type];
	f.tsei _ MakePointerType[f.tsei];
	END;
      discrimTC =>
	BEGIN
	f: Foo _ Son[tb[index].son[1],type];
	f.tsei _ SelectVariantType[f.tsei, CheckLink[tb[index].son[2],hash]];
	END;
      lengthen =>
	BEGIN
	f: Foo _ Son[tb[index].son[1],type];
	LengthenFob[f];
	END;
      abs => Abs[tb[index].son[1],type];
      min =>
	BEGIN
	size: NumberType;
	cnt: CARDINAL;
	signed: BOOLEAN;
	[size,cnt,signed] _ GetSize[index,type];
	Min[size,cnt,signed];
	END;
      max =>
	BEGIN
	size: NumberType;
	cnt: CARDINAL;
	signed: BOOLEAN;
	[size,cnt,signed] _ GetSize[index,type];
	Max[size,cnt,signed];
	END;
      intOO => Interval[
	t: tb[index].son[1], type: type, openLow: TRUE, openHigh: TRUE];
      intOC => Interval[t: tb[index].son[1], type: type, openLow: TRUE];
      intCO => Interval[t: tb[index].son[1], type: type, openHigh: TRUE];
      intCC => Interval[t: tb[index].son[1], type: type];
      bang => Interval[t: tb[index].son[1], type: type, cntOnly: TRUE];
      ENDCASE => NotImpl[tb[index].name];
    END;
    
  NotImpl: PROC [name: Tree.NodeName] = {
    P1.PrintNodeName[name]; SIGNAL NotImplemented[NIL]};
    
  Deref: PUBLIC PROC [f: Foo] RETURNS [success: BOOLEAN] =
    BEGIN
    tsei: Symbols.CSEIndex _ TypeForSe[f.tsei];
    ref: SEIndex;
    n: Number;
    Add[];
    DO
      WITH seb[tsei] SELECT FROM
	ref => {
	  dereferenced _ TRUE;
	  IF ~f.typeOnly THEN {ref _ TypeForSe[refType]; EXIT}
	  ELSE {
	    f^ _ DebugFormat.NullFob; f.tsei _ refType; f.typeOnly _ TRUE;
	    WITH seb[refType] SELECT FROM
	      id => f.hti _ hash;
	      ENDCASE;
	    Drop[]; RETURN[TRUE]}};
	long => tsei _ TypeForSe[rangeType];
	subrange => tsei _ TypeForSe[rangeType];
      ENDCASE => GOTO cant;
      ENDLOOP;
    Drop[];
    n _ GetNumber[f, invalidPointer];
    DHeap.FreeLong[f.addr.base];
    SELECT n.type FROM
      one => f.addr.base _ DebugOps.Lengthen[n.p];
      two => f.addr.base _ n.lp;
      ENDCASE;
    IF f.addr.base = NIL THEN AbortWithError[nilChk,f.hti];
    f.tsei _ ref; f.words _ SymbolOps.WordsForType[ref];
    f.hti _ Symbols.HTNull;
    f.typeOnly _ FALSE;
    f.addr.offset _ 0;
    f.addr.useStack _ FALSE;
    f.bits _ 0;
    f.there _ TRUE;
    RETURN[TRUE];
    EXITS cant => {Drop[]; RETURN[FALSE]};
    END;
    
  Qualify: PUBLIC PROC [f: Foo, hti: Symbols.HTIndex] =
    BEGIN OPEN Symbols;
    original, root: CSEIndex;
    Add[];
    WHILE Deref[f] DO NULL ENDLOOP;
    original _ TypeForSe[f.tsei];
    root _ SymbolOps.TypeRoot[original];
    SELECT TRUE FROM
      QualifyCsei[f,hti,original] => {Drop[]; RETURN};
      root # original => IF QualifyCsei[f,hti,root] THEN {Drop[]; RETURN};
      ENDCASE;
    Drop[];
    AbortWithError[notValidField,hti];
    END;
    
  QualifyCsei: PUBLIC PROC [f: Foo, hti: Symbols.HTIndex, csei: Symbols.CSEIndex] 
    RETURNS [found: BOOLEAN] =
    BEGIN OPEN Symbols;
    pad: CARDINAL;
    WITH seb[csei] SELECT FROM
      record =>
	BEGIN
	pad _ DI.Pad[f,LOOPHOLE[csei]];
	IF SearchCtx[f, fieldCtx, hti, pad] THEN RETURN[TRUE];
	IF hints.variant THEN RETURN[SearchVariants[
	  f,hti,pad,LOOPHOLE[VariantUnionType[LOOPHOLE[csei]]]]];
	END;
      definition => {
	temp: DebugFormat.Fob _ DebugFormat.NullFob;
	p: POINTER _ State.Get[].h.interpretContext;
	isei: ISEIndex = SearchCtxList[hti,defCtx];
	reallyThere: BOOLEAN;
	IF isei = ISENull THEN RETURN [FALSE];
	temp.addr.base _ DebugOps.Lengthen[IF Frames.Type[p] = local THEN Lf.GF[p] ELSE p];
	temp.tsei _ f.tsei; temp.there _ TRUE; temp.indent _ f.indent;
	reallyThere _ SELECT Lookup.Mode[isei] FROM
	  refVal => TRUE,
	  refProc => FALSE,
	  ENDCASE => FALSE;
	found _ SearchCtx[@temp,defCtx,hti,0];
 	IF found THEN Tos[].f.there _ reallyThere;
	RETURN};
      ENDCASE => {Drop[]; AbortWithError[typeMismatch,f.hti]};
    RETURN[FALSE];
    END;
    
  SearchCtx: PROC [f: Foo, ctx: CTXIndex, hti: HTIndex, pad: CARDINAL]
      RETURNS [BOOLEAN] =
    BEGIN OPEN Symbols;
    isei: ISEIndex _ SearchCtxList[hti,ctx];
    field: Foo;
    IF isei = ISENull THEN RETURN [FALSE];
    IF f.typeOnly THEN {
      field _ DHeap.AllocFob[]; field^ _ f^;
      field.hti _ seb[isei].hash; field.tsei _ isei}
    ELSE field _ FindField[f, pad, isei];
    IF field = NIL THEN RETURN [FALSE];
    Push[field];
    RETURN[TRUE];    
    END;
    
  SearchRecord: PROC [
      f: Foo, rsei: RecordSEIndex, hti: HTIndex, pad: CARDINAL]
    RETURNS [BOOLEAN] = INLINE
    BEGIN RETURN[SearchCtx[f,seb[rsei].fieldCtx,hti,pad]] END;
    
  SearchVariants: PROC [
    f: Foo, hti: HTIndex, pad: CARDINAL, usei: UnionSEIndex]
      RETURNS [BOOLEAN] =
    BEGIN OPEN Symbols;
    isei: ISEIndex;
    IF usei = typeANY THEN RETURN [FALSE];
    SELECT VariantType[usei] FROM
      controlled =>
	BEGIN
	isei _ seb[usei].tagSei;
	IF seb[isei].hash = hti THEN {
	  field: Foo _ FindField[f, pad, isei];
	  IF field = NIL THEN RETURN [FALSE];
	  Push[field]; RETURN[TRUE]};
	isei _ TagIsei[f,pad,usei];
	IF isei = ISENull THEN RETURN [FALSE];
	RETURN[SearchRecord[f,seb[isei].idInfo,hti,pad]];
	END;
      overlaid =>
	BEGIN OPEN SymbolOps, seb[usei];
	Lookup.Complete[caseCtx];
	FOR isei _ FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei = ISENull DO
	  IF SearchRecord[f,seb[isei].idInfo,hti,pad] THEN RETURN[TRUE];
	  ENDLOOP;
	RETURN[FALSE];
	END;
      computed =>
	BEGIN OPEN SymbolOps, seb[usei];
	cnt: CARDINAL _ 0;
	Lookup.Complete[caseCtx];
	FOR isei _ FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei = ISENull DO
	  IF SearchRecord[f,seb[isei].idInfo,hti,pad] THEN cnt _ cnt + 1;
	  IF cnt > 1 THEN AbortWithError[notUniqueField,hti];
	  ENDLOOP;
	RETURN[cnt = 1];
	END;
      ENDCASE => ERROR;
    END;
    
  TakeAddress: PROC [f: Foo] =
    BEGIN
    addr: LONG POINTER = f.addr.base;
    tsei: Symbols.SEIndex = MakePointerType[f.tsei];
    IF f.addr.offset # 0 OR ~f.there THEN AbortWithError[invalidAddress,f.hti];
    IF Inline.HighHalf[addr] = data.mds THEN PushVal[Inline.LowHalf[addr], tsei]
    ELSE PushLongVal[addr,tsei];
    END;
    
  LoopHole: PUBLIC PROC [
      f: Foo, type: Symbols.SEIndex, lengthen: BOOLEAN _ FALSE] =
    BEGIN
    tSize: CARDINAL;
    checkSize: BOOLEAN _ TRUE;
    csei: Symbols.CSEIndex = TypeForSe[type];
    Add[];
    WITH seb[csei] SELECT FROM
      subrange => checkSize _ range # 0;
      ENDCASE;
    Drop[];
    SELECT TRUE FROM
      f = NIL => RETURN;
      f.tsei = type => RETURN;
      type = nullProc =>
	type _ LoopHoleControlLink[f,Lookup.Proc ! NotAProcedure => GO TO notProc];
      type = nullSig OR type = nullError =>
	type _ LoopHoleControlLink[f,Lookup.Signal ! NotAProcedure => GO TO notProc];
      ~checkSize => NULL;
      TotalWords[f] = (tSize _ SymbolOps.WordsForType[csei]) => NULL;
      ~lengthen => AbortWithError[sizeMismatch];
      tSize # 2 => AbortWithError[sizeMismatch];
      ~CheckLength[f,1] => AbortWithError[sizeMismatch];
      ENDCASE => LengthenFob[f];
    f.tsei _ type;
    EXITS notProc => AbortWithError[notProcDesc];
    END;
    
  LoopHoleControlLink: PROC [
      f: Foo, proc: PROC [PrincOps.SignalDesc] RETURNS [Symbols.ISEIndex]]
    RETURNS [Symbols.SEIndex] =
    BEGIN
    desc: PrincOps.SignalDesc = LOOPHOLE[DerefProcDesc[GetControlLink[f]]];
    gf: MachineDefs.GFHandle = Gf.FrameGfi[desc.gfi];
    isei: Symbols.ISEIndex _ Symbols.ISENull;
    IF ~Gf.Validate[gf] THEN AbortWithError[notProcDesc];
    isei _ proc[desc ! SymbolTable.Missing => CONTINUE];
    IF isei # Symbols.ISENull THEN RETURN[TypeForSe[isei]];
    AbortWithError[notFound, DSyms.GFrameHti[gf]];
    ERROR;
    END;
    
  FindLiteral: PROCEDURE [info: Literals.LitRecord] RETURNS [f: Foo] =
    BEGIN
    f _ DHeap.AllocFob[];
    [f.addr.base, f.words] _ Lookup.CopyLiteral[info];
    WITH info SELECT FROM
      string => f.tsei _ com.typeSTRING;
      ENDCASE => f.tsei _ Symbols.typeANY;
    END;
    
  CheckLength: PUBLIC PROC [f: Foo, size: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN
    IF f.words # size OR f.bits # 0 OR f.addr.offset # 0 THEN 
      RETURN[FALSE]
    ELSE RETURN[TRUE];
    END;
    
  NumberLength: PUBLIC PROC [f: Foo] RETURNS [nt: NumberType] =
    BEGIN
    IF CheckLength[f,1] THEN RETURN[one];
    IF CheckLength[f,2] THEN RETURN[two]; 
    RETURN[nogood]
    END;
    
  GetNumber: PUBLIC PROC [f: Foo, code: Err _ invalidNumber] RETURNS [n: Number] =
    BEGIN
    p: LONG POINTER TO Words;
    size: CARDINAL = TotalWords[f];
    csei: Symbols.CSEIndex;
    IF size ~IN[1..2] THEN AbortWithError[code] ELSE n.type _ LOOPHOLE[size];
    GetValue[f];
    p _ f.addr.base;
    FOR i: NumberType IN [nogood..n.type) DO
      n.w[i] _ p[i];
      ENDLOOP;
    IF (csei _ TypeForSe[f.tsei]) = com.typeCARDINAL THEN RETURN;
    Add[];
    WITH seb[csei] SELECT FROM
      subrange =>
	IF n.type = one THEN n.i _ n.i + origin ELSE AbortWithError[invalidSubrange];
      ENDCASE;
    Drop[];
    END;
    
  Stack: TYPE = State.Stack;
  
  PushVal: PUBLIC PROC [u: UNSPECIFIED, tsei: Symbols.SEIndex] =
    BEGIN
    f: Foo _ DHeap.AllocFob[];
    p: POINTER TO UNSPECIFIED;
    f.addr.base _ p _ Storage.Node[SIZE[UNSPECIFIED]];
    p^ _ u; f.words _ 1;
    f.tsei _ tsei;
    Push[f];
    END;
    
  PushLongVal: PUBLIC PROC [lu: LONG UNSPECIFIED, tsei: Symbols.SEIndex] =
    BEGIN
    f: Foo _ DHeap.AllocFob[];
    p: POINTER TO LONG UNSPECIFIED;
    f.addr.base _ p _ Storage.Node[SIZE[LONG UNSPECIFIED]];
    p^ _ lu; f.words _ 2;
    f.tsei _ MakeLongType[tsei];
    Push[f];
    END;
    
  Push: PUBLIC PROCEDURE [f: Foo] =
    BEGIN
    h: State.Handle _ State.Get[];
    new: POINTER TO Stack _ Storage.Node[SIZE[Stack]];
    new^ _ [h.fooStack,f];
    h.fooStack _ new;
    END;
    
  Pop: PUBLIC PROCEDURE RETURNS [f: Foo] =
    BEGIN
    h: State.Handle _ State.Get[];
    old: POINTER TO Stack _ h.fooStack;
    IF old = NIL THEN ERROR Underflow;
    f _ old.foo;
    h.fooStack _ old.link;
    Storage.Free[old];
    END;
    
  ResetStack: PROCEDURE =
    BEGIN
    h: State.Handle _ State.Get[];
    top, next: POINTER TO Stack;
    FOR top _ h.fooStack, next UNTIL top = NIL DO
      next _ top.link;
      Storage.Free[top];
      ENDLOOP;
    h.fooStack _ NIL;
    END;
    
  Tos: PUBLIC PROCEDURE RETURNS [f: Foo] =
    BEGIN
    h: State.Handle _ State.Get[];
    old: POINTER TO Stack _ h.fooStack;
    IF old = NIL THEN ERROR Underflow;
    RETURN[old.foo];
    END;
    
  CheckForStackEmpty: PUBLIC PROCEDURE = 
    BEGIN
    IF State.Get[].h.fooStack # NIL THEN ERROR StackNotEmptyAtStatement;
    END;
    
  END.