-- file UtilsHot.Mesa
-- last modified by Bruce, October 28, 1980 12:17 PM
-- last modified by Johnsson, July 18, 1980 8:57 AM
DIRECTORY
ComData USING [typeCARDINAL, typeStringBody],
Copier USING [SearchFileCtx],
DContext USING [GetGlobal],
DebugOps USING [BitAddress, LongCopyREAD],
DI USING [Foo, SearchCtxForVal, UnionSEIndex, ValFormat, VType],
DSyms USING [GFHandle, GFrameHti],
Gf USING [],
Init USING [],
Inline USING [COPY, LowHalf],
LiteralOps USING [DescriptorValue, StringValue],
Literals USING [LitDescriptor, LitRecord, ltType],
Lookup USING [HTIndex, HtiToString, MakeFoo],
MachineDefs USING [FieldDescriptor, GFHandle, LCOPY, WordLength],
Mopcodes USING [zRFS],
Storage USING [CopyString, Node],
String USING [WordsForString],
Strings USING [AppendSubString, SubString, SubStringDescriptor],
SymbolOps USING [BitsForType, EnterString, SearchContext, SubStringForHash, UnderType],
SymbolPack,
Symbols USING [codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex, CTXNull, ctxType, HTIndex, ISEIndex, ISENull, mdType, RecordSEIndex, SEIndex, seType, TypeClass, typeTYPE],
Table USING [AddNotify, Base, DropNotify, Notifier];
UtilsHot: PROGRAM
IMPORTS
com: ComData, Copier, DContext, DebugOps, DI, Strings, DSyms, Inline,
LiteralOps, Lookup, MachineDefs, Storage, SymbolOps,
myBase: SymbolPack, String, Table
EXPORTS DI, Gf, Init, Lookup
SHARES Copier =
BEGIN
OPEN DI, SymbolOps, Symbols;
LiteralProblem: ERROR = CODE;
StrangeRecord: ERROR = CODE;
WrongTypeClass: ERROR [f: Foo] = CODE;
DefaultOutputFormat: PUBLIC ValFormat ← [card[]];
-- tables defining the current symbol table
seb: Table.Base; -- se table
mdb: Table.Base; -- module table
ltb: Table.Base;
ctxb: Table.Base; -- context table
Notify: Table.Notifier =
BEGIN
ltb ← base[Literals.ltType];
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;
Name: PUBLIC PROCEDURE [name: STRING, gf: MachineDefs.GFHandle ← NIL] =
BEGIN
hti: Symbols.HTIndex = DSyms.GFrameHti[IF gf = NIL THEN DContext.GetGlobal[] ELSE gf];
Lookup.HtiToString[hti,name];
END;
CopyLiteral: PUBLIC PROCEDURE [info: Literals.LitRecord]
RETURNS [p: POINTER, length: CARDINAL] =
BEGIN
Enter[];
WITH info SELECT FROM
word =>
BEGIN
lit: Literals.LitDescriptor ← LiteralOps.DescriptorValue[index];
length ← lit.length;
p ← Storage.Node[length];
MachineDefs.LCOPY[from: @ltb[lit.offset], to: p, nwords: length];
END;
string =>
BEGIN
s: STRING ←
Storage.CopyString[LiteralOps.StringValue[index]];
length ← String.WordsForString[s.length];
p ← s;
END;
ENDCASE => ERROR LiteralProblem;
Exit[];
END;
StringToHti: PUBLIC PROC [s: STRING] RETURNS [HTIndex] =
BEGIN
desc: Strings.SubStringDescriptor ← [base: s, offset: 0, length: s.length];
RETURN[SymbolOps.EnterString[@desc]];
END;
HtiToString: PUBLIC PROC [hti: HTIndex, s: STRING] =
BEGIN
desc: Strings.SubStringDescriptor;
ss: Strings.SubString ← @desc;
SymbolOps.SubStringForHash[ss,hti];
Strings.AppendSubString[s,ss];
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;
IF field = NIL THEN RETURN;
field.there ← f.there; field.xfer ← f.xfer; field.indent ← f.indent;
IF ~f.there THEN FixupHeap[f,field];
END;
FixupHeap: PROC [old, new: Foo] = {
OPEN Inline;
words: CARDINAL ← old.words + (IF old.bits = 0 THEN 0 ELSE 1);
new.addr.base ← Storage.Node[words];
COPY[from: LowHalf[old.addr.base], nwords: words, to: LowHalf[new.addr.base]]};
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 > 0 AND 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;
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 ← DI.SearchCtxForVal[val,ictx,none];
END;
TypeForSe: PUBLIC PROC [sei: SEIndex] RETURNS [type: CSEIndex] =
BEGIN
Enter[];
DO
WITH seb[sei] SELECT FROM
id => IF idType # typeTYPE THEN sei ← idType ELSE EXIT;
ENDCASE => EXIT;
ENDLOOP;
Exit[];
RETURN[UnderType[sei]];
END;
RFS: PROC [POINTER, MachineDefs.FieldDescriptor] RETURNS [UNSPECIFIED] =
MACHINE CODE BEGIN Mopcodes.zRFS END;
ReadField: PROCEDURE [f: Foo] =
BEGIN OPEN f;
fd: MachineDefs.FieldDescriptor ←
[offset: 0, posn: addr.offset, size: bits];
p: POINTER ← Inline.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 {
p ← Storage.Node[cnt];
DebugOps.LongCopyREAD[from: addr.base, to: p, nwords: cnt];
addr.base ← p;
there ← FALSE};
IF bits # 0 THEN ReadField[f];
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 ← DefaultOutputFormat;
codeINT => BEGIN intSub ← inSubrange; vf ← [int[]] END;
codeCHAR => vf ← [char[]];
ENDCASE;
GOTO exit;
END;
subrange =>
BEGIN
IF csei = com.typeCARDINAL THEN { vf ← DefaultOutputFormat; 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.