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