<> <> <> <> 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; <<>> <> <<>> 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; <<>> <> <<>> sourceFile: PUBLIC ConvertUnsafe.LS; fgTable: PUBLIC LONG DESCRIPTOR FOR ARRAY OF SymbolSegment.FGTEntry; <<>> <> <<>> notifier: PUBLIC PROC[SymbolTableBase]; NullNotifier: PUBLIC PROC[SymbolTableBase] = { }; <<>> <> <<>> 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)}; <<>> <> <<>> 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_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: 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]}; <<>> <> <<>> 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]}; <<>> <> <<>> 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]}; <<>> <> <<>> 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_BitsPerElement[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_BitsPerElement[t.componentType, t.packed])#0 AND b<=PackedBitCount.LAST <> 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 ] }; <<>> <> <<>> 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; }; }.