file SymbolPack.mesa
last modified by Satterthwaite, February 17, 1983 4:05 pm
last modified by Paul Rovner, September 19, 1983 10:33 pm
Last Edited by: Levin, September 22, 1983 10:58 am
DIRECTORY
ConvertUnsafe USING [LS, SubString, EqualSubStrings],
PrincOpsUtils USING [BITAND, BITXOR],
Literals USING [Base],
Symbols,
SymbolOps USING [PackedSize],
SymbolSegment USING [Base, ExtIndex, ExtRecord, FGTEntry, STHeader],
TimeStamp USING [Stamp],
Tree USING [Base, Link, Null];
SymbolPack: PROGRAM
IMPORTS PrincOpsUtils, ConvertUnsafe
EXPORTS SymbolOps =
PUBLIC {OPEN Symbols;
SymbolTableBase: TYPE = POINTER TO FRAME[SymbolPack];
link: SymbolTableBase;
cacheInfo: LONG POINTER;
tables defining the current symbol table
hashVec: LONG POINTER TO HashVector;  -- hash index
ht: LONG DESCRIPTOR FOR ARRAY Name OF HTRecord; -- hash table
ssb: ConvertUnsafe.LS;  -- id string
seb: Symbols.Base;   -- se table
ctxb: Symbols.Base;   -- context table
mdb: Symbols.Base;   -- module directory base
bb: Symbols.Base;   -- body table
tb: Tree.Base;   -- tree area
ltb: Literals.Base;   -- literal area
extb: SymbolSegment.Base;  -- extension map
mdLimit: MDIndex;   -- module directory size
extLimit: SymbolSegment.ExtIndex; -- extension size
mainCtx: CTXIndex;
stHandle: LONG POINTER TO SymbolSegment.STHeader;
info defining the source file links
sourceFile: ConvertUnsafe.LS;
fgTable: LONG DESCRIPTOR FOR ARRAY OF SymbolSegment.FGTEntry;
the following procedure is called if the base values change
notifier: PROC [SymbolTableBase];
NullNotifier: PROC [SymbolTableBase] = { };
hash manipulation
SubString: TYPE = ConvertUnsafe.SubString;
FindString: PROC [s: SubString] RETURNS [name: Name] = {
ss: SubString;
name ← hashVec[HashValue[s]];
WHILE name # nullName DO
ss ← SubStringForName[name];
IF ConvertUnsafe.EqualSubStrings[s, ss] THEN EXIT;
name ← ht[name].link;
ENDLOOP;
};
HashValue: 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: PROC [name: Name] RETURNS[s: ConvertUnsafe.SubString] = {
s.base ← ssb;
IF name = nullName THEN s.offset ← s.length ← 0
ELSE s.length ← ht[name].ssIndex - (s.offset ← ht[name-1].ssIndex);
};
context management
CtxEntries: 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: PROC [ctx: CTXIndex] RETURNS [ISEIndex] = {
RETURN [IF ctx = CTXNull THEN ISENull ELSE ctxb[ctx].seList]};
NextSe: 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: 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: PROC [value: CARDINAL, 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: PROC [stamp: TimeStamp.Stamp] RETURNS [MDIndex] = {
FOR mdi: MDIndex ← MDIndex.FIRST, mdi + MDRecord.SIZE UNTIL mdi = mdLimit DO
IF mdb[mdi].stamp = stamp THEN RETURN [mdi] ENDLOOP;
RETURN [MDNull];
};
type manipulation
ArgCtx: PROC [type: CSEIndex] RETURNS [CTXIndex] = {
sei: RecordSEIndex = ArgRecord[type];
RETURN [IF sei = RecordSENull THEN CTXNull ELSE seb[sei].fieldCtx];
};
ArgRecord: PROC [type: CSEIndex] RETURNS [RecordSEIndex] = {
RETURN [
IF type = nullType
THEN RecordSENull
ELSE
WITH seb[type] SELECT FROM
record => LOOPHOLE[type, RecordSEIndex],
ENDCASE => RecordSENull];
};
ClusterSe: PROC [type: Type] RETURNS [Type] = {
WITH t: seb[type] SELECT FROM
id => {
next: Type = 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];
};
NormalType: PROC [type: CSEIndex] RETURNS [nType: CSEIndex] = {
RETURN [
WITH t: seb[type] SELECT FROM
subrange => NormalType[UnderType[t.rangeType]],
long, real => NormalType[UnderType[t.rangeType]],
ENDCASE => type
];
};
RecordLink: PROC [type: RecordSEIndex] RETURNS [RecordSEIndex] = {
RETURN [
WITH t: seb[type] SELECT FROM
linked => LOOPHOLE[UnderType[t.linkType], RecordSEIndex],
ENDCASE => RecordSENull
]};
RecordRoot: PROC [type: RecordSEIndex] RETURNS [root: RecordSEIndex] = {
next: RecordSEIndex;
root ← type;
WHILE (next ← RecordLink[root]) # RecordSENull DO root ← next ENDLOOP;
};
ReferentType: PROC [type: CSEIndex] RETURNS [CSEIndex] = {
sei: CSEIndex = NormalType[type];
RETURN [
WITH t: seb[sei] SELECT FROM
ref => UnderType[t.refType],
ENDCASE => typeANY
]};
TransferTypes: 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: PROC [type: Type] RETURNS [TypeClass] = {
RETURN [IF type = nullType THEN $nil ELSE seb[UnderType[type]].typeTag];
};
TypeLink: 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: PROC [type: Type] RETURNS [root: Type] = {
next: Type;
root ← type;
WHILE (next ← TypeLink[root]) # nullType DO root ← next ENDLOOP;
};
UnderType: 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 ← se.idInfo};
ENDCASE => EXIT;
ENDLOOP;
RETURN [LOOPHOLE[sei, CSEIndex]];
};
XferMode: PROC [type: Type] RETURNS [TransferMode] = {
sei: CSEIndex = UnderType[type];
RETURN [WITH t: seb[sei] SELECT FROM transfer => t.mode, ENDCASE => $none];
};
information returning procedures
wordFill: CARDINAL = WordLength-1;
Untruncate: PRIVATE PROC [n: CARDINAL] RETURNS [LONG CARDINAL] = {
RETURN [IF n=0 THEN CARDINAL.LAST.LONG+1 ELSE n]};
BitsForRange: PROC [maxValue: CARDINAL] RETURNS [nBits: CARDINAL] = {
fieldMax: CARDINAL;
nBits ← 1; fieldMax ← 1;
WHILE nBits < WordLength AND fieldMax < maxValue DO
nBits ← nBits + 1; fieldMax ← 2*fieldMax + 1 ENDLOOP;
};
BitsForType: 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])
> WordLength
THEN ((n + wordFill)/WordLength)*WordLength
ELSE n,
opaque => t.length,
relative => BitsForType[t.offsetType],
subrange => IF t.empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1],
ENDCASE => WordsForType[sei]*WordLength];
};
BitsPerElement: PROC [type: Type, packed: BOOL] RETURNS [BitCount] = {
nBits: BitCount = BitsForType[type];
RETURN [
IF packed AND (nBits#0 AND nBits<=PackedBitCount.LAST) -- IN PackedBitCount
THEN SymbolOps.PackedSize[PackedBitCount[nBits]]
ELSE (nBits+wordFill)/WordLength * WordLength
];
};
Cardinality: PROC [type: Type] RETURNS [LONG CARDINAL] = {
sei: CSEIndex = UnderType[type];
RETURN [
WITH t: seb[sei] SELECT FROM
enumerated => IF t.empty THEN 0 ELSE Untruncate[t.nValues], -- compatibility hack
subrange => IF t.empty THEN 0 ELSE t.range.LONG+1,
basic => IF t.code = codeCHAR THEN 256 ELSE 0,
relative => Cardinality[t.offsetType],
ENDCASE => 0];
};
FindExtension: PROC [sei: ISEIndex] RETURNS [type: ExtensionType, tree: Tree.Link] = {
OPEN SymbolSegment;
FOR exti: ExtIndex ← ExtIndex.FIRST, 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: PROC [field: ISEIndex] RETURNS [offset: BitAddress, size: FieldBitCount] = {
word, nW: CARDINAL;
word ← 0;
FOR sei: ISEIndex ← FirstCtxSe[seb[field].idCtx], NextSe[sei] DO
nW ← CARDINAL[WordsForType[seb[sei].idType]];
IF sei = field THEN EXIT;
word ← word + nW;
ENDLOOP;
RETURN [offset: BitAddress[wd:word, bd:0], size: nW * WordLength];
};
NameForSe: PROC [sei: ISEIndex] RETURNS [Name] = {
RETURN [IF sei = ISENull THEN nullName ELSE seb[sei].hash]};
LinkMode: PROC [sei: ISEIndex] RETURNS [Linkage] = {
RETURN [
IF seb[sei].idType = typeTYPE
THEN (IF TypeForm[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: PROC [field: ISEIndex] RETURNS [offset: BitAddress, size: FieldBitCount] = {
RETURN [offset: seb[field].idValue, size: seb[field].idInfo]};
RCType: PROC [type: CSEIndex] RETURNS [RefClass] = {
next: Type;
struc: RefClass ← $simple;
FOR sei: CSEIndex ← type, UnderType[next] DO
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: 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;
};
WordsForType: PROC [type: Type] RETURNS [WordCount] = {
sei: CSEIndex = UnderType[type];
b: BitCount;
itemsPerWord: ARRAY PackedBitCount OF [0..16] = [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 + wordFill)/WordLength,
enumerated => IF t.empty THEN 0 ELSE 1,
record => (t.length.LONG + wordFill)/WordLength,
ref => 1,
array =>
IF (b𡤋itsPerElement[t.componentType, t.packed])#0
AND b<=PackedBitCount.LAST
b IN PackedBitCount
THEN (Cardinality[t.indexType] + (itemsPerWord[b]-1))/itemsPerWord[b]
ELSE Cardinality[t.indexType] * ((b+wordFill)/WordLength),
arraydesc => 2,
transfer => IF t.mode = port THEN 2 ELSE 1,
relative => WordsForType[t.offsetType],
opaque => (t.length.LONG + wordFill)/WordLength,
zone => (IF t.mds THEN 1 ELSE 2),
subrange => IF t.empty THEN 0 ELSE 1,
long => WordsForType[t.rangeType] + 1,
real => 2,
ENDCASE => 0
];
};
body table management
ParentBti: PROC [bti: BTIndex] RETURNS [BTIndex] = {
UNTIL bb[bti].link.which = $parent DO bti ← bb[bti].link.index ENDLOOP;
RETURN [bb[bti].link.index];
};
SiblingBti: PROC [bti: BTIndex] RETURNS [BTIndex] = {
RETURN [IF bb[bti].link.which = $sibling THEN bb[bti].link.index ELSE BTNull]};
SonBti: PROC [bti: BTIndex] RETURNS [BTIndex] = {RETURN [bb[bti].firstSon]};
EnumerateBodies: 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;
};
}.