-- file UtilsCold.Mesa
-- last modified by Bruce, October 25, 1980 9:00 PM
DIRECTORY
ComData USING [seAnon, typeBOOL, typeCONDITION, typeLOCK, typeStringBody],
Copier USING [
AugmentContext, CompleteContext, CopyUnion, FindExternalCtx, Outer, SEToken,
TokenSymbol],
DebugOps USING [BitAddress, Foo, GFHandle, Lengthen, LongCopyWRITE, LongREAD, LongWRITE,
ReadCodeWord, ShortREAD],
DI USING [
AbortWithError, Desc, Foo, GetValue, LongDesc,
Normalize, Pad, SearchCtxList, TypeForSe],
DIActions USING [],
DOutput USING [EOL, Line, Octal, Text],
DSyms USING [GFHandle, GFrameMdi],
Dump USING [HtiVal],
Frames USING [Invalid],
Gf USING [AddGfi, Check, Links, NewLink, OldLink, Validate],
DHeap USING [AllocFob],
Inline USING [LowHalf],
Lf USING [GF, NoAccessLink, Validate],
Lookup USING [CopyLiteral, Flavor],
MachineDefs USING [ControlLink, FieldDescriptor, GFHandle, ProcDesc, WordLength],
Mopcodes USING [zWFS],
PrincOps USING [ControlLink],
State USING [Get],
Storage USING [Node],
SymbolOps USING [
Cardinality, EnterExtension, FindExtension, FirstCtxSe, FnField,
NextSe, TypeForm, UnderType, WordsForType, XferMode],
SymbolPack USING [FirstCtxSe, NextSe, seb, XferMode],
Symbols USING [
ArraySEIndex, BitAddress, BTIndex, BTNull, CSEIndex, CTXIndex, CTXNull,
ctxType, ExtensionType, HTIndex, IncludedCTXIndex, IncludedCTXNull, ISEIndex,
ISENull, MDIndex, MDNull, mdType, RecordSEIndex, SEIndex, SENull, SERecord,
seType, TransferMode, typeANY, typeTYPE],
SymbolTable USING [Base, Missing],
Table USING [AddNotify, Base, DropNotify, Notifier],
Tree USING [Link, Node, Null, treeType],
TreeOps USING [FreeTree];
UtilsCold: PROGRAM
IMPORTS
com: ComData, Copier, DebugOps, DI, DOutput, DSyms, Dump, Frames,
Gf, DHeap, Inline, Lf, Lookup, State, Storage,
SymbolOps, myBase: SymbolPack, SymbolTable, Table, TreeOps
EXPORTS DI, DIActions, Lookup
SHARES Copier =
BEGIN OPEN DI, SymbolOps, Symbols;
NotAProcedure: PUBLIC ERROR [cl: MachineDefs.ControlLink] = CODE;
NotAnArray: PUBLIC ERROR = CODE;
NotHere: PUBLIC ERROR = CODE;
SizeMismatch: PUBLIC ERROR = CODE;
NotRelocated: PUBLIC SIGNAL RETURNS [LONG POINTER] = CODE;
CantAssignInDebuggerImage: ERROR = CODE;
UnexpectedLiteral: ERROR = CODE;
LiteralProblem: ERROR = CODE;
OffsetVariableCrossesWordBoundary: ERROR = CODE;
ConfusedAboutImports: ERROR = CODE;
NoTree: ERROR = CODE;
-- tables defining the current symbol table
seb: Table.Base; -- se table
mdb: Table.Base; -- module table
ctxb: Table.Base; -- context table
tb: Table.Base; -- tree table
Notify: Table.Notifier =
BEGIN -- called whenever the main symbol table is repacked
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType];
tb ← base[Tree.treeType];
END;
entryDepth: CARDINAL ← 0;
Add: PROCEDURE =
BEGIN
IF entryDepth = 0 THEN Table.AddNotify[Notify];
entryDepth ← entryDepth + 1;
END;
Drop: PROCEDURE =
BEGIN
IF (entryDepth ← entryDepth-1) = 0 THEN Table.DropNotify[Notify];
END;
-- finding union and discriminated types
VariantUnionType: PUBLIC PROC [type: SEIndex] RETURNS [vType: CSEIndex] =
BEGIN
rType: CSEIndex;
Add[];
rType ← TypeForSe[type];
vType ← WITH seb[rType] SELECT FROM
record =>
IF hints.variant
THEN UnderType[TypeForSe[UnionField[LOOPHOLE[rType]]]]
ELSE typeANY,
ENDCASE => typeANY;
Drop[];
RETURN
END;
SelectVariantType: PUBLIC PROCEDURE [type: SEIndex, tag: HTIndex] RETURNS [sei: ISEIndex] =
BEGIN
vType: CSEIndex = VariantUnionType[type];
Add[];
WITH seb[vType] SELECT FROM
union => sei ← SearchCtxList[tag, caseCtx];
ENDCASE => sei ← ISENull;
Drop[];
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];
Add[];
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;
Drop[];
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];
Add[];
IF (sei ← SearchValContext[val,ctx]) # ISENull
AND CheckIsei[myBase,sei,tm] THEN {Drop[]; RETURN};
sei ← ISENull;
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;
Drop[];
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;
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: LongDesc, asei: ArraySEIndex] =
BEGIN
desc: BOOLEAN;
long: BOOLEAN;
Add[];
[asei:asei, desc:desc, long:long] ← ArraySei[f.tsei ! UNWIND => Drop[]];
IF long THEN {Drop[]; ERROR SizeMismatch};
IF ~desc THEN
BEGIN
IF ~f.there THEN ERROR NotHere;
d.base ← f.addr.base;
d.length ← SymbolOps.Cardinality[seb[asei].indexType];
END
ELSE
BEGIN
sd: Desc;
GetValue[f];
sd ← LOOPHOLE[f.addr.base, LONG POINTER TO Desc]↑;
d.base ← DebugOps.Lengthen[sd.base]; d.length ← sd.length;
END;
Drop[];
END;
GetLongDesc: PUBLIC PROC [f: Foo] RETURNS [ld: LongDesc, asei: ArraySEIndex] =
BEGIN
desc: BOOLEAN;
long: BOOLEAN;
lp: LONG POINTER TO LongDesc;
Add[];
[asei:asei, desc:desc, long:long] ← ArraySei[f.tsei ! UNWIND => Drop[]];
IF ~long THEN {Drop[]; 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;
Drop[];
END;
WFS: PROC [UNSPECIFIED, POINTER, MachineDefs.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: MachineDefs.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;
CopyMore: PUBLIC PROCEDURE [
tsei: Symbols.SEIndex, doVariants: BOOLEAN ← FALSE] =
BEGIN OPEN Symbols, SymbolOps, com;
csei: CSEIndex;
Add[];
DO
WITH seb[tsei] SELECT FROM
id => tsei ← IF idType = typeTYPE THEN UnderType[tsei] ELSE idType;
cons => BEGIN csei ← LOOPHOLE[tsei]; EXIT END;
ENDCASE
ENDLOOP;
WITH seb[csei] SELECT FROM
enumerated => IF csei # typeBOOL THEN Complete[valueCtx];
record =>
SELECT csei FROM
typeStringBody, typeLOCK, typeCONDITION => RETURN;
ENDCASE => Complete[fieldCtx, doVariants];
ENDCASE;
Drop[];
END;
Complete: PUBLIC PROCEDURE [
ictx: Symbols.CTXIndex, variants: BOOLEAN ← FALSE] =
BEGIN OPEN Symbols, SymbolOps, Copier;
CheckUnions: PROCEDURE [isei: ISEIndex] =
BEGIN
tsei: SEIndex;
IF isei = ISENull THEN RETURN;
tsei ← seb[isei].idType;
IF tsei = typeTYPE THEN RETURN;
WITH se: seb[tsei] SELECT FROM
cons => WITH se SELECT FROM
union =>
BEGIN
Complete[caseCtx];
FOR isei ← SymbolOps.FirstCtxSe[caseCtx], SymbolOps.NextSe[isei]
UNTIL isei = ISENull DO
CopyMore[isei,TRUE];
ENDLOOP;
END;
ENDCASE;
ENDCASE;
RETURN
END;
Add[];
WITH ctxb[ictx] SELECT FROM
included => IF ~complete THEN
CompleteContext[LOOPHOLE[ictx], TRUE ! UNWIND => Drop[]];
ENDCASE => {Drop[]; RETURN};
WITH ctxb[ictx] SELECT FROM
included =>
BEGIN
p: POINTER ← State.Get[].h.interpretContext;
gf: MachineDefs.GFHandle ← IF Lf.Validate[p] THEN Lf.GF[p] ELSE p;
mdi: MDIndex;
mdi ← DSyms.GFrameMdi[gf ! SymbolTable.Missing => GOTO bailout];
IF ~complete THEN
AugmentContext[LOOPHOLE[ictx], TRUE, mdi ! UNWIND => Drop[]];
-- IF ~reset AND ~complete THEN {ResetCtxList[ictx]; closed ← reset ← TRUE};
EXITS
bailout => NULL;
END;
ENDCASE;
IF variants THEN
BEGIN
isei, root: ISEIndex;
isei ← root ← ctxb[ictx].seList;
DO
IF isei = SENull THEN EXIT;
CheckUnions[isei];
WITH id: seb[isei] SELECT FROM
sequential => isei ← isei + SIZE[sequential id SERecord];
linked => IF (isei ← id.link) = root THEN EXIT;
ENDCASE => EXIT;
ENDLOOP;
END;
Drop[];
END;
AddDesc: PROCEDURE [f: Foo, cl: PrincOps.ControlLink] =
BEGIN
p: POINTER TO PrincOps.ControlLink;
p ← Storage.Node[1];
p↑ ← cl;
f.addr.base ← p;
f.words ← 1;
END;
Constant: PROCEDURE [f: Foo, isei: Symbols.ISEIndex] =
BEGIN OPEN seb[isei];
val: POINTER;
length: CARDINAL ← 1;
IF ~extended THEN
BEGIN
val ← Storage.Node[length];
LOOPHOLE[val, POINTER TO CARDINAL]↑ ← idValue;
END
ELSE
BEGIN
tree: Tree.Link;
type: Symbols.ExtensionType;
[type, tree] ← SymbolOps.FindExtension[isei];
IF type # value THEN ERROR UnexpectedLiteral;
IF tree = Tree.Null THEN {MakeFooError[noTree,hash]; ERROR NoTree};
WITH tree SELECT FROM
subtree =>
BEGIN
IF tb[index].name # mwconst THEN ERROR LiteralProblem;
tree ← tb[index].son[1];
END;
ENDCASE => ERROR UnexpectedLiteral;
WITH tree SELECT FROM
literal => [val,length] ← Lookup.CopyLiteral[info];
ENDCASE => ERROR LiteralProblem;
END;
f.addr.base ← val;
f.words ← length;
END;
Mode: PUBLIC PROCEDURE [isei: Symbols.ISEIndex] RETURNS [Lookup.Flavor] =
BEGIN
tsei: Symbols.SEIndex ← seb[isei].idType;
xfer: BOOLEAN ← SymbolOps.XferMode[tsei] # none;
constant: BOOLEAN ← seb[isei].constant;
linkspace: BOOLEAN ← seb[isei].linkSpace;
SELECT TRUE FROM
xfer AND constant =>
BEGIN
bti: Symbols.BTIndex ← seb[isei].idInfo;
IF seb[isei].extended THEN RETURN[inline];
IF bti = Symbols.BTNull THEN RETURN[controlLink]
ELSE RETURN[unrelocatedControlLink];
END;
xfer AND ~constant =>
IF linkspace THEN RETURN[refProc] ELSE RETURN[val];
constant => RETURN[manifest];
linkspace => RETURN[refVal];
ENDCASE => RETURN[val];
END;
MakeFooError: PROCEDURE [err: {links, unbound, noTree}, u: UNSPECIFIED] =
BEGIN OPEN DOutput;
SELECT err FROM
links => {Text[" !Can't find links from frame: "L]; Octal[u]; EOL[]};
unbound => {EOL[]; Dump.HtiVal[u]; Line[" is unbound!"L]};
noTree => {Text[" ! Tree for "L]; Dump.HtiVal[u]; Line[" not in symbol table."L]};
ENDCASE;
END;
GetLink: PROC [gf: MachineDefs.GFHandle, bits: CARDINAL, proc: BOOLEAN]
RETURNS [UNSPECIFIED] =
BEGIN OPEN DebugOps;
offset: INTEGER ← bits/MachineDefs.WordLength + 1;
cl: MachineDefs.ProcDesc;
IF ~Gf.Validate[gf] THEN gf ← Lf.GF[LOOPHOLE[gf]];
IF Gf.Links[gf] THEN cl ← ReadCodeWord[gf, -offset]
ELSE cl ← ShortREAD[gf-offset];
IF proc THEN RETURN[Gf.NewLink[cl]] ELSE RETURN[cl];
END;
FrameAddress: PROC [
ba: DebugOps.BitAddress, isei: Symbols.ISEIndex, sizeInc: CARDINAL]
RETURNS [addr: DebugOps.BitAddress, size: CARDINAL] =
BEGIN
delta: CARDINAL;
addr.useStack ← FALSE;
addr.local ← ba.local;
[delta, addr.offset] ← Normalize[seb[isei].idValue+ba.offset];
addr.base ← ba.base+delta;
size ← seb[isei].idInfo+sizeInc;
END;
StackAddress: PROC [ba: DebugOps.BitAddress, isei: Symbols.ISEIndex]
RETURNS [addr: DebugOps.BitAddress, size: CARDINAL] =
BEGIN
delta: CARDINAL;
offset: Symbols.BitAddress;
addr.useStack ← TRUE;
addr.local ← ba.local;
[offset,size] ← SymbolOps.FnField[isei];
[delta, addr.offset] ← Normalize[offset.bd+ba.offset];
addr.base ← ba.base+delta+offset.wd;
END;
CheckForHiddenPadding: PROC [f: Foo] = INLINE
BEGIN
csei: Symbols.CSEIndex = DI.TypeForSe[f.tsei];
WITH seb[csei] SELECT FROM
array => f.addr.offset ← DI.Pad[f, LOOPHOLE[csei]];
ENDCASE;
END;
FixupFrame: PROC [p: POINTER] RETURNS [gf: MachineDefs.GFHandle] =
BEGIN
gf ← IF Lf.Validate[p] THEN Lf.GF[p] ELSE p;
Gf.Check[gf];
END;
MakeFoo: PUBLIC PROCEDURE [isei: Symbols.ISEIndex,
ba: DebugOps.BitAddress ← [NIL, 0, FALSE], sizeInc: CARDINAL ← 0]
RETURNS [f: Foo] =
BEGIN OPEN DebugOps, MachineDefs, Symbols, seb[isei];
flavor: Lookup.Flavor;
gf: GFHandle;
IF isei = ISENull THEN RETURN[NIL];
Add[];
f ← DHeap.AllocFob[]; -- initialized to all zero
f.hti ← hash;
IF idType = Symbols.typeTYPE THEN
BEGIN f.typeOnly ← TRUE; f.tsei ← isei; Drop[]; RETURN END;
f.tsei ← idType;
SELECT (flavor ← Mode[isei]) FROM
manifest, inline, controlLink => NULL;
ENDCASE => IF ~ba.useStack THEN
BEGIN ENABLE UNWIND => Drop[];
IF ba.base = NIL THEN ba.base ← SIGNAL NotRelocated;
IF flavor # val THEN gf ← FixupFrame[Inline.LowHalf[ba.base]];
END;
SELECT flavor FROM
manifest => Constant[f,isei ! NoTree => {f ← NIL; CONTINUE}];
val =>
BEGIN
size: CARDINAL;
f.there ← TRUE;
IF ba.useStack THEN [f.addr, size] ← StackAddress[ba,isei]
ELSE [f.addr, size] ← FrameAddress[ba, isei, sizeInc];
[f.words, f.bits] ← Normalize[size];
IF f.bits + f.addr.offset > MachineDefs.WordLength THEN
ERROR OffsetVariableCrossesWordBoundary;
CheckForHiddenPadding[f];
END;
refProc =>
BEGIN
cl: PrincOps.ControlLink ← GetLink[gf, idValue, TRUE
!Frames.Invalid,Lf.NoAccessLink=>{MakeFooError[links,gf];GOTO bad}];
AddDesc[f, cl];
EXITS
bad => BEGIN Drop[]; RETURN[NIL] END;
END;
refVal =>
BEGIN
p: POINTER ← GetLink[gf, idValue, FALSE ! Frames.Invalid, Lf.NoAccessLink =>
BEGIN MakeFooError[links,gf]; GOTO nolinks END];
IF p = NIL OR p = LOOPHOLE[1] THEN {MakeFooError[unbound, f.hti]; GOTO nolinks};
WITH seb[SymbolOps.UnderType[idType]] SELECT FROM
ref => f.tsei ← DI.TypeForSe[refType];
ENDCASE => ERROR ConfusedAboutImports;
f.there ← TRUE;
f.addr.base ← Lengthen[p];
WITH seb[f.tsei] SELECT FROM
id => [f.words, f.bits] ← Normalize[idInfo];
ENDCASE => f.words ← SymbolOps.WordsForType[f.tsei];
EXITS
nolinks => BEGIN Drop[]; RETURN[NIL] END;
END;
inline =>
BEGIN
tree: Tree.Link;
type: Symbols.ExtensionType;
[type, tree] ← SymbolOps.FindExtension[isei];
SymbolOps.EnterExtension[isei,type,TreeOps.FreeTree[tree]];
DOutput.Line[" !Inline"L];
Drop[];
RETURN[NIL]
END;
controlLink => AddDesc[f, idValue];
unrelocatedControlLink => AddDesc[f, Gf.AddGfi[gf, idValue]];
ENDCASE;
Drop[];
END;
END.