<> <> <> <> <> <> DIRECTORY Alloc USING [Handle, Index, Notifier, AddNotify, Bounds, DropNotify, Top, Words], ConvertUnsafe USING [AppendSubString, EqualSubStrings, LS, SubString], Symbols USING [Base, ExtensionType, HashVector, HVIndex, HTRecord, HTIndex, Name, SERecord, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CTXRecord, MDIndex, BTIndex, nullName, HTNull, ISENull, CSENull, CTXNull, BTNull, ByteLength, lG, lL, lZ, typeANY, typeTYPE, WordLength, htType, ssType, seType, ctxType, mdType, bodyType], SymbolOps USING [CtxEntries, FindExtension, FirstCtxSe, HashValue, NextSe, ParentBti, SubStringForName, TypeForm, XferMode], SymbolPack, SymbolSegment USING [Base, ExtIndex, ExtRecord, extType, ltType, treeType], Tree USING [Base, Link, Map, Null], UnsafeStorage USING [GetSystemUZone]; SymbolPackExt: PROGRAM IMPORTS Alloc, ConvertUnsafe, SymbolOps, own: SymbolPack, UnsafeStorage EXPORTS SymbolOps = { OPEN SymbolOps, Symbols; charsPerWord: NAT = Symbols.WordLength/Symbols.ByteLength; SubString: TYPE = ConvertUnsafe.SubString; <> ssw: Alloc.Index; <> table: Alloc.Handle; hashVec: LONG POINTER TO HashVector; ht: LONG DESCRIPTOR FOR ARRAY Name OF HTRecord; htb: Symbols.Base; -- hash table ssb: LONG STRING; -- id string seb: Symbols.Base; -- se table ctxb: Symbols.Base; -- context table mdb: Symbols.Base; -- module directory base bb: Symbols.Base; -- body table extb: SymbolSegment.Base; -- extension table UpdateBases: Alloc.Notifier = { <> own.hashVec _ hashVec; htb _ base[htType]; own.ssb _ ssb _ LOOPHOLE[base[ssType], ConvertUnsafe.LS]; own.ht _ ht _ DESCRIPTOR[htb, ht.LENGTH]; own.seb _ seb _ base[seType]; own.ctxb _ ctxb _ base[ctxType]; own.mdb _ mdb _ base[mdType]; own.bb _ bb _ base[bodyType]; own.tb _ base[SymbolSegment.treeType]; own.ltb _ base[SymbolSegment.ltType]; own.extb _ extb _ base[SymbolSegment.extType]; own.notifier[own]}; initialized: BOOL _ FALSE; Initialize: PUBLIC PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = { <> IF initialized THEN Finalize[]; hashVec^ _ ALL[HTNull]; own.notifier _ own.NullNotifier; own.mdLimit _ MDIndex.FIRST; own.extLimit _ SymbolSegment.ExtIndex.FIRST; own.mainCtx _ CTXNull; own.stHandle _ NIL; own.sourceFile _ NIL; ht _ NIL; table _ ownTable; table.AddNotify[UpdateBases]; ssw _ table.Words[ssType, TEXT[0].SIZE] + TEXT[0].SIZE; ssb^ _ StringBody[length: 0, maxlength: 0, text:]; IF AllocateHash[] # nullName THEN ERROR; IF MakeNonCtxSe[SERecord.cons.nil.SIZE] # CSENull THEN ERROR; seb[CSENull] _ SERecord[mark3: FALSE, mark4: FALSE, body: cons[nil[]]]; IF MakeNonCtxSe[SERecord.cons.mode.SIZE] # typeTYPE THEN ERROR; seb[typeTYPE] _ SERecord[mark3: TRUE, mark4: TRUE, body: cons[mode[]]]; IF table.Words[ctxType, CTXRecord.nil.SIZE] # CTXNull THEN ERROR; ctxb[CTXNull] _ CTXRecord[FALSE, FALSE, ISENull, lZ, nil[]]; initialized _ TRUE; }; Reset: PUBLIC PROC = { nC: CARDINAL = (table.Bounds[ssType].size - TEXT[0].SIZE)*charsPerWord; desc: SubString; hvi: HVIndex; htLimit: HTIndex = table.Bounds[htType].size/HTRecord.SIZE; ssw _ table.Top[ssType]; ssb^ _ StringBody[length: ht[htLimit-1].ssIndex, maxlength: nC, text:]; own.ht _ ht _ DESCRIPTOR[htb, htLimit]; hashVec^ _ ALL[HTNull]; FOR hti: HTIndex IN (HTNull .. htLimit) DO desc _ SubStringForName[hti]; hvi _ HashValue[desc]; ht[hti].link _ hashVec[hvi]; hashVec[hvi] _ hti; ht[hti].anyInternal _ ht[hti].anyPublic _ FALSE; ENDLOOP; own.mdLimit _ table.Top[mdType]; own.extLimit _ table.Top[SymbolSegment.extType]}; Finalize: PUBLIC PROC = { table.DropNotify[UpdateBases]; table _ NIL; initialized _ FALSE}; <> EnterString: PUBLIC PROC [s: SubString] RETURNS [name: Name] = { hvi: HVIndex = HashValue[s]; desc: SubString; offset, length, nw: CARDINAL; ssi: Alloc.Index; FOR name _ hashVec[hvi], ht[name].link UNTIL name = nullName DO desc _ SubStringForName[name]; IF ConvertUnsafe.EqualSubStrings[s, desc] THEN RETURN [name]; ENDLOOP; offset _ ssb.length; length _ s.length; nw _ (offset+length+(charsPerWord-1) - ssb.maxlength)/charsPerWord; IF nw # 0 THEN { IF (ssi _ table.Words[ssType, nw]) # ssw THEN ERROR; ssw _ ssw + nw; ssb^ _ StringBody[length: offset, maxlength: ssb.maxlength + nw*charsPerWord, text:]; }; ConvertUnsafe.AppendSubString[to: ssb, from: s]; name _ AllocateHash[]; ht[name].link _ hashVec[hvi]; hashVec[hvi] _ name; RETURN; }; AllocateHash: PROC RETURNS [HTIndex] = { hti: HTIndex = ht.LENGTH; [] _ table.Words[htType, HTRecord.SIZE]; own.ht _ ht _ DESCRIPTOR[htb, ht.LENGTH+1]; ht[hti] _ HTRecord[ anyInternal: FALSE, anyPublic: FALSE, link: HTNull, ssIndex: ssb.length]; RETURN [hti]}; HashBlock: PUBLIC PROC RETURNS [LONG POINTER TO HashVector] = { RETURN [hashVec]}; <> StaticNestError: PUBLIC SIGNAL = CODE; NextLevel: PUBLIC PROC [cl: ContextLevel] RETURNS [nl: ContextLevel] = { IF cl+1 < ContextLevel.LAST THEN nl _ cl+1 ELSE {SIGNAL StaticNestError; nl _ cl}; RETURN}; BlockLevel: PUBLIC PROC [cl: ContextLevel] RETURNS [nl: ContextLevel] = { RETURN [IF cl = lG THEN lL ELSE cl]}; <> Circular: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE { RETURN [WITH c:ctxb[ctx] SELECT FROM included=> ~c.reset, ENDCASE=> FALSE]}; NewCtx: PUBLIC PROC [level: ContextLevel] RETURNS [ctx: CTXIndex] = { <> ctx _ table.Words[ctxType, CTXRecord.simple.SIZE]; ctxb[ctx] _ [ rePainted: FALSE, varUpdated: FALSE, seList: ISENull, level: level, extension: simple[ctxNew: CTXNull]]; RETURN}; SetMainCtx: PUBLIC PROC [ctx: CTXIndex] = {own.mainCtx _ ctx}; ResetCtxList: PUBLIC PROC [ctx: CTXIndex] = { <> sei: ISEIndex = ctxb[ctx].seList; IF sei # ISENull THEN {ctxb[ctx].seList _ NextSe[sei]; SetSeLink[sei, ISENull]}}; FirstVisibleSe: PUBLIC PROC [ctx: CTXIndex] RETURNS [sei: ISEIndex] = { sei _ ctxb[ctx].seList; WHILE sei # ISENull AND seb[sei].idCtx # ctx DO sei _ NextSe[sei] ENDLOOP; RETURN}; NextVisibleSe: PUBLIC PROC [sei: ISEIndex] RETURNS [next: ISEIndex] = { IF (next _ sei) # ISENull THEN UNTIL (next _ NextSe[next]) = ISENull OR seb[next].idCtx = seb[sei].idCtx DO NULL ENDLOOP; RETURN}; VisibleCtxEntries: PUBLIC PROC [ctx: CTXIndex] RETURNS [n: CARDINAL _ 0] = { IF ctx = CTXNull OR Circular[ctx] THEN RETURN; FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF seb[sei].idCtx = ctx THEN n _ n+1 ENDLOOP; RETURN}; ContextVariant: PUBLIC PROC [ctx: CTXIndex] RETURNS [sei: ISEIndex] = { FOR sei _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO IF TypeForm[seb[sei].idType] = union THEN RETURN ENDLOOP; RETURN [ISENull]}; <> MakeSeChain: PUBLIC PROC [ctx: CTXIndex, n: CARDINAL, linked: BOOL] RETURNS [seChain: ISEIndex] = { sei: ISEIndex; IF n = 0 THEN RETURN [ISENull]; seChain _ table.Words[seType, (n-1)*SERecord.id.sequential.SIZE + (IF linked THEN SERecord.id.linked.SIZE ELSE SERecord.id.terminal.SIZE)]; sei _ seChain; THROUGH [1..n) DO seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,sequential[]]]; sei _ sei + SERecord.id.sequential.SIZE; ENDLOOP; IF linked THEN seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,linked[ISENull]]] ELSE seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,terminal[]]]; RETURN}; MakeCtxSe: PUBLIC PROC [name: Name, ctx: CTXIndex] RETURNS [sei: ISEIndex] = { next, pSei: ISEIndex; sei _ table.Words[seType, SERecord.id.linked.SIZE]; SELECT TRUE FROM (ctx = CTXNull) => next _ ISENull; Circular[ctx] => { pSei _ ctxb[ctx].seList; IF pSei = ISENull THEN next _ sei ELSE {next _ NextSe[pSei]; SetSeLink[pSei, sei]}; ctxb[ctx].seList _ sei}; ENDCASE => { pSei _ ctxb[ctx].seList; IF pSei = ISENull THEN {next _ ISENull; ctxb[ctx].seList _ sei} ELSE { UNTIL (next _ NextSe[pSei]) = ISENull DO pSei _ next ENDLOOP; SetSeLink[pSei, sei]}}; seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,name,,linked[link: next]]]; RETURN}; NameClash: PUBLIC SIGNAL [name: Name] = CODE; FillCtxSe: PUBLIC PROC [sei: ISEIndex, name: Name, public: BOOL] = { ctx: CTXIndex = seb[sei].idCtx; seb[sei].hash _ name; IF name # nullName THEN { IF ht[name].anyInternal AND ctx # CTXNull THEN FOR pSei: ISEIndex _ FirstCtxSe[ctx], NextSe[pSei] UNTIL pSei = sei DO IF seb[pSei].hash = name THEN {SIGNAL NameClash[name]; EXIT}; ENDLOOP; ht[name].anyInternal _ TRUE; IF public THEN ht[name].anyPublic _ TRUE}}; EnterExtension: PUBLIC PROC [sei: ISEIndex, type: ExtensionType, tree: Tree.Link] = { OPEN SymbolSegment; exti: ExtIndex; extLimit: ExtIndex = own.extLimit; FOR exti _ ExtIndex.FIRST, exti + ExtRecord.SIZE UNTIL exti = extLimit DO IF extb[exti].sei = sei THEN GO TO Update; REPEAT Update => extb[exti] _ ExtRecord[sei:sei, type:type, tree:tree]; FINISHED => IF tree # Tree.Null THEN { exti _ table.Words[extType, ExtRecord.SIZE]; own.extLimit _ own.extLimit + ExtRecord.SIZE; extb[exti] _ ExtRecord[sei:sei, type:type, tree:tree]}; ENDLOOP; seb[sei].extended _ TRUE}; SetSeLink: PUBLIC PROC [sei, next: ISEIndex] = { WITH seb[sei] SELECT FROM linked => link _ next; ENDCASE => ERROR}; MakeNonCtxSe: PUBLIC PROC [size: CARDINAL] RETURNS [sei: CSEIndex] = { sei _ table.Words[seType, size]; seb[sei] _ [mark3: FALSE, mark4: FALSE, body: cons[typeInfo: ]]; RETURN}; <> CopyBasicType: PUBLIC PROC [type: CSEIndex] RETURNS [copy: CSEIndex] = { WITH master: seb[type] SELECT FROM basic => { copy _ MakeNonCtxSe[SERecord.cons.basic.SIZE]; seb[copy] _ SERecord[ mark3: master.mark3, mark4: master.mark4, body: cons[basic[ code: master.code, ordered: master.ordered, length: master.length]]]} ENDCASE => copy _ typeANY; RETURN}; CopyXferType: PUBLIC PROC [type: CSEIndex, mapper: Tree.Map] RETURNS [copy: CSEIndex] = { WITH master: seb[type] SELECT FROM transfer => { copy _ MakeNonCtxSe[SERecord.cons.transfer.SIZE]; seb[copy] _ SERecord[ mark3: master.mark3, mark4: master.mark4, body: cons[transfer[ mode: master.mode, safe: master.safe, typeIn: CopyArgs[master.typeIn, NIL], typeOut: CopyArgs[master.typeOut, mapper]]]]}; ENDCASE => copy _ typeANY; RETURN}; CopyArgSe: PUBLIC PROC [copy, master: ISEIndex] = {CopyArg[copy, master, NIL]}; CopyArgs: PROC [args: CSEIndex, mapper: Tree.Map] RETURNS [copy: CSEIndex] = { IF args = CSENull THEN copy _ CSENull ELSE WITH t: seb[args] SELECT FROM record => { ctx1: CTXIndex = t.fieldCtx; ctx2: CTXIndex = NewCtx[ctxb[ctx1].level]; seChain: ISEIndex = MakeSeChain[ctx2, CtxEntries[ctx1], FALSE]; sei1: ISEIndex _ ctxb[ctx1].seList; sei2: ISEIndex _ ctxb[ctx2].seList _ seChain; UNTIL sei1 = ISENull DO CopyArg[sei2, sei1, mapper]; sei1 _ NextSe[sei1]; sei2 _ NextSe[sei2]; ENDLOOP; copy _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]; seb[copy] _ SERecord[mark3: t.mark3, mark4: t.mark4, body: cons[ record[ machineDep: FALSE, painted: t.painted, argument: TRUE, hints: t.hints, fieldCtx: ctx2, length: t.length, monitored: FALSE, linkPart: notLinked[]]]]}; any => { copy _ MakeNonCtxSe[SERecord.cons.any.SIZE]; seb[copy] _ SERecord[mark3: t.mark3, mark4: t.mark4, body: cons[any[]]]}; ENDCASE => ERROR; RETURN}; CopyArg: PROC [copy, master: ISEIndex, mapper: Tree.Map] = { seb[copy].hash _ seb[master].hash; seb[copy].public _ seb[master].public; seb[copy].immutable _ seb[master].immutable; seb[copy].constant _ seb[master].constant; seb[copy].idType _ seb[master].idType; seb[copy].idInfo _ seb[master].idInfo; seb[copy].idValue _ seb[master].idValue; seb[copy].linkSpace _ FALSE; seb[copy].mark3 _ seb[master].mark3; seb[copy].mark4 _ seb[master].mark4; IF mapper # NIL AND seb[master].extended THEN { type: ExtensionType; t: Tree.Link; [type, t] _ FindExtension[master]; EnterExtension[copy, type, mapper[t]]} ELSE seb[copy].extended _ FALSE}; <> LinkBti: PUBLIC PROC [bti, parent: BTIndex] = { prev: BTIndex; IF parent # BTNull THEN { IF (prev _ bb[parent].firstSon) = BTNull THEN bb[parent].firstSon _ bti ELSE { UNTIL bb[prev].link.which = parent DO prev _ bb[prev].link.index ENDLOOP; bb[prev].link _ [which:sibling, index:bti]}}; bb[bti].link _ [which:parent, index:parent]}; DelinkBti: PUBLIC PROC [bti: BTIndex] = { prev, next: BTIndex; parent: BTIndex = ParentBti[bti]; IF parent # BTNull THEN { prev _ bb[parent].firstSon; IF prev = bti THEN bb[parent].firstSon _ IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index ELSE { UNTIL (next _ bb[prev].link.index) = bti DO prev _ next ENDLOOP; bb[prev].link _ bb[next].link}}; bb[bti].link _ [which:parent, index:BTNull]}; <> ConstantId: PUBLIC PROC [sei: ISEIndex] RETURNS [BOOL] = { RETURN [IF ~seb[sei].constant THEN FALSE ELSE SELECT XferMode[seb[sei].idType] FROM proc, signal, error, program => seb[sei].mark4 AND seb[sei].idInfo = BTNull, ENDCASE => TRUE]}; <> hashVec _ UnsafeStorage.GetSystemUZone[].NEW[HashVector _ ALL[HTNull]]; }.