[ivy]<Satterthwaite>Mimosa>SymbolPack.mesa!4

file SymbolPack.mesa
last modified by Satterthwaite, June 18, 1986 10:28:58 am PDT
last modified by Paul Rovner, September 19, 1983 10:33 pm
Last Edited by: Levin, September 22, 1983 10:58 am
DIRECTORY
ConvertUnsafe: TYPE USING [LS, SubString, EqualSubStrings],
PrincOpsUtils: TYPE USING [BITAND, BITXOR],
Literals: TYPE USING [Base],
Symbols: TYPE,
SymbolOps: TYPE USING [PackedSize],
SymbolSegment: TYPE USING [Base, ExtIndex, ExtRecord, FGTEntry, STHeader, ExtFirst],
Target: TYPE MachineParms USING [PackedBitCount, bitsPerAU, bitsPerLongWord, bitsPerWord],
TimeStamp: TYPE USING [Stamp],
Tree: TYPE USING [Base, Link, Null];
SymbolPack: PROGRAM
IMPORTS PrincOpsUtils, ConvertUnsafe
EXPORTS SymbolOps = {
OPEN Symbols;
SymbolTableBase: PUBLIC TYPE = POINTER TO FRAME[SymbolPack];
link: PUBLIC SymbolTableBase;
cacheInfo: PUBLIC LONG POINTER;
tables defining the current symbol table
hashVec: PUBLIC LONG POINTER TO HashVector;-- hash index
htb: PUBLIC Symbols.Base;-- hash table
ssb: PUBLIC ConvertUnsafe.LS;-- id string
seb: PUBLIC Symbols.Base;-- se table
ctxb: PUBLIC Symbols.Base;-- context table
mdb: PUBLIC Symbols.Base;-- module directory base
bb: PUBLIC Symbols.Base;-- body table
tb: PUBLIC Tree.Base;-- tree area
ltb: PUBLIC Literals.Base;-- literal area
stb: PUBLIC Literals.Base;-- string literal area
extb: PUBLIC SymbolSegment.Base;-- extension map
mdLimit: PUBLIC MDIndex;-- module directory size
extLimit: PUBLIC SymbolSegment.ExtIndex;-- extension size
mainCtx: PUBLIC CTXIndex;
stHandle: PUBLIC LONG POINTER TO SymbolSegment.STHeader;
loopholes for Symbols.UNSPEC
Card: PROC[value: Symbols.UNSPEC] RETURNS[CARD] = INLINE {RETURN[LOOPHOLE[value]]};
TypeInfo: PROC[info: Symbols.UNSPEC] RETURNS[Type] = INLINE {RETURN[LOOPHOLE[info]]};
info defining the source file links
sourceFile: PUBLIC ConvertUnsafe.LS;
fgTable: PUBLIC LONG DESCRIPTOR FOR ARRAY OF SymbolSegment.FGTEntry;
the following procedure is called if the base values change
notifier: PUBLIC PROC[SymbolTableBase];
NullNotifier: PUBLIC PROC[SymbolTableBase] = { };
hash manipulation
SubString: TYPE = ConvertUnsafe.SubString;
FindString: PUBLIC PROC[s: SubString] RETURNS[name: Name] = {
ss: SubString;
name ← hashVec[HashValue[s]];
WHILE name # nullName DO
ss ← SubStringForName[name];
IF s.EqualSubStrings[ss] THEN EXIT;
name ← htb[name].link;
ENDLOOP;
};
HashValue: PUBLIC PROC[s: SubString] RETURNS[HVIndex] = {
CharBits: PROC[CHAR, WORD] RETURNS[WORD] = LOOPHOLE[PrincOpsUtils.BITAND];
Mask: WORD = 337b;-- masks out ASCII case shifts
v: WORD = CharBits[s.base[s.offset], Mask]*177b
+ CharBits[s.base[s.offset+(s.length-1)], Mask];
RETURN[PrincOpsUtils.BITXOR[v, s.length*17b] MOD hashVec^.LENGTH]};
SubStringForName: PUBLIC PROC[name: Name] RETURNS[s: ConvertUnsafe.SubString] = {
s.base ← ssb;
IF name = nullName THEN s.offset ← s.length ← 0
ELSE s.length ← htb[name].ssIndex - (s.offset ← htb[name-HTRecord.SIZE].ssIndex)};
context management
ctxLevelSplit: NAT = (ContextLevel.LAST+1)/2;
CtxLevel: PUBLIC PROC[ctx: CTXIndex] RETURNS[ContextLevel] = {
RETURN[IF ctx = CTXNull THEN lZ ELSE ctxb[ctx].level]};
CtxEntries: PUBLIC PROC[ctx: CTXIndex] RETURNS[n: CARDINAL𡤀] = {
IF ctx = CTXNull THEN RETURN;
WITH c: ctxb[ctx] SELECT FROM
included => IF ~c.reset THEN RETURN;
ENDCASE;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO n ← n+1 ENDLOOP};
FirstCtxSe: PUBLIC PROC[ctx: CTXIndex] RETURNS[ISEIndex] = {
RETURN[IF ctx = CTXNull THEN ISENull ELSE ctxb[ctx].seList]};
NextSe: PUBLIC PROC[sei: ISEIndex] RETURNS[ISEIndex] = {
RETURN[
IF sei = ISENull
THEN ISENull
ELSE
WITH id: seb[sei] SELECT FROM
terminal => ISENull,
sequential => sei + SERecord.id.sequential.SIZE,
linked => id.link,
ENDCASE => ISENull]
};
SearchContext: PUBLIC PROC[name: Name, ctx: CTXIndex] RETURNS[ISEIndex] = {
sei, root: ISEIndex;
IF ctx # CTXNull AND name # nullName THEN {
sei ← root ← ctxb[ctx].seList;
DO
IF sei = ISENull THEN EXIT;
IF seb[sei].hash = name THEN RETURN[sei];
WITH id: seb[sei] SELECT FROM
sequential => sei ← sei + SERecord.id.sequential.SIZE;
linked => IF (sei ← id.link) = root THEN EXIT;
ENDCASE => EXIT;
ENDLOOP;
};
RETURN[ISENull]};
SeiForValue: PUBLIC PROC[value: Symbols.UNSPEC, ctx: CTXIndex] RETURNS[ISEIndex] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF seb[sei].idValue = value THEN RETURN[sei] ENDLOOP;
RETURN[ISENull]};
module management
FindMdi: PUBLIC PROC[stamp: TimeStamp.Stamp] RETURNS[MDIndex] = {
FOR mdi: MDIndex ← MDFirst, mdi + MDRecord.SIZE UNTIL mdi = mdLimit DO
IF mdb[mdi].stamp = stamp THEN RETURN[mdi] ENDLOOP;
RETURN[MDNull]};
type manipulation
ArgCtx: PUBLIC PROC[type: CSEIndex] RETURNS[CTXIndex] = {
sei: RecordSEIndex = ArgRecord[type];
RETURN[IF sei = RecordSENull THEN CTXNull ELSE seb[sei].fieldCtx]};
ArgRecord: PUBLIC PROC[type: CSEIndex] RETURNS[RecordSEIndex] = {
RETURN[
IF type = nullType
THEN RecordSENull
ELSE
WITH seb[type] SELECT FROM
record => LOOPHOLE[type, RecordSEIndex],
ENDCASE => RecordSENull]
};
ClusterSe: PUBLIC PROC[type: Type] RETURNS[Type] = {
WITH t: seb[type] SELECT FROM
id => {
next: Type = TypeInfo[t.idInfo];
RETURN[
IF t.extended
THEN type
ELSE WITH u: seb[next] SELECT FROM
id => IF t.hash = u.hash THEN ClusterSe[next] ELSE type,
ENDCASE => type]
};
ENDCASE => RETURN[type];
};
EqTypes: PUBLIC PROC[type1, type2: Type] RETURNS[BOOL] = {
RETURN[type1 = type2 OR UnderType[type1] = UnderType[type2]]};
NormalType: PUBLIC PROC[type: Type] RETURNS[nType: CSEIndex] = {
sei: CSEIndex = UnderType[type];
RETURN[
WITH t: seb[sei] SELECT FROM
subrange => NormalType[t.rangeType],
long, real => NormalType[t.rangeType],
ENDCASE => sei]
};
RecordLink: PUBLIC PROC[type: RecordSEIndex] RETURNS[RecordSEIndex] = {
RETURN[
WITH t: seb[type] SELECT FROM
linked => LOOPHOLE[UnderType[t.linkType], RecordSEIndex],
ENDCASE => RecordSENull]
};
RecordRoot: PUBLIC PROC[type: RecordSEIndex] RETURNS[root: RecordSEIndex] = {
next: RecordSEIndex;
root ← type;
WHILE (next ← RecordLink[root]) # RecordSENull DO root ← next ENDLOOP};
ReferentType: PUBLIC PROC[type: Type] RETURNS[Type] = {
sei: CSEIndex = NormalType[type];
RETURN[
WITH t: seb[sei] SELECT FROM
ref => t.refType,
ENDCASE => typeANY]
};
TransferTypes: PUBLIC PROC[type: Type] RETURNS[typeIn, typeOut: RecordSEIndex] = {
sei: CSEIndex = UnderType[type];
WITH t: seb[sei] SELECT FROM
transfer => RETURN[typeIn: ArgRecord[t.typeIn], typeOut: ArgRecord[t.typeOut]];
ENDCASE;
RETURN[RecordSENull, RecordSENull]};
TypeForm: PUBLIC PROC[type: Type] RETURNS[TypeClass] = {
RETURN[IF type = nullType THEN $nil ELSE seb[UnderType[type]].typeTag]};
TypeLink: PUBLIC PROC[type: Type] RETURNS[Type] = {
sei: CSEIndex = UnderType[type];
RETURN[
WITH se: seb[sei] SELECT FROM
record => WITH se SELECT FROM linked => linkType, ENDCASE => nullType,
ENDCASE => nullType]
};
TypeRoot: PUBLIC PROC[type: Type] RETURNS[root: Type] = {
next: Type;
root ← type;
WHILE (next ← TypeLink[root]) # nullType DO root ← next ENDLOOP};
UnderType: PUBLIC PROC[type: Type] RETURNS[CSEIndex] = {
sei: Type ← type;
WHILE sei # nullType DO
WITH se: seb[sei] SELECT FROM
id => {IF se.idType # typeTYPE THEN ERROR; sei ← TypeInfo[se.idInfo]};
ENDCASE => EXIT;
ENDLOOP;
RETURN[LOOPHOLE[sei, CSEIndex]]};
XferMode: PUBLIC PROC[type: Type] RETURNS[TransferMode] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM transfer => t.mode, ENDCASE => $none]};
information returning procedures
bitsPerAU: CARDINAL = Target.bitsPerAU;
bitsPerWord: CARDINAL = Target.bitsPerWord;
bitsPerLongWord: CARDINAL = Target.bitsPerLongWord;
unitFill: CARDINAL = bitsPerAU-1;
AUsForType: PUBLIC PROC[type: Type] RETURNS[CARD] = {
sei: CSEIndex = UnderType[type];
b: BitCount;
itemsPerAU: ARRAY Target.PackedBitCount OF [0..bitsPerAU] = [16, 8, 4, 4, 2, 2, 2, 2];
RETURN[
IF sei = CSENull
THEN 0
ELSE
WITH t: seb[sei] SELECT FROM
mode => 1,-- fudge for compiler (Pass4.Binding)
basic => (t.length + unitFill)/bitsPerAU,
enumerated => IF t.empty THEN 0 ELSE bitsPerWord/bitsPerAU,
record => (t.length + unitFill)/bitsPerAU,
ref => bitsPerWord/bitsPerAU,
array =>
IF (b𡤋itsPerElement[t.componentType, t.packed])#0
AND b<=Target.PackedBitCount.LAST
b IN PackedBitCount
THEN (Cardinality[t.indexType] + (itemsPerAU[b]-1))/itemsPerAU[b]
ELSE Cardinality[t.indexType] * ((b+unitFill)/bitsPerAU),
arraydesc => 2*(bitsPerWord/bitsPerAU),
transfer => (IF t.mode = port THEN 2 ELSE 1)*(bitsPerWord/bitsPerAU),
relative => AUsForType[t.offsetType],
opaque => (t.length + unitFill)/bitsPerAU,
zone => (IF t.mds THEN 1 ELSE 2)*(bitsPerWord/bitsPerAU),
subrange => IF t.empty THEN 0 ELSE bitsPerWord/bitsPerAU,
long =>
AUsForType[t.rangeType] + (bitsPerLongWord-bitsPerWord)/bitsPerAU,
real => bitsPerLongWord/bitsPerAU,
ENDCASE => 0
]
};
BitsForRange: PUBLIC PROC[maxValue: CARD] RETURNS[nBits: CARD] = {
fieldMax: CARD;
nBits ← 1; fieldMax ← 1;
WHILE nBits < bitsPerWord AND fieldMax < maxValue DO
nBits ← nBits + 1; fieldMax ← 2*fieldMax + 1 ENDLOOP
};
BitsForType: PUBLIC PROC[type: Type] RETURNS[BitCount] = {
n: BitCount;
sei: CSEIndex = UnderType[type];
RETURN[
IF sei = CSENull
THEN 0
ELSE
WITH t: seb[sei] SELECT FROM
basic => t.length,
enumerated => IF t.empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1],
record => t.length,
array =>
IF (n𡤋itsPerElement[t.componentType, t.packed]*Cardinality[t.indexType])
> bitsPerAU
THEN ((n + unitFill)/bitsPerAU)*bitsPerAU
ELSE n,
opaque => t.length,
relative => BitsForType[t.offsetType],
subrange => IF t.empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1],
ENDCASE => AUsForType[sei]*bitsPerAU]
};
BitsPerElement: PUBLIC PROC[type: Type, packed: BOOL] RETURNS[BitCount] = {
nBits: BitCount = BitsForType[type];
RETURN[
IF packed AND (nBits#0 AND nBits<=Target.PackedBitCount.LAST) -- IN PackedBitCount
THEN SymbolOps.PackedSize[nBits]
ELSE (nBits+unitFill)/bitsPerAU * bitsPerAU]
};
Cardinality: PUBLIC PROC[type: Type] RETURNS[CARD] = {
sei: CSEIndex = UnderType[type];
RETURN[
WITH t: seb[sei] SELECT FROM
enumerated => IF t.empty THEN 0 ELSE t.range+1,
subrange => IF t.empty THEN 0 ELSE t.range+1,
basic => IF t.code = codeCHAR THEN 256 ELSE 0,
relative => Cardinality[t.offsetType],
ENDCASE => 0]
};
FindExtension: PUBLIC PROC[sei: ISEIndex] RETURNS[type: ExtensionType, tree: Tree.Link] = {
OPEN SymbolSegment;
FOR exti: ExtIndex ← ExtFirst, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
IF extb[exti].sei = sei THEN RETURN[extb[exti].type, extb[exti].tree];
ENDLOOP;
RETURN[$none, Tree.Null]};
FnField: PUBLIC PROC[field: ISEIndex] RETURNS[offset: BitAddress, size: BitCount] = {
au, nu: CARD;
au ← 0;
FOR sei: ISEIndex ← FirstCtxSe[seb[field].idCtx], NextSe[sei] DO
nu ← AUsForType[seb[sei].idType];
IF sei = field THEN EXIT;
au ← au + nu;
ENDLOOP;
RETURN[offset: BitAddress[au*bitsPerAU], size: nu*bitsPerAU]};
NameForSe: PUBLIC PROC[sei: ISEIndex] RETURNS[Name] = {
RETURN[IF sei = ISENull THEN nullName ELSE seb[sei].hash]};
LinkMode: PUBLIC PROC[sei: ISEIndex] RETURNS[Linkage] = {
RETURN[
IF seb[sei].idType = typeTYPE
THEN (IF TypeForm[TypeInfo[seb[sei].idInfo]]=$opaque THEN $type ELSE $manifest)
ELSE
SELECT XferMode[seb[sei].idType] FROM
$proc, $program =>
IF seb[sei].constant
THEN (IF seb[sei].extended THEN $val ELSE $manifest)
ELSE $val,
$signal, $error => IF seb[sei].constant THEN $manifest ELSE $val,
ENDCASE => IF seb[sei].constant THEN $manifest ELSE $ref
]
};
RecField: PUBLIC PROC[field: ISEIndex] RETURNS[offset: BitAddress, size: BitCount] = {
RETURN[offset: [bd: Card[seb[field].idValue]], size: Card[seb[field].idInfo]]};
RCType: PUBLIC PROC[type: Type] RETURNS[RefClass] = {
next: Type;
struc: RefClass ← $simple;
FOR tv: Type ← type, next DO
sei: CSEIndex = UnderType[tv];
WITH t: seb[sei] SELECT FROM
record =>
SELECT TRUE FROM
~t.hints.refField => RETURN[$none];
t.hints.unifield => next ← seb[ctxb[t.fieldCtx].seList].idType;
ENDCASE => RETURN[$composite];
ref => RETURN[IF t.counted THEN struc ELSE $none];
array => {struc ← $composite; next ← t.componentType};
relative => next ← t.offsetType;
subrange => next ← t.rangeType;
long => next ← t.rangeType;
union => RETURN[IF t.hints.refField THEN $composite ELSE $none];
sequence => {struc ← $composite; next ← t.componentType};
zone => RETURN[IF t.counted THEN struc ELSE $none];
ENDCASE => RETURN[$none];
ENDLOOP;
};
VariantField: PUBLIC PROC[type: CSEIndex] RETURNS[sei: ISEIndex] = {
WITH t: seb[type] SELECT FROM
record =>
FOR sei ← FirstCtxSe[t.fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
SELECT TypeForm[seb[sei].idType] FROM
$sequence, $union => EXIT;
ENDCASE;
ENDLOOP;
ENDCASE => sei ← ISENull;
};
body table management
ParentBti: PUBLIC PROC[bti: BTIndex] RETURNS[BTIndex] = {
UNTIL bb[bti].link.which = $parent DO bti ← bb[bti].link.index ENDLOOP;
RETURN[bb[bti].link.index]};
SiblingBti: PUBLIC PROC[bti: BTIndex] RETURNS[BTIndex] = {
RETURN[IF bb[bti].link.which = $sibling THEN bb[bti].link.index ELSE BTNull]};
SonBti: PUBLIC PROC[bti: BTIndex] RETURNS[BTIndex] = {RETURN[bb[bti].firstSon]};
EnumerateBodies: PUBLIC PROC[root: BTIndex, proc: PROC[BTIndex] RETURNS[stop: BOOL]]
RETURNS[bti: BTIndex] = {
prev: BTIndex;
bti ← root;
UNTIL bti = BTNull DO
IF proc[bti] THEN GO TO Stopped;
IF bb[bti].firstSon # BTNull THEN bti ← bb[bti].firstSon
ELSE
DO
IF bti = root THEN GO TO Done;
prev ← bti; bti ← bb[bti].link.index;
IF bb[prev].link.which # $parent THEN EXIT;
ENDLOOP;
REPEAT
Stopped => NULL;
Done => bti ← BTNull;
ENDLOOP;
};
}.