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