file SymbolPack.mesa
last modified by Satterthwaite, April 16, 1986 3:46:51 pm PST
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],
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
ht: PUBLIC LONG DESCRIPTOR FOR ARRAY Name OF HTRecord; -- 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
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;
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 ← ht[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 ← ht[name].ssIndex - (s.offset ← ht[name-1].ssIndex)};
context management
ctxLevelSplit: NAT = (ContextLevel.LAST+1)/2;
CtxLevel:
PUBLIC PROC[ctx: CTXIndex]
RETURNS[ContextLevel] = {
RETURN[
IF ctx = CTXNull
THEN lZ
ELSE ctxLevelSplit*ctxb[ctx].levelOrigin + ctxb[ctx].levelOffset]
};
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:
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:
PUBLIC
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:
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 = 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 ← 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
wordFill: CARDINAL = WordLength-1;
Untruncate:
PROC[n:
CARDINAL]
RETURNS[
LONG
CARDINAL] = {
RETURN[IF n=0 THEN CARDINAL.LAST.LONG+1 ELSE n]};
BitsForRange:
PUBLIC
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:
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])
> 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:
PUBLIC
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:
PUBLIC
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:
PUBLIC
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:
PUBLIC
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:
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[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: FieldBitCount] = {
RETURN[offset: seb[field].idValue, size: 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;
};
WordsForType:
PUBLIC
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:
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;
};