-- DIMed.mesa  last edit:
  -- Bruce  October 25, 1980  9:59 PM
  -- Sandman  July 18, 1980  8:11 AM
  
DIRECTORY
  Actions USING [DoRead, ReadUser],
  ComData USING [typeCARDINAL, typeINT, typeStringBody],
  DebugFormat USING [BitAddress, Foo],
  DebugOps USING [Foo, InvalidNumber, Lengthen, ShortCopyWRITE, ShortREAD],
  DI USING [
    CSEIndex, dereferenced, DerefProcDesc, Err, FindField, Foo, Format,
    GetControlLink, GetDesc, GetLongDesc, GetNumber, GetValue, ISEIndex,
    LongDesc, Normalize, NotAnArray, NotAProcedure, Number, NumberType,
    Pad, SEIndex, SequenceSEIndex, TypeForSe],
  DIActions USING [
    CheckLength, CheckLink, Dec, Deref, DIAbort, Inc,
    LengthenFob, LoopHoleWork, MakeCnt, Pop, Push, PushLongVal, PushVal, Qualify, Son,
    TargetTypeWork, Tos, Work],
  DOutput USING [Blanks, Char, EOL, Line, Text],
  Dump USING [ArrayHandle, ArrayInfo, CalculateAddr, Elements, ModeName],
  Gf USING [OldLink],
  DHeap USING [AllocFob, FreeLong],
  Init USING [CoreSwap],
  Inline USING [LongNumber],
  Lookup USING [HTIndex, HtiToString, StringToHti, XferCtx],
  MachineDefs USING [CallDP, WordLength],
  Pc USING [LinkToCbti],
  PrincOps USING [ControlLink, MaxParamsInStack, StateVector, SVPointer],
  State USING [GetGS, GSHandle],
  Storage USING [Node],
  SymbolOps USING [
    BitsPerElement, FirstCtxSe, MakeNonCtxSe, NextSe, TransferTypes, TypeRoot,
    UnderType, VariantField, WordsForType, XferMode],
  SymbolPack,
  Symbols USING [
    ArraySEIndex, bodyType, CBTIndex, CBTNull, CSEIndex, CSENull, HTIndex, HTNull,
    ISEIndex, ISENull, RecordSEIndex, RecordSENull, SEIndex, SENull, SERecord, seType,
    TransferMode, typeANY],
  SymbolTable USING [Base],
  Table USING [AddNotify, Base, DropNotify, Notifier],
  Tree USING [Index, Link, Null, Scan, treeType],
  TreeOps USING [OpName, ScanList],
  Types USING [Assignable, Equivalent, Handle];
  
DIMed: PROGRAM
  IMPORTS Actions, com: ComData, DebugOps, DI, DIActions,
    DOutput, Dump, Gf, DHeap, Init, Lookup, Pc, State, Storage, 
    MyBase: SymbolPack, SymbolOps, Table, TreeOps, Types
  EXPORTS DI, DIActions =
  BEGIN OPEN DI, DIActions;
  
  BadTree: ERROR = CODE;
  BadTag: ERROR = CODE;
  DerefError: ERROR = CODE;
  
  data: State.GSHandle _ State.GetGS[];
  
  seb: Table.Base;
  tb: Table.Base;
  bb: Table.Base;
  med: PUBLIC CARDINAL _ 0;
  
  Notify: Table.Notifier =
    BEGIN
    tb _ base[Tree.treeType];
    bb _ base[Symbols.bodyType];
    seb _ base[Symbols.seType];
    END;
    
  Add: PROCEDURE =
    BEGIN
    IF med = 0 THEN Table.AddNotify[Notify];
    med _ med + 1;
    END;
    
  Drop: PROCEDURE =
    BEGIN
    IF (med _ med-1) = 0 THEN Table.DropNotify[Notify];
    END;
    
  Interval: PUBLIC PROC [
      t: Tree.Link, type: Symbols.SEIndex,
      openLow, openHigh, cntOnly: BOOLEAN _ FALSE] =
    BEGIN
    index: Tree.Index _ CheckLink[t,subtree];
    f1, f2: Foo;
    size, size2: NumberType;
    signed, signed2: BOOLEAN;
    Add[];
    [f1,size,signed] _ MinimalRep[tb[index].son[1],type];
    [f2,size2,signed2] _
	MinimalRep[tb[index].son[2], IF cntOnly THEN Symbols.typeANY ELSE type];
    Drop[];
    IF cntOnly THEN RETURN;
    IF openLow THEN Inc[f1,size,signed];
    IF openHigh THEN Dec[f2,size,signed2];
    MakeCnt[f2,f1,size,signed OR signed2];
    END;
    
  Size: PUBLIC PROC [f: Foo] =
    BEGIN
    IF ~f.typeOnly THEN AbortWithError[notType];
    PushVal[SymbolOps.WordsForType[f.tsei],com.typeCARDINAL];
    END;
    
  PushNil: PUBLIC PROC [f: Foo] =
    BEGIN
    p: POINTER TO ARRAY [0..3) OF POINTER _ Storage.Node[3];
    nil: Foo _ DHeap.AllocFob[];
    p^ _ ALL[NIL];
    nil.addr.base _ p;
    nil.words _ 1;
    Add[];
    IF f # NIL THEN
      BEGIN
      csei: Symbols.CSEIndex _ TypeForSe[f.tsei];
      nil.tsei _ csei;
      DO
	WITH seb[csei] SELECT FROM
	  long => {nil.words _ nil.words + 1; csei _ TypeForSe[rangeType]};
	  arraydesc => {nil.words _ nil.words + 1; EXIT};
	  ENDCASE => EXIT;
	ENDLOOP;
      END
    ELSE nil.tsei _ Symbols.typeANY;
    Drop[];
    Push[nil];
    END;
    
  Assignable: PUBLIC PROCEDURE [f: Foo, csei: CSEIndex] =
    BEGIN
    left: Types.Handle _ [LOOPHOLE[MyBase],csei];
    right: Types.Handle _ [LOOPHOLE[MyBase],TypeForSe[f.tsei]];
    tSize: CARDINAL = SymbolOps.WordsForType[csei];
    checkSize: BOOLEAN _ TRUE;
    IF ~Types.Assignable[typeL: left, typeR: right] THEN
      AbortWithError[typeMismatch, f.hti];
    DI.GetValue[f];  -- so I can check sizes
    Add[];
    WITH seb[TypeForSe[csei]] SELECT FROM
      subrange =>
	IF CheckLength[f,1] THEN {
	  i: LONG POINTER TO INTEGER _ LOOPHOLE[f.addr.base];
	  checkSize _ range # 0;
	  i^ _ i^ - origin}
	ELSE {Drop[]; AbortWithError[invalidSubrange]};
      ENDCASE;
    Drop[];
    SELECT TRUE FROM
      f.tsei = csei => NULL;
      csei = nullProc => NULL;
      csei = nullSig => NULL;
      csei = nullError => NULL;
      TotalWords[f] = tSize => RETURN;
      tSize # 2 => AbortWithError[sizeMismatch];
      ~CheckLength[f,1] => AbortWithError[sizeMismatch];
      ENDCASE => LengthenFob[f];
    IF checkSize AND tSize # TotalWords[f] THEN AbortWithError[sizeMismatch, f.hti];
    END;
    
  DumpArray: PUBLIC PROC [array: Foo] =
    BEGIN
    cnt: CARDINAL _ GetIndex[];
    start: CARDINAL _ GetIndex[];
    long: BOOLEAN;
    [array,long,] _ SetUpApply[array];
    IF long THEN DoLongDesc[array,start,start+cnt]
    ELSE DoDesc[array,start,start+cnt];
    END;
    
  GetIndex: PROC RETURNS [c: CARDINAL] =
    BEGIN
    f: Foo _ Pop[];
    n: Number;
    n _ GetNumber[f];
    SELECT n.type FROM
      one => c _ n.c;
      ENDCASE => AbortWithError[indexTooBig];
    END;
    
  Memory: PUBLIC PROC [t: Tree.Link, type: Symbols.SEIndex] =
    BEGIN
    f: Foo _ Son[t,type];
    lp: LONG POINTER;
    n: Number _ GetNumber[f, invalidAddress];
    SELECT n.type FROM
      one => lp _ DebugOps.Lengthen[n.p];
      two => lp _ n.lp;
      ENDCASE;
    DHeap.FreeLong[f.addr.base];
    f.hti _ Symbols.HTNull;
    f.tsei _ type;
    f.addr.base _ lp;
    f.there _ TRUE;
    f.words _ 1;
    END;
    
  TotalWords: PUBLIC PROC [f: Foo] RETURNS [cnt: CARDINAL] =
    BEGIN
    cnt _ f.words;
    IF f.bits # 0 THEN cnt _ cnt + 1;
    END;
    
  DumpMemory: PUBLIC PROCEDURE [fcnt: Foo] =
    BEGIN
    fstart: Foo _ Pop[];
    start: LONG POINTER;
    cnt: CARDINAL;
    n: Number;
    n _ GetNumber[fstart];
    SELECT n.type FROM
      one => start _ DebugOps.Lengthen[n.p];
      two => start _ n.lp;
      ENDCASE => AbortWithError[invalidAddress];
    n _ GetNumber[fcnt];
    SELECT n.type FROM
      one => cnt _ n.c;
      two => AbortWithError[wontDump];
      ENDCASE => AbortWithError[invalidNumber];
    Actions.DoRead[start,cnt, Actions.ReadUser];
    RETURN
    END;
    
  GetSize: PUBLIC PROCEDURE [index: Tree.Index, type: Symbols.SEIndex]
      RETURNS [size: NumberType, cnt: CARDINAL, signed: BOOLEAN] =
    BEGIN
    Process: Tree.Scan =
      BEGIN
      tosSize: NumberType;
      int: BOOLEAN;
      IF t = Tree.Null THEN ERROR BadTree;
      cnt _ cnt + 1;
      [,tosSize,int] _ GetRep[t, type];
      IF int THEN signed _ TRUE;
      IF tosSize = size THEN RETURN;
      size _ two;
      END;
    cnt _ 0;  size _ one; signed _ FALSE;
    Add[];
    TreeOps.ScanList[tb[index].son[1],Process ! UNWIND => Drop[]];
    Drop[];
    END;
    
  MinimalRep: PUBLIC PROCEDURE [t: Tree.Link, type: Symbols.SEIndex]
      RETURNS [f: Foo, size: NumberType, signed: BOOLEAN] =
    BEGIN
    p: LONG POINTER TO Inline.LongNumber;
    [f,size,signed] _ GetRep[t,type];
    IF size = one THEN RETURN;
    p _ f.addr.base;
    IF p.highbits # 0 THEN RETURN;
    size _ one; f.words _ 1;
    END;
    
  GetRep: PUBLIC PROCEDURE [t: Tree.Link, type: Symbols.SEIndex]
      RETURNS [f: Foo, size: NumberType, signed: BOOLEAN] =
    BEGIN
    n: Number;
    LoopHoleWork[t, type];
    f _ Tos[];
    Add[];
    WITH seb[TypeForSe[f.tsei]] SELECT FROM
      subrange => f.tsei _ TypeForSe[rangeType];
      ENDCASE;
    Drop[];
    n _ GetNumber[f];
    size _ n.type;
    WITH Format[f.tsei].vf SELECT FROM
      int => {signed _ TRUE; RETURN};
      ENDCASE;
    SELECT size FROM
      one => signed _ ~n.sign;
      two => signed _ ~n.lsign;
      ENDCASE => ERROR DebugOps.InvalidNumber[f];
    END;
    
  Base: PUBLIC PROC [f: Foo, sei: SEIndex] =
    BEGIN
    long: BOOLEAN;
    Add[];
    WITH seb[TypeForSe[f.tsei]] SELECT FROM
      long => long _ TRUE;
      ENDCASE => long _ FALSE;
    Drop[];
    IF long THEN LongBase[f,sei] ELSE ShortBase[f,sei];
    END;
    
  ShortBase: PROC [f: Foo, sei: SEIndex] =
    BEGIN
    asei: Symbols.ArraySEIndex;
    d: LongDesc;
    [d,asei] _ GetDesc[f ! NotAnArray =>
	{AbortWithError[typeMismatch,f.hti]; ERROR}];
    PushLongVal[d.base,MakeLongType[MakePointerType[Symbols.typeANY]]];
    END;
    
  LongBase: PROC [f: Foo, sei: SEIndex] =
    BEGIN
    asei: Symbols.ArraySEIndex;
    d: LongDesc;
    [d,asei] _ GetLongDesc[f ! NotAnArray =>
	{AbortWithError[typeMismatch,f.hti]; ERROR}];
    PushLongVal[d.base,MakeLongType[MakePointerType[Symbols.typeANY]]];
    END;
    
  Length: PUBLIC PROC [f: Foo, sei: SEIndex] =
    BEGIN
    long: BOOLEAN;
    asei: Symbols.ArraySEIndex;
    Add[];
    WITH seb[TypeForSe[f.tsei]] SELECT FROM
      long => long _ TRUE;
      ENDCASE => long _ FALSE;
    Drop[];
    IF long THEN 
      BEGIN ld: LongDesc;
      [ld,asei] _ GetLongDesc[f ! NotAnArray =>
	{AbortWithError[typeMismatch,f.hti]; ERROR}];
      PushVal[ld.length,com.typeCARDINAL];
      END
    ELSE
      BEGIN
      d: LongDesc;
      [d,asei] _ GetDesc[f ! NotAnArray =>
	{AbortWithError[typeMismatch,f.hti]; ERROR}];
      PushVal[d.length,com.typeCARDINAL];
      END;
    END;
    
  DerefApply: PROC [f: Foo] RETURNS [success: BOOLEAN] =
    BEGIN
    tsei: Symbols.CSEIndex _ TypeForSe[f.tsei];
    DO
      WITH seb[tsei] SELECT FROM
	ref => IF basing THEN RETURN[FALSE] ELSE EXIT;
	long => tsei _ TypeForSe[rangeType];
	ENDCASE => RETURN[FALSE];
      ENDLOOP;
    RETURN[Deref[f]];
    END;
    
  SetUpApply: PROC [f: Foo]
      RETURNS [newFoo: Foo, long: BOOLEAN, target: Symbols.CSEIndex] = 
    BEGIN
    WHILE DerefApply[f] DO ENDLOOP;
    target _ TypeForSe[f.tsei];
    Add[];
    WITH seb[target] SELECT FROM
      long => {long _ TRUE; target _ TypeForSe[rangeType]};
      ENDCASE => long _ FALSE;
    Drop[];
    IF target = com.typeStringBody THEN {
      DIActions.Qualify[f, Lookup.StringToHti["text"L]];
      newFoo _ Pop[];
      target _ TypeForSe[newFoo.tsei]}
    ELSE newFoo _ f;
    END;
    
  DoApply: PUBLIC PROC [t: Tree.Link, target: Foo] =
    BEGIN ENABLE UNWIND => Drop[];
    uniOperand: BOOLEAN _ TreeOps.OpName[t] # list;
    long: BOOLEAN;
    targetType: CSEIndex;
    IF target = NIL THEN RETURN;
    Add[];
    [target, long, targetType] _ SetUpApply[target];
    dereferenced _ TRUE;
    DO
    WITH seb[targetType] SELECT FROM
      record => {
	isei: Symbols.ISEIndex = SymbolOps.VariantField[targetType];
	WITH seb[TypeForSe[isei]] SELECT FROM
	  sequence => {
	    DIActions.Qualify[target, seb[isei].hash];
	    target _ Pop[];
	    targetType _ TypeForSe[target.tsei];
	    LOOP};
	  ENDCASE;
	AbortWithError[constructor]};
      sequence =>
	BEGIN
	start: CARDINAL;
	start _ GetStart[t, TypeForSe[tagSei]];
	DoSequence[target,tagSei,start];
	END;
      array =>
	BEGIN
	start: CARDINAL;
	IF ~uniOperand THEN ERROR BadTree;
	start _ GetStart[t, indexType];
	DoArray[target,start,start];
	END;
      arraydesc =>
	BEGIN
	start: CARDINAL;
	asei: Symbols.ArraySEIndex;
	IF ~uniOperand THEN ERROR BadTree;
	asei _ LOOPHOLE[SymbolOps.UnderType[describedType]];
	start _ GetStart[t, seb[asei].indexType];
	IF long THEN DoLongDesc[target,start,start]
	ELSE DoDesc[target,start,start];
	END;
      transfer =>
	BEGIN
	tm: Symbols.TransferMode = SymbolOps.XferMode[targetType];
	IF tm # proc THEN ApplyError[tm];
	ProcedureCall[t,target];
	END;
      ref =>
	BEGIN
	tos: Foo;
	IF ~basing THEN ERROR DerefError;
	Work[t];
	tos _ Tos[];
	IF ~uniOperand THEN AbortWithError[notRelative,tos.hti];
	Reloc[target,tos];
	END;
      ENDCASE => AbortWithError[wrongBrackets, target.hti];
      EXIT;
      ENDLOOP;
    Drop[];
    END;
    
  DoSequence: PROC [f: Foo, tagSei: Symbols.ISEIndex, start: CARDINAL] =
    BEGIN
    ai: Dump.ArrayInfo;
    tag: Foo;
    ba: DebugFormat.BitAddress;
    sei: SequenceSEIndex = LOOPHOLE[TypeForSe[f.tsei]];
    rec: Symbols.CSEIndex = SymbolOps.TypeRoot[sei];
    words: CARDINAL;
    Add[];
    tag _ DI.FindField[f, DI.Pad[f, LOOPHOLE[rec]], tagSei];
    IF tag.bits + tag.addr.offset > MachineDefs.WordLength THEN ERROR BadTag;
    ba _ [base: tag.addr.base, offset: ];
    [words, ba.offset] _ Normalize[tag.addr.offset+tag.bits];
    ba.base _ tag.words + ba.base + words;
    DI.GetValue[tag];
    ai _ [start: start, stop: start, length: tag.addr.base^, addr: ba,
      packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
      type: seb[sei].componentType];
    Drop[];
    GetElement[@ai];
    END;
    
  DoArray: PROC [f: Foo, start, stop: CARDINAL] =
    BEGIN
    ai: Dump.ArrayInfo;
    d: LongDesc;
    sei: Symbols.ArraySEIndex;
    [d,sei] _ GetDesc[f];
    Add[];
    ai _ [
      start: start, stop: stop, length: d.length, addr: f.addr,
      packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
      type: seb[sei].componentType];
    Drop[];
    IF start = stop THEN GetElement[@ai] ELSE Dump.Elements[@ai];
    END;
    
  GetElement: PUBLIC PROCEDURE [ai: Dump.ArrayHandle] =
    BEGIN OPEN DOutput;
    f: Foo _ DHeap.AllocFob[];  -- comes back zeroed
    f.tsei _ ai.type;
    f.there _ TRUE;
    [f.words, f.bits] _ Normalize[ai.packing];
    f.addr _ Dump.CalculateAddr[ai, ai.start];
    Push[f];
    END;
    
  GetStart: PROC [t: Tree.Link, target: Symbols.SEIndex] RETURNS [CARDINAL] =
    BEGIN
    f: Foo;
    n: Number;
    offset: INTEGER _ 0;
    tsei: Symbols.CSEIndex _ TypeForSe[target];
    WITH seb[tsei] SELECT FROM
      subrange => {offset _ origin; --IF range = 0 THEN --tsei _ TypeForSe[rangeType]};
      ENDCASE;
    TargetTypeWork[t,tsei];
    SELECT TotalWords[(f _ Pop[])] FROM
      0 => AbortWithError[invalidNumber];
      1 => NULL;
      2 => AbortWithError[indexTooBig];
      ENDCASE => AbortWithError[invalidNumber];
    n _ GetNumber[f];
    RETURN[n.c-offset];
    END;
    
  Reloc: PROC [base, rel: Foo] =
    BEGIN ENABLE UNWIND => Drop[];
    csei: CSEIndex _ TypeForSe[rel.tsei];
    rr: RelocRec;
    Add[];
    WITH seb[csei] SELECT FROM
      relative =>
	BEGIN
	lengthen, pointer: BOOLEAN;
	left: Types.Handle _ [LOOPHOLE[MyBase],TypeForSe[baseType]];
	right: Types.Handle _ [LOOPHOLE[MyBase],TypeForSe[base.tsei]];
	IF ~Types.Equivalent[left, right] THEN AbortWithError[wrongBase, base.hti];
	rel.tsei _ offsetType;
	[rr, lengthen, pointer] _ Relocate[base,rel];
	DHeap.FreeLong[rel.addr.base];
	rel.tsei _ IF lengthen THEN MakeLongType[TypeForSe[resultType]] ELSE resultType;
	rel.addr.base _ rr.base; rel.addr.offset _ rel.bits _ 0;
	rel.words _ SymbolOps.WordsForType[resultType];
	rel.there _ FALSE; rel.hti _ Symbols.HTNull;
	IF pointer AND ~Deref[rel] THEN AbortWithError[notRelative];
	END;
      ENDCASE => AbortWithError[notRelative,rel.hti];
    Drop[];
    END;
    
  Relocate: PROC [f1,f2: Foo] RETURNS [rr: RelocRec, lengthen: BOOLEAN, deref: BOOLEAN] =
    BEGIN
    n: Number;
    lc: LONG CARDINAL;
    csei: Symbols.CSEIndex _ TypeForSe[f2.tsei];
    long: BOOLEAN _ FALSE;
    lengthen _ FALSE;
    n _ GetNumber[f1, invalidAddress];
    rr.base _ Storage.Node[SIZE[LongDesc]];
    IF n.type = one THEN lc _ n.c ELSE lc _ n.lc;
    DO ENABLE UNWIND => DHeap.FreeLong[rr.base];
      WITH seb[csei] SELECT FROM
	arraydesc => {
	  IF long THEN {
	    d: LongDesc;
	    [d, csei] _ GetLongDesc[f2];
	    d.base _ d.base + lc;
	    rr.rel^ _ d}
	  ELSE {
	    d: LongDesc;
	    [d, csei] _ GetDesc[f2];
	    lengthen _ TRUE;
	    d.base _ d.base + lc;
	    rr.rel^ _ d};
	  deref _ FALSE;
	  RETURN};
	long => {long _ TRUE; csei _ TypeForSe[rangeType]; LOOP};
	ENDCASE => {
	  deref _ TRUE;
	  n _ GetNumber[f2, notRelative];
	  IF n.type = one THEN lc _ lc + n.c ELSE lc _ lc + n.lc;
	  rr.lc^ _ lc;
	  RETURN};
      ENDLOOP;
    END;
    
  RelocRec: TYPE = RECORD [SELECT OVERLAID * FROM
    pointer => [lc: LONG POINTER TO LONG CARDINAL],
    relDesc => [rel: LONG POINTER TO LongDesc],
    foo => [base: LONG POINTER],
    ENDCASE];
    
  DoLongDesc: PROC [f: Foo, start, stop: CARDINAL] =
    BEGIN
    sei: Symbols.ArraySEIndex;
    d: LongDesc;
    ai: Dump.ArrayInfo;
    [d,sei] _ GetLongDesc[f];
    IF d.base = NIL THEN AbortWithError[nilChk];
    Add[];
    ai _ [start: start, stop: stop, addr: [d.base,0], length: d.length,
      packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
      type: seb[sei].componentType];
    Drop[];
    IF start = stop THEN GetElement[@ai] ELSE Dump.Elements[@ai];
    END;
    
  DoDesc: PROC [f: Foo, start, stop: CARDINAL] =
    BEGIN
    sei: Symbols.ArraySEIndex;
    d: LongDesc;
    ai: Dump.ArrayInfo;
    [d,sei] _ GetDesc[f];
    IF d.base = NIL THEN AbortWithError[nilChk];
    Add[];
    ai _ [start: start, stop: stop, addr: [d.base,0],
      length: d.length, 
      packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
      type: seb[sei].componentType];
    Drop[];
    IF start = stop THEN GetElement[@ai] ELSE Dump.Elements[@ai];
    END;
    
  ProcedureCall: PUBLIC PROCEDURE [args: Tree.Link, proc: Foo] =
    BEGIN OPEN SymbolOps;
    ENABLE UNWIND => Drop[];
    cnt: CARDINAL _ 0;
    in: Symbols.RecordSEIndex;
    isei: ISEIndex _ Symbols.ISENull;
    cl: PrincOps.ControlLink;
    state: PrincOps.StateVector;
    cbti: Symbols.CBTIndex;
    sv: PrincOps.SVPointer;
    
    Collect: Tree.Scan = 
      BEGIN
      f: Foo;
      words: CARDINAL;
      p: LONG POINTER TO ARRAY [0..0) OF UNSPECIFIED;
      isei _ IF cnt = 0 THEN FirstCtxSe[seb[in].fieldCtx] ELSE NextSe[isei];
      IF isei = Symbols.ISENull THEN AbortWithError[wrongNumberArgs,proc.hti];
      TargetTypeWork[t,isei];
      words _ TotalWords[(f_Pop[])];
      GetValue[f];
      cnt _ cnt + words;
      IF state.stkptr + words > PrincOps.MaxParamsInStack THEN
	AbortWithError[tooManyArgs,proc.hti];
      p _ LOOPHOLE[f.addr.base];
      FOR i: CARDINAL IN [0..words) DO
	state.stk[state.stkptr] _ p[i];
	state.stkptr _ state.stkptr + 1;
	ENDLOOP;
      END;
      
    Add[];
    IF data.worryEntry THEN AbortWithError[worryCall];
    in _ TransferTypes[TypeForSe[proc.tsei]].typeIn;
    state.instbyte _ state.stkptr _ 0;
    TreeOps.ScanList[args,Collect];
    IF cnt#WordsForType[in] OR (cnt#0 AND NextSe[isei]#Symbols.ISENull) THEN 
      AbortWithError[wrongNumberArgs,proc.hti];
    cl _ DerefProcDesc[GetControlLink[proc ! NotAProcedure => GOTO inline] !
      NotAProcedure => GOTO inline];
    cbti _ Pc.LinkToCbti[cl];
    IF cbti = Symbols.CBTNull THEN AbortWithError[callingInline];
    state.source _ NIL;
    state.dest _ Gf.OldLink[cl];
    sv _ @LOOPHOLE[data.ESV.parameter, MachineDefs.CallDP].sv;
    DebugOps.ShortCopyWRITE[
      to: sv, from: @state, nwords: SIZE[PrincOps.StateVector]];
    Init.CoreSwap[call];
    sv _ @LOOPHOLE[data.ESV.parameter, MachineDefs.CallDP].sv;
    CollectResults[cbti, sv];
    Drop[];
    EXITS
      inline => AbortWithError[callingInline];
    END;
    
  CollectResults: PROC [cbti: Symbols.CBTIndex, sv: PrincOps.SVPointer] =
    BEGIN
    f: DebugOps.Foo _ Lookup.XferCtx[bb[cbti].id,NIL,out];
    locals: POINTER;
    IF f = NIL OR f.tsei = Symbols.RecordSENull THEN {Push[DHeap.AllocFob[]]; RETURN};
    WITH seb[DI.TypeForSe[f.tsei]] SELECT FROM
      record => IF hints.unifield THEN {
	csei: Symbols.CSEIndex = DI.TypeForSe[SymbolOps.FirstCtxSe[fieldCtx]];
	WITH seb[csei] SELECT FROM
	  record => NULL;
	  ENDCASE => f.tsei _ csei};
      ENDCASE;
    f.there _ f.addr.useStack _ TRUE;
    locals _ IF f.words > PrincOps.MaxParamsInStack THEN
      DebugOps.ShortREAD[@sv.stk[0]]
    ELSE @sv.stk[0];
    f.addr.base _ DebugOps.Lengthen[locals];
    f.xfer _ FALSE;
    Push[f];
    END;
    
  ApplyError: PROC [tm: Symbols.TransferMode] =
    BEGIN OPEN DOutput;
    Text[" can't call a"L]; IF tm = error THEN Char['n];
    Blanks[1]; Dump.ModeName[tm]; Char['!]; EOL[];
    ERROR DIAbort;
    END;
    
  LongRec: TYPE = RECORD [sei, lsei: Symbols.CSEIndex];
  longs: ARRAY [0..3) OF LongRec;
  nullProc: PUBLIC Symbols.CSEIndex;
  nullError: PUBLIC Symbols.CSEIndex;
  nullSig: PUBLIC Symbols.CSEIndex;
  
  MakeXferType: PUBLIC PROC [mode: Symbols.TransferMode]
      RETURNS [csei: Symbols.CSEIndex] =
    BEGIN OPEN SymbolOps, Symbols;
    SELECT mode FROM
      proc =>
	BEGIN
	IF nullProc # CSENull THEN RETURN[nullProc];
	csei _ nullProc _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	END;
      signal =>
	BEGIN
	IF nullSig # CSENull THEN RETURN[nullSig];
	csei _ nullSig _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	END;
      error =>
	BEGIN
	IF nullError # CSENull THEN RETURN[nullError];
	csei _ nullError _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	END;
      ENDCASE;
    Add[];
    seb[csei] _ SERecord[mark3: TRUE, mark4: TRUE, body: cons[transfer[
	mode: mode, inRecord: RecordSENull, outRecord: RecordSENull]]];
    Drop[];
    END;
    
  SetUpLongs: PROCEDURE =
    BEGIN
    longs[0] _ [com.typeINT, Symbols.CSENull];
    longs[1] _ [com.typeCARDINAL, Symbols.CSENull];
    longs[2] _ [Symbols.typeANY, Symbols.CSENull];
    nullProc _ nullError _ nullSig _ Symbols.CSENull;
    END;
    
  ResetLongs: PUBLIC PROC =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..LENGTH[longs]) DO longs[i].lsei _ Symbols.CSENull ENDLOOP;
    nullProc _ nullError _ nullSig _ Symbols.CSENull;
    END;
    
  MakeLongType: PUBLIC PROC [rType: Symbols.SEIndex]
    RETURNS [type: Symbols.CSEIndex] =
    BEGIN OPEN SymbolOps, Symbols;
    i: CARDINAL;
    sei: CSEIndex _ UnderType[rType];
    Add[];
    WITH seb[sei] SELECT FROM
      long => {Drop[]; RETURN[sei]};
      ENDCASE => Drop[];
    FOR i IN [0..LENGTH[longs]) DO
      IF longs[i].sei # sei THEN LOOP;
      IF longs[i].lsei # SENull THEN RETURN[longs[i].lsei];
      longs[i].lsei _ type _ MakeNonCtxSe[SIZE[long cons SERecord]];
      EXIT
      REPEAT
	FINISHED => type _ MakeNonCtxSe[SIZE[long cons SERecord]];
      ENDLOOP;
    Add[];
    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
	body: cons[long[rangeType: rType]]];
    Drop[];
    RETURN
    END;
    
  MakePointerType: PUBLIC PROC [cType: Symbols.SEIndex]
      RETURNS [type: Symbols.CSEIndex] =
    BEGIN OPEN SymbolOps, Symbols;
    type _ MakeNonCtxSe[SIZE[ref cons SERecord]];
    Add[];
    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
	body: cons[ref[
	    list: FALSE,
	    counted: FALSE,
	    ordered: FALSE,
	    readOnly: FALSE,
	    basing: FALSE,
	    refType: cType]]];
    Drop[];
    RETURN
    END;
    
  AbortWithError: PUBLIC PROC [
      code: Err, hti: Symbols.HTIndex _ Symbols.HTNull] =
    BEGIN Error[code, hti]; ERROR DIAbort END;
    
  Error: PUBLIC PROC [code: Err, hti: Symbols.HTIndex _ Symbols.HTNull] =
    BEGIN
    s: STRING _ [40];
    IF hti # Symbols.HTNull THEN {Lookup.HtiToString[hti,s]; DOutput.Text[s]};
    DOutput.Line[SELECT code FROM
      callingInline => " can't call an INLINE!"L,
      cantLengthen => " can't lengthen!"L,
      constructor => " can't make a constructor!"L,
      indexTooBig => " double word array index!"L,
      invalidAddress => " has an invalid address!"L,
      invalidNumber => " is an invalid number!"L,
      invalidPointer => " is an invalid pointer!"L,
      invalidSubrange => " invalid subrange!"L,
      nilChk => " pointer fault!"L,
      notFound => " not found!"L,
      notProcDesc => " is not a valid control link!"L,
      notRelative => " is not a relative pointer!"L,
      notType => " is not a type!"L,
      notUniqueField => " is not a unique field selector!"L,
      notValidField => " is not a valid field selector!"L,
      overflow => " overflow!"L,
      relation => " relations not implemented!"L,
      sizeMismatch => " size mismatch!"L,
      tooManyArgs => " too many arguments for stack!"L,
      typeMismatch => " has incorrect type!"L,
      unknownVariant => " unknown variant!"L,
      wontDump => " Won't dump that much memory!"L,
      worryCall => " not permitted in worry mode!"L,
      wrongBase => " is the wrong base!"L,
      wrongNumberArgs => " has the wrong number of arguments!"L,
      wrongBrackets => " used incorrectly with []!"L,
      wrongDollar => "$ is ambiguous; use frame $!"L,
      notArray => " is not an array!"L,
      ENDCASE => ERROR];
    END;
    
  SetUpLongs[];
  
  END.