<<>> <> <> <> <> <> DIRECTORY IO, Atom, Convert, ConvertUnsafe, MobConnection, File, MobDefs, MobListerUtils, OSMiscOps, RefText, Rope, SymbolOps, Symbols, SymbolSegment, SymbolTable, SymbolTablePrivate, Table; MobConnectionImpl: PROGRAM IMPORTS IO, Atom, Convert, RefText, Rope, SymbolOps, MobListerUtils EXPORTS MobConnection, SymbolTable, SymbolOps = { FormIdentifier: TYPE = ATOM; ModuleID: TYPE = MobConnection.ModuleID; FilterItem: TYPE = MobConnection.FilterItem; Filter: TYPE = MobConnection.Filter; bytesPerUnit: NAT = BYTES[WORD]; unitsPerFilePage: NAT = File.wordsPerPage; bytesPerFilePage: NAT = unitsPerFilePage*bytesPerUnit; bitsPerByte: CARD = 8; bitsPerUnit: CARD = OSMiscOps.bytesPerUnit*bitsPerByte; UnitsToFilePages: PROC[units: INT] RETURNS[INT] = { RETURN[(units+unitsPerFilePage-1)/unitsPerFilePage]}; BytesToFilePages: PROC[bytes: INT] RETURNS[INT] = { RETURN[(bytes+bytesPerFilePage-1)/bytesPerFilePage]}; Base: TYPE = MobDefs.Base; Mob: TYPE = MobDefs.Mob; BitAddress: TYPE = Symbols.BitAddress; BodyRecord: TYPE = Symbols.BodyRecord; BTIndex: TYPE = Symbols.BTIndex; RootBti: BTIndex = Symbols.RootBti; CBTIndex: TYPE = Symbols.CBTIndex; ContextLevel: TYPE = Symbols.ContextLevel; lG: ContextLevel = Symbols.lG; CSEIndex: TYPE = Symbols.CSEIndex; CSENull: CSEIndex = Symbols.CSENull; typeTYPE: CSEIndex = Symbols.typeTYPE; CTIndex: TYPE = MobDefs.CTIndex; CTNull: CTIndex = MobDefs.CTNull; CTRecord: TYPE = MobDefs.CTRecord; CTXIndex: TYPE = Symbols.CTXIndex; CTXNull: CTXIndex = Symbols.CTXNull; CTXRecord: TYPE = Symbols.CTXRecord; EVIndex: TYPE = MobDefs.EVIndex; EVNull: EVIndex = MobDefs.EVNull; EVRecord: TYPE = MobDefs.EVRecord; EXPIndex: TYPE = MobDefs.EXPIndex; EXPLink: TYPE = MobDefs.EXPLink; EXPRecord: TYPE = MobDefs.EXPRecord; FPIndex: TYPE = MobDefs.FPIndex; FPRecord: TYPE = MobDefs.FPRecord; FTIndex: TYPE = MobDefs.FTIndex; FTNull: FTIndex = MobDefs.FTNull; FTSelf: FTIndex = MobDefs.FTSelf; FTRecord: TYPE = MobDefs.FTRecord; HTIndex: TYPE = Symbols.HTIndex; ISEIndex: TYPE = Symbols.ISEIndex; ISENull: ISEIndex = Symbols.ISENull; ISERecord: TYPE = SERecord.id; LFIndex: TYPE = MobDefs.LFIndex; LFNull: LFIndex = MobDefs.LFNull; LFRecord: TYPE = MobDefs.LinkFrag; Link: TYPE = MobDefs.Link; nullLink: Link = MobDefs.nullLink; Namee: TYPE = MobDefs.Namee; NameRecord: TYPE = MobDefs.NameRecord; NameString: TYPE = MobDefs.NameString; NTIndex: TYPE = MobDefs.NTIndex; NTNull: NTIndex = MobDefs.NTNull; NTRecord: TYPE = MobDefs.NTRecord; IMPIndex: TYPE = MobDefs.IMPIndex; IMPRecord: TYPE = MobDefs.IMPRecord; MTIndex: TYPE = MobDefs.MTIndex; MTRecord: TYPE = MobDefs.MTRecord; RefMob: TYPE = REF Mob; RefMTRecord: TYPE = REF MTRecord; RefSGRecord: TYPE = REF SGRecord; RFIndex: TYPE = MobDefs.RFIndex; RFNull: RFIndex = MobDefs.RFNull; RFRecord: TYPE = MobDefs.RefLitFrag; ROPE: TYPE = Rope.ROPE; Name: TYPE = Symbols.Name; nullName: Name = Symbols.nullName; SEIndex: TYPE = Symbols.SEIndex; SENull: SEIndex = Symbols.SENull; SERecord: TYPE = Symbols.SERecord; SGIndex: TYPE = MobDefs.SGIndex; SGNull: SGIndex = MobDefs.SGNull; SGRecord: TYPE = MobDefs.SGRecord; SpaceID: TYPE = MobDefs.SpaceID; SPIndex: TYPE = MobDefs.SPIndex; SPRecord: TYPE = MobDefs.SPRecord; SymbolTableBase: TYPE = REF SymbolTableBaseRep; STB: TYPE = REF SymbolTableBaseRep; SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep; TFIndex: TYPE = MobDefs.TFIndex; TFNull: TFIndex = MobDefs.TFNull; TFRecord: TYPE = MobDefs.TypeFrag; TYPIndex: TYPE = MobDefs.TYPIndex; TYPNull: TYPIndex = MobDefs.TYPNull; TYPRecord: TYPE = MobDefs.TYPRecord; VersionStamp: TYPE = MobDefs.VersionStamp; Error: PUBLIC ERROR [culprit: REF, msg: ROPE] = CODE; Appender: TYPE = RECORD [head, last: LIST OF REF ANY]; LORAFromMob: PUBLIC SAFE PROC [fileName: Rope.ROPE, filter: Filter ¬ ALL[TRUE]] RETURNS [result: LIST OF REF ANY ¬ NIL] = CHECKED { stack: LIST OF Appender ¬ NIL; Begin: SAFE PROC [id: FormIdentifier] = { head: LIST OF REF ANY = LIST[id]; stack ¬ CONS[[head, head], stack]; }; End: SAFE PROC = { a: LIST OF REF ANY ¬ stack.first.head; stack ¬ stack.rest; IF stack = NIL THEN result ¬ a ELSE Put[a]; }; Put: SAFE PROC [a: REF] = {stack.first.last ¬ stack.first.last.rest ¬ LIST[a]}; PutATOM: SAFE PROC [a: ATOM] = {Put[a]}; PutROPE: SAFE PROC [a: ROPE] = {Put[a]}; PutINT: SAFE PROC [a: INT] = {Put[NEW[INT ¬ a]]}; PutBOOL: SAFE PROC [a: BOOL] = {Put[IF a THEN $TRUE ELSE $FALSE]}; PutModuleID: SAFE PROC [a: ModuleID] = {Put[NEW[ModuleID ¬ a]]}; DecodeMob[fileName: fileName, begin: Begin, end: End, putATOM: PutATOM, putROPE: PutROPE, putINT: PutINT, putBOOL: PutBOOL, putModuleID: PutModuleID, filter: filter]; IF stack # NIL THEN ERROR; }; DecodeMob: PUBLIC SAFE PROC [fileName: Rope.ROPE, begin: SAFE PROC [FormIdentifier], end: SAFE PROC, putATOM: SAFE PROC[ATOM], putROPE: SAFE PROC[ROPE], putINT: SAFE PROC[INT], putBOOL: SAFE PROC[BOOL], putModuleID: SAFE PROC[ModuleID], filter: Filter] = TRUSTED { Inner: PROC [mob: MobDefs.MobBase] = { Start: PROC [FormIdentifier] = begin; End: PROC = end; PutRope: PROC [ROPE] = putROPE; PutINT: PROC [int: INT] = putINT; PutLabeledINT: PROC [symbol: ATOM, int: INT] = {Start[symbol]; PutINT[int]; End[]}; PutLabeledBOOL: PROC [symbol: ATOM, bool: BOOL] = {Start[symbol]; putBOOL[bool]; End[]}; PrintStamps: PROC = { IF filter[imports] THEN {Start[$imports]; FOR iti: IMPIndex ¬ IMPIndex.FIRST, iti + IMPRecord.SIZE UNTIL iti = mob.impLimit DO ip: LONG POINTER TO IMPRecord = @itb[iti]; IF LOOPHOLE[iti, CARD] > LOOPHOLE[mob.impLimit, CARD] THEN GO TO Bogus; <> <> <> PutFileStamp[ip.file, ip.name]; REPEAT Bogus => PrintGarbage[]; ENDLOOP; End[]}; IF filter[exports] THEN {Start[$exports]; FOR eti: EXPIndex ¬ EXPIndex.FIRST, eti + etb[eti].nLinks*EXPLink.SIZE + EXPRecord.SIZE UNTIL eti = mob.expLimit DO ee: LONG POINTER TO EXPRecord = @etb[eti]; OnlyTypes: PROC RETURNS [BOOL] = { FOR i: CARD16 IN [0..ee.nLinks) DO IF ee[i].from = [tag: var, modIndex: 0, offset: 0] THEN EXIT; IF ee[i].from.tag # type THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE] }; IF LOOPHOLE[eti, CARD] > LOOPHOLE[mob.expLimit, CARD] THEN GO TO Bogus; IF NOT filter[typeExports] AND OnlyTypes[] THEN LOOP; IF filter[exportedItems] THEN {Start[$export]; PutFileStamp[ee.file, ee.name]; FOR i: CARD16 IN [0..ee.nLinks) DO IF ee[i].from = [tag: var, modIndex: 0, offset: 0] THEN EXIT; Start[SELECT ee[i].from.tag FROM var => $var, proc => $proc, type => $type, ENDCASE => $other]; PutINT[ee[i].to]; End[]; ENDLOOP; End[]} ELSE PutFileStamp[ee.file, ee.name]; <> <> <> REPEAT Bogus => PrintGarbage[]; ENDLOOP; End[]}; IF filter[modules] THEN {Start[$modules]; FOR mti: MTIndex ¬ MTIndex.FIRST, mti + MTSize[mti] UNTIL mti = mob.mtLimit DO mm: LONG POINTER TO MTRecord = @mtb[mti]; IF LOOPHOLE[mti, CARD] > LOOPHOLE[mob.mtLimit, CARD] THEN GO TO Bogus; <> <> <> PutFileStamp[mm.file, mm.name]; REPEAT Bogus => PrintGarbage[]; ENDLOOP; End[]}; }; PutFileStamp: PROC[fti: FTIndex, mName: NameRecord] = { SELECT fti FROM FTNull => PutName[mName]; FTSelf => PutName[mName]; ENDCASE => { ftr: LONG POINTER TO FTRecord = @ftb[fti]; PutStampedName[n: ftr.name, stamp: ftr.version]; }; }; PutMobName: PROC[] = { name: NameRecord = IF mob.nModules=1 AND mob.nConfigs = 0 THEN (@mtb[MTIndex.FIRST]).name ELSE mob.source; PutStampedName[n: name, stamp: mob.version]; }; PrintHeader: PROC = { {Start[$header]; PutLabeledINT[$configurations, mob.nConfigs]; PutLabeledINT[$modules, mob.nModules]; PutLabeledINT[$imports, mob.nImports]; PutLabeledINT[$exports, mob.nExports]; PutLabeledINT[$firstdummy, mob.firstdummy]; PutLabeledINT[$dummies, mob.nDummies]; PutLabeledBOOL[$definitions, mob.definitions]; PutLabeledBOOL[$repackaged, mob.repackaged]; PutLabeledBOOL[$typeexported, mob.typeExported]; PutLabeledBOOL[$inlinefloat, mob.inlineFloat]; PutLabeledBOOL[$mappingstarted, mob.mappingStarted]; PutLabeledBOOL[$mappingfinished, mob.mappingFinished]; PutLabeledBOOL[$versions, mob.versions]; PutLabeledBOOL[$extended, mob.extended]; End[]}; }; PrintConfigs: PROC = { cti: CTIndex ¬ CTIndex.FIRST; IF cti = mob.ctLimit THEN RETURN; {Start[$configurations]; <> UNTIL cti = mob.ctLimit DO PrintConfig[cti]; cti ¬ cti + CTRecord.SIZE + ctb[cti].nControls*Namee.SIZE; IF LOOPHOLE[cti, CARD] > LOOPHOLE[mob.ctLimit, CARD] THEN GO TO Bogus; REPEAT Bogus => PrintGarbage[]; ENDLOOP; End[]}; }; PrintConfig: PROC[cti: CTIndex] = { ctp: LONG POINTER TO CTRecord = @ctb[cti]; Start[$configuration]; PutName[ctp.name]; <> <> <> IF ctp.nControls # 0 THEN {Start[$control]; FOR i: CARDINAL IN [0..ctp.nControls) DO WITH c~~ctp.controls[i] SELECT FROM module => {PutName[mtb[c.mti].name]}; config => {Start[$config]; PutName[ctb[c.cti].name]; End[]}; ENDCASE => ERROR; ENDLOOP; End[]}; End[]}; <> <> <> <> <> <> < LOOPHOLE[mob.impLimit, CARD] THEN GO TO Bogus;>> <> < PrintGarbage[];>> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> < maxSpan _ DoContext[t.fieldCtx];>> <> <<};>> <> <> <> <> <> <<};>> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> < >> <> <>> <> < >> <> <> <<}; -- End of inner>> <> < CONTINUE];>> <> < {>> <> <> <> < {>> <> <> <> <> <> <> <> <> <<};>> < {>> <> <<};>> < CONTINUE];>> <> <<};>> <<};>> <<>> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <> < LOOPHOLE[mob.mtLimit, CARD] THEN GO TO Bogus;>> <> < PrintGarbage[];>> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<"exported variables: [%g]", [cardinal[LOOPHOLE[mth.variables, CARD]]]];>> <<};>> <> <> <> <> <> <> <> <> <> <> <> <> <<>> MTSize: PROC[mti: MTIndex] RETURNS[NAT] = { RETURN[MTRecord.SIZE] }; <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<};>> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<};>> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<};>> <<};>> <<>> <> <> <> <> <> <> < LOOPHOLE[mob.ftLimit, CARD] THEN {>> <> <> <> <<};>> <<>> <> <> <> < stream.PutRope["(null)"];>> < stream.PutRope["(self)"];>> < {>> <> <> <> <> <<};>> <<>> PrintUsing: PROC [stb: SymbolTableBase] = { limit: CTXIndex = LOOPHOLE[stb.stHandle.ctxBlock.size]; ctx: CTXIndex ¬ CTXIndex.FIRST + CTXRecord.nil.SIZE; pairs: LIST OF Pair ¬ NIL; ros: IO.STREAM ¬ IO.ROS[]; firstCopiedHash: Symbols.HTIndex; InDirectory: PROC [ctx: CTXIndex] RETURNS [BOOL] = { FOR dirSei: ISEIndex ¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.directoryCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]] SELECT FROM definition => IF ctx = se.defCtx THEN RETURN [TRUE]; ENDCASE; ENDLOOP; RETURN [FALSE]}; DoContext: PROC [ctx: CTXIndex] = { IF ctx # CTXNull THEN { sei, root: ISEIndex; cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx]; which: LIST OF Pair ¬ NIL; key, modName: ROPE ¬ NIL; mdi: Symbols.MDIndex; DoSei: PROC [sei: ISEIndex] = { sep: LONG POINTER TO ISERecord = @stb.seb[sei]; IF LOOPHOLE[sep.hash, CARD] < LOOPHOLE[firstCopiedHash, CARD] THEN { name: ROPE ¬ NIL; IF sep.idType = typeTYPE THEN { typeSei: SEIndex ¬ SymbolOps.DecodeType[sep.idInfo]; WITH tse~~stb.seb[typeSei] SELECT FROM id => { IF tse.idCtx # ctx AND InDirectory[tse.idCtx] THEN RETURN}; ENDCASE; }; ros ¬ IO.ROS[ros]; MobListerUtils.PrintSei[sei, ros, stb]; name ¬ ros.RopeFromROS[FALSE]; which.first.names ¬ InsertName[name, which.first.names]}; }; WITH c~~cp SELECT FROM included => { mdi ¬ c.module}; imported => { mdi ¬ stb.ctxb[c.includeLink].module}; ENDCASE => RETURN; <> ros ¬ IO.ROS[ros]; MobListerUtils.PrintName[stb.mdb[mdi].moduleId, ros, stb]; modName ¬ ros.RopeFromROS[FALSE]; [which, pairs] ¬ FindList[modName, pairs]; IF which.first.file = NIL THEN { <> modFileName: ROPE ¬ NIL; ros ¬ IO.ROS[ros]; MobListerUtils.PrintName[stb.mdb[mdi].fileId, ros, stb]; modFileName ¬ ros.RopeFromROS[FALSE]; modFileName ¬ modFileName.Flatten[0, modFileName.SkipTo[0, "."]]; which.first.file ¬ modFileName}; root ¬ sei ¬ stb.ctxb[ctx].seList; DO IF sei = SENull THEN EXIT; DoSei[sei]; IF (sei ¬ SymbolOps.NextSe[stb, sei]) = root THEN EXIT; ENDLOOP; }; }; BEGIN firstCopiedHash ¬ LAST[Symbols.HTIndex]; <> <> <> <> < firstCopiedHash _ LENGTH[stb.hashVec];>> <> END; FOR dirSei: ISEIndex ¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.directoryCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]] SELECT FROM definition => DoContext[se.defCtx]; ENDCASE; ENDLOOP; FOR dirSei: ISEIndex ¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.importCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]] SELECT FROM definition => DoContext[se.defCtx]; transfer => { bti: BTIndex = SymbolOps.DecodeBti[stb.seb[dirSei].idInfo]; DoContext[stb.bb[bti].localCtx]}; ENDCASE; ENDLOOP; <> IF pairs # NIL THEN {Start[$directory]; WHILE pairs # NIL DO pair: Pair = pairs.first; names: LIST OF ROPE ¬ pair.names; {Start[$item]; putATOM[Atom.MakeAtom[pair.key]]; IF NOT (pair.key).Equal[pair.file, FALSE] THEN {Start[$from]; PutRope[pair.file]; End[]}; IF filter[using] THEN {Start[$using]; WHILE names # NIL DO PutRope[names.first]; names ¬ names.rest; ENDLOOP; End[]}; End[]}; pairs ¬ pairs.rest; ENDLOOP; End[]}; }; <> <> <> <> <> <> <<};>> <<>> PrintFileName: PROC[fti: FTIndex] = { SELECT fti FROM FTNull => putATOM[$null]; FTSelf => putATOM[$self]; ENDCASE => PutName[ftb[fti].name]; }; <> <> <<};>> <<>> PrintLongIndex: PROC[index: CARD] = { <> }; PrintGarbage: PROC = { Tab[2]; PutRope["? Looks like garbage ..."]; }; Tab: PROC[n: CARDINAL] = { }; <> PutName: PROC[n: NameRecord] = { putATOM[SymbolFromName[n]]; }; PutStampedName: PROC[n: NameRecord, stamp: VersionStamp] = { IF filter[versions] THEN putModuleID[[SymbolFromName[n], SymbolFromStamp[stamp]]] ELSE PutName[n]; }; NameToRope: PROC[n: NameRecord] RETURNS[ROPE] = { CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR]; ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb]; index: CARDINAL = n+4; len: CARDINAL = ss[index]-0C; i: CARDINAL ¬ index+1; P: SAFE PROC RETURNS [c: CHAR] = TRUSTED { c ¬ ss[i]; i ¬ i + 1 }; RETURN[Rope.FromProc[len: len, p: P]]; }; SymbolFromName: PROC[n: NameRecord] RETURNS [a: ATOM] = { CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR]; ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb]; index: CARDINAL = n+4; len: CARDINAL = ss[index]-0C; text: REF TEXT ¬ RefText.ObtainScratch[len]; FOR i: NAT IN [index+1..index+1+len) DO text[text.length] ¬ ss[i]; text.length ¬ text.length + 1; ENDLOOP; a ¬ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[text]; }; SymbolFromNameAndIndex: PROC[n: NameRecord, card: CARD] RETURNS [a: ATOM] = { CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR]; ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb]; index: CARDINAL = n+4; len: CARDINAL = ss[index]-0C; text: REF TEXT ¬ RefText.ObtainScratch[len+9]; FOR i: NAT IN [index+1..index+1+len) DO text[text.length] ¬ ss[i]; text.length ¬ text.length + 1; ENDLOOP; text[text.length] ¬ '-; text.length ¬ text.length + 1; text ¬ Convert.AppendCard[to: text, from: card, base: 16, showRadix: FALSE]; a ¬ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[text]; }; SymbolFromNameAndVersionStamp: PROC [n: NameRecord, stamp: VersionStamp] RETURNS [a: ATOM] = { DigitArray: TYPE = PACKED ARRAY DigitArrayIndex OF HexDigit; HexDigit: TYPE = [0..16); DigitArrayIndex: TYPE = [0..BITS[VersionStamp]/BITS[HexDigit]); CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR]; ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb]; index: CARDINAL = n+4; len: CARDINAL = ss[index]-0C; text: REF TEXT ¬ RefText.ObtainScratch[len+17]; FOR i: NAT IN [index+1..index+1+len) DO text[text.length] ¬ ss[i]; text.length ¬ text.length + 1; ENDLOOP; text[text.length] ¬ '-; text.length ¬ text.length + 1; FOR i: DigitArrayIndex IN DigitArrayIndex DO d: HexDigit = LOOPHOLE[stamp, DigitArray][i]; text[text.length] ¬ IF d < 10 THEN '0+d ELSE 'a-10+d; text.length ¬ text.length + 1; ENDLOOP; a ¬ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[text]; }; SymbolFromStamp: PROC [stamp: VersionStamp] RETURNS [a: ATOM] = { DigitArray: TYPE = PACKED ARRAY DigitArrayIndex OF HexDigit; HexDigit: TYPE = [0..16); DigitArrayIndex: TYPE = [0..BITS[VersionStamp]/BITS[HexDigit]); text: REF TEXT ¬ RefText.ObtainScratch[17]; text[text.length] ¬ 'v; text.length ¬ text.length + 1; FOR i: DigitArrayIndex IN DigitArrayIndex DO d: HexDigit = LOOPHOLE[stamp, DigitArray][i]; text[text.length] ¬ IF d < 10 THEN '0+d ELSE 'a-10+d; text.length ¬ text.length + 1; ENDLOOP; a ¬ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[text]; }; PutInstanceName: PROC[n: Namee] = { FindName: PROC[ntb: Base, nti: NTIndex] RETURNS[stop: BOOL] = { RETURN[ntb[nti].item = n]; }; nti: NTIndex = EnumerateNameTable[FindName]; IF nti = NTNull THEN putATOM[$anon] ELSE PutName[ntb[nti].name] }; EnumerateNameTable: PROC[ proc: PROC[Base, NTIndex] RETURNS[BOOL]] RETURNS[nti: NTIndex] = { FOR nti ¬ NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = mob.ntLimit DO IF proc[ntb, nti] THEN RETURN[nti]; ENDLOOP; RETURN[NTNull]}; <> tb: MobDefs.Base; <> ssb: MobDefs.NameString ¬ NIL; evb: MobDefs.Base ¬ NIL; spb: MobDefs.Base ¬ NIL; fpb: MobDefs.Base ¬ NIL; ctb: MobDefs.Base ¬ NIL; mtb: MobDefs.Base ¬ NIL; lfb: MobDefs.Base ¬ NIL; tfb: MobDefs.Base ¬ NIL; rfb: MobDefs.Base ¬ NIL; itb: MobDefs.Base ¬ NIL; etb: MobDefs.Base ¬ NIL; sgb: MobDefs.Base ¬ NIL; ftb: MobDefs.Base ¬ NIL; ntb: MobDefs.Base ¬ NIL; InitTableBases: PROC[ptr: LONG POINTER] = { tb ¬ LOOPHOLE[ptr]; ssb ¬ LOOPHOLE[ptr + mob.ssOffset.units]; ctb ¬ tb + mob.ctOffset.units; mtb ¬ tb + mob.mtOffset.units; IF mob.extended THEN { lfb ¬ tb + mob.lfOffset.units; tfb ¬ tb + mob.tfOffset.units; rfb ¬ tb + mob.rfOffset.units}; itb ¬ tb + mob.impOffset.units; etb ¬ tb + mob.expOffset.units; sgb ¬ tb + mob.sgOffset.units; ftb ¬ tb + mob.ftOffset.units; ntb ¬ tb + mob.ntOffset.units; evb ¬ tb + mob.evOffset.units; spb ¬ tb + mob.spOffset.units; fpb ¬ tb + mob.fpOffset.units; }; <> tb ¬ NIL; IF mob.versionIdent # MobDefs.VersionID THEN Error[fileName, "not a valid Cedar mob file"]; InitTableBases[mob]; {Start[IF mob.definitions THEN $definitions ELSE IF mob.nConfigs = 0 THEN $program ELSE $configuration]; PutMobName[]; IF filter[directory] AND mob.nConfigs = 0 THEN { mtb: MobDefs.Base = LOOPHOLE[mob+mob.mtOffset.units]; sgh: MobDefs.SGHandle = IF mtb[FIRST[MobDefs.MTIndex]].sseg = MobDefs.SGNull THEN Error[fileName, "NoSymbols"] -- NoSymbols ELSE @sgb[mtb[FIRST[MobDefs.MTIndex]].sseg]; stb: LONG POINTER TO SymbolSegment.STHeader = LOOPHOLE[mob+sgh.base.units]; IF sgh.file = MobDefs.FTSelf AND sgh.units.units # 0 AND stb.versionIdent = SymbolSegment.VersionID THEN PrintUsing[InstallTable[stb]]; }; IF filter = ALL[FALSE] THEN PrintHeader[]; PrintStamps[]; IF filter[configurations] THEN PrintConfigs[]; End[]}; }; theMob: MobDefs.MobBase ~ MobListerUtils.ReadMob[fileName ! MobListerUtils.MobErr => ERROR Error[culprit: fileName, msg: err]]; Inner[theMob ! UNWIND => MobListerUtils.FreeMob[theMob]]; MobListerUtils.FreeMob[theMob]; }; InstallTable: PROC [node: LONG POINTER] RETURNS [SymbolTableBase] = { b: LONG POINTER = node; tB: SymbolSegment.Base = LOOPHOLE[b]; p: LONG POINTER TO SymbolSegment.STHeader = b; base: SymbolTableBase ¬ NEW[SymbolTableBaseRep]; base.cacheInfo ¬ LOOPHOLE[node]; base.hashVec ¬ b+p.hvBlock.offset; base.htb ¬ tB + p.htBlock.offset - SymbolSegment.biases[SymbolSegment.htType]; base.ssb ¬ b + p.ssBlock.offset - SymbolSegment.biases[SymbolSegment.ssType]; base.seb ¬ tB + p.seBlock.offset - SymbolSegment.biases[SymbolSegment.seType]; base.ctxb ¬ tB + p.ctxBlock.offset - SymbolSegment.biases[SymbolSegment.ctxType]; base.mdb ¬ tB + p.mdBlock.offset - SymbolSegment.biases[SymbolSegment.mdType]; base.bb ¬ tB + p.bodyBlock.offset - SymbolSegment.biases[SymbolSegment.bodyType]; base.tb ¬ tB + p.treeBlock.offset - SymbolSegment.biases[SymbolSegment.treeType]; base.ltb ¬ tB + p.litBlock.offset - SymbolSegment.biases[SymbolSegment.ltType]; base.stb ¬ tB + p.sLitBlock.offset - SymbolSegment.biases[SymbolSegment.stType]; base.extb ¬ tB + p.extBlock.offset - SymbolSegment.biases[SymbolSegment.extType]; base.mdLimit ¬ Symbols.MDFirst + p.mdBlock.size; base.extLimit ¬ SymbolSegment.ExtFirst + p.extBlock.size; base.mainCtx ¬ p.outerCtx; base.stHandle ¬ p; IF p.fgRelBase = 0 OR p.fgCount = 0 THEN { base.sourceFile ¬ NIL; base.fgTable ¬ NIL; } ELSE { q: LONG POINTER TO SymbolSegment.FGHeader = LOOPHOLE[b + p.fgRelBase]; source: LONG STRING = LOOPHOLE[q + SIZE[SymbolSegment.FGHeader[0]] - SIZE[StringBody[0]]]; base.sourceFile ¬ source; base.fgTable ¬ DESCRIPTOR[q + q.offset, q.length]; }; RETURN [base]; }; Pair: TYPE = RECORD [key: ROPE, file: ROPE, names: LIST OF ROPE]; FindList: PROC [key: ROPE, base: LIST OF Pair] RETURNS [which,newBase: LIST OF Pair ¬ NIL] = { <> newBase ¬ base; WHILE which = NIL DO FOR each: LIST OF Pair ¬ newBase, each.rest WHILE each # NIL DO IF key.Equal[each.first.key] THEN {which ¬ each; RETURN}; ENDLOOP; newBase ¬ InsertPair[[key, NIL, NIL], newBase]; ENDLOOP; }; InsertName: PROC [rope: ROPE, list: LIST OF ROPE] RETURNS [LIST OF ROPE] = { lag: LIST OF ROPE ¬ NIL; FOR each: LIST OF ROPE ¬ list, each.rest WHILE each # NIL DO SELECT rope.Compare[each.first, FALSE] FROM $less => EXIT; $equal => SELECT rope.Compare[each.first, TRUE] FROM $less => EXIT; $equal => RETURN [list]; $greater => {}; ENDCASE; $greater => {}; ENDCASE => ERROR; lag ¬ each; ENDLOOP; IF lag = NIL THEN RETURN [CONS[rope, list]] ELSE {lag.rest ¬ CONS[rope, lag.rest]; RETURN [list]}}; InsertPair: PROC [pair: Pair, list: LIST OF Pair] RETURNS [LIST OF Pair] = { lag: LIST OF Pair ¬ NIL; key: ROPE ¬ pair.key; FOR each: LIST OF Pair ¬ list, each.rest WHILE each # NIL DO SELECT key.Compare[each.first.key, FALSE] FROM $less => EXIT; $equal => SELECT key.Compare[each.first.key, TRUE] FROM $less => EXIT; $equal => RETURN [list]; $greater => {}; ENDCASE; $greater => {}; ENDCASE => ERROR; lag ¬ each; ENDLOOP; IF lag = NIL THEN RETURN [CONS[pair, list]] ELSE {lag.rest ¬ CONS[pair, lag.rest]; RETURN [list]}; }; FirstCtxSe: PUBLIC --SymbolOps-- PROC [stb: STB, ctx: CTXIndex] RETURNS [ISEIndex] = { RETURN [IF ctx = CTXNull THEN ISENull ELSE stb.ctxb[ctx].seList]; }; NameForSe: PUBLIC --SymbolOps-- PROC [stb: STB, sei: ISEIndex] RETURNS [Name] = { RETURN [IF sei = ISENull THEN nullName ELSE stb.seb[sei].hash]; }; NextSe: PUBLIC --SymbolOps-- PROC [stb: STB, sei: ISEIndex] RETURNS [ISEIndex] = { IF sei # ISENull THEN WITH id: stb.seb[sei] SELECT FROM sequential => RETURN [sei + SERecord.id.sequential.SIZE]; linked => RETURN [id.link]; ENDCASE; RETURN [ISENull]; }; SubStringForName: PUBLIC --SymbolOps-- PROC [stb: STB, name: Symbols.Name] RETURNS [s: ConvertUnsafe.SubString] = { s.base ¬ stb.ssb; IF name = nullName THEN s.offset ¬ s.length ¬ 0 ELSE s.length ¬ stb.htb[name].ssIndex - (s.offset ¬ stb.htb[name-Symbols.HTRecord.SIZE].ssIndex+1); }; TypeLink: PUBLIC --SymbolOps-- PROC [stb: STB, type: Symbols.Type] RETURNS [Symbols.Type] = { sei: CSEIndex = UnderType[stb, type]; WITH se: stb.seb[sei] SELECT FROM record => WITH se SELECT FROM linked => RETURN [linkType]; ENDCASE; ENDCASE; RETURN [Symbols.nullType]; }; UnderType: PUBLIC --SymbolOps-- PROC [stb: STB, type: Symbols.Type] RETURNS [CSEIndex] = { sei: Symbols.Type ¬ type; WHILE sei # Symbols.nullType DO sep: Symbols.SEPointer = @stb.seb[sei]; IF LOOPHOLE[sei, Table.IndexRep].tag # Symbols.seTag THEN ERROR; -- This happens if a truly nasty sei is used WITH se: sep­ SELECT FROM id => {IF se.idType # Symbols.typeTYPE THEN ERROR; sei ¬ TypeInfo[se.idInfo]}; cons => EXIT; ENDCASE => ERROR; ENDLOOP; RETURN [LOOPHOLE[sei, CSEIndex]]; }; TypeInfo: PROC [info: Symbols.UNSPEC] RETURNS [Symbols.Type] = INLINE { RETURN [LOOPHOLE[info]]; }; XferMode: PUBLIC --SymbolOps-- PROC [stb: STB, type: Symbols.Type] RETURNS [Symbols.TransferMode] = { sei: CSEIndex = UnderType[stb, type]; RETURN [WITH t: stb.seb[sei] SELECT FROM transfer => t.mode, ENDCASE => $none]; }; <> << RETURNS[ROPE _ NIL] = {>> <> <> <> <> <> <> <> <> <> <> <> <<~sep.mark4 OR SymbolOps.LinkMode[exstb, sei] = $manifest => {};>> < {>> <> <> <> <> < {};>> < ros.PutRope[" [inline]"];>> <> <> <<};>> <> <> <> <<};>> <> }.