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;
};