
<<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_0] = {
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_BitsPerElement[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_BitsPerElement[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;
};

}.

