DIRECTORY Basics: TYPE USING [bytesPerWord], BcdDefs: TYPE, FileSegment: TYPE USING [Pages], IO: TYPE USING [GetIndex, SetIndex, STREAM, PutChar, UnsafePutBlock], PGSConDefs: TYPE USING [objectVersion, outeol, outstring, pgsVersion, resetoutstream, seterrstream, sourceName, sourceVersion, warningsLogged, WriteSymbols], PrincOps: TYPE USING [bytesPerPage, wordsPerPage], Rope: TYPE USING [Cat, Find, Flatten, FromChar, Length, ROPE, Substr], TableCommand: TYPE USING [FindInterface, FindItem, BadInterface], UnsafeStorage: TYPE USING [GetSystemUZone, NewUObject]; PGSBcd: PROGRAM IMPORTS IO, PGSConDefs, Rope, TableCommand, UnsafeStorage EXPORTS PGSConDefs = { StreamIndex: TYPE = INT; -- FileStream.FileByteIndex bytesPerWord: CARDINAL = Basics.bytesPerWord; bcdHeader: BcdDefs.BCD; module: BcdDefs.MTRecord.direct; export: BcdDefs.EXPHandle; defsFile: BcdDefs.FTRecord; codeSeg, symbolSeg: BcdDefs.SGRecord; ssb: Rope.ROPE; out: IO.STREAM; moduleIndex, segIndex: StreamIndex; -- for fixup moduleId: Rope.ROPE; systemZone: UNCOUNTED ZONE _ UnsafeStorage.GetSystemUZone[]; InitializePackedString: PROC = {ssb _ Rope.FromChar[LOOPHOLE[0]]}; AddName: PROC[n: Rope.ROPE] RETURNS[name: BcdDefs.NameRecord] = { IF n = NIL THEN name _ BcdDefs.NullName ELSE { lengthChar: CHAR _ VAL[CARDINAL[n.Length[]]]; name _ BcdDefs.NameRecord[ssb.Length[]+1]; ssb _ Rope.Cat[ssb, Rope.FromChar[lengthChar], n]}; RETURN}; FillInModule: PROC[name: BcdDefs.NameRecord, altoCode: BOOL] = { OPEN BcdDefs; module _ MTRecord[ name: name, namedInstance: FALSE, initial: FALSE, file: FTSelf, linkLoc: frame, config: CTNull, code: [ sgi: SGIndex.FIRST, linkspace: FALSE, packed: FALSE, offset: 0, length: 0], sseg: SGIndex.FIRST+SGRecord.SIZE, frameRefs: FALSE, frameType: 0, framesize: 4, tableCompiled: TRUE, altoCode: altoCode, long: FALSE, residentFrame: FALSE, crossJumped: FALSE, packageable: TRUE, gfi: 1, variables: EVNull, ngfi: 1, boundsChecks: FALSE, nilChecks: FALSE, extension: direct[length: 0, frag: ]]; codeSeg _ [class: code, file: FTSelf, base: 2, pages: 0, extraPages: 0]; symbolSeg _ [class: symbols, file: FTNull, base: 0, pages: 0, extraPages: 0]}; FillInExport: PROC[name: BcdDefs.NameRecord, size, entry: CARDINAL] = { export _ UnsafeStorage.NewUObject[BcdDefs.EXPRecord.SIZE+size, systemZone]; export^ _ BcdDefs.EXPRecord[ name: name, size: size, port: interface, namedInstance: FALSE, typeExported: FALSE, file: BcdDefs.FTIndex.FIRST, links:]; FOR i: CARDINAL IN [0..size) DO export.links[i] _ BcdDefs.NullLink ENDLOOP; export.links[entry] _ BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]}; FillInHeader: PROC = { OPEN h: bcdHeader; LOOPHOLE[bcdHeader, ARRAY [0..BcdDefs.BCD.SIZE) OF CARDINAL] _ ALL[0]; h.versionIdent _ BcdDefs.VersionID; h.version _ PGSConDefs.objectVersion; h.creator _ PGSConDefs.pgsVersion; h.sourceVersion _ PGSConDefs.sourceVersion; h.source _ IF PGSConDefs.sourceName = NIL THEN BcdDefs.NullName ELSE AddName[PGSConDefs.sourceName]; h.nPages _ 1; h.nConfigs _ 0; h.nModules _ 1; h.nImports _ 0; h.nExports _ IF export = NIL THEN 0 ELSE 1; h.definitions _ h.repackaged _ h.typeExported _ FALSE; h.tableCompiled _ TRUE; h.versions _ FALSE; h.extended _ TRUE; h.spare1 _ TRUE; -- large eval stack h.spare2 _ FALSE; h.firstdummy _ 2; h.nDummies _ 0; h.ctOffset _ h.impOffset _ h.ntOffset _ BcdDefs.BCD.SIZE; h.ssOffset _ BcdDefs.BCD.SIZE; h.ssLimit _ StringBody[ssb.Length[]].SIZE; -- all strings must be entered by now h.mtOffset _ h.ssOffset + LOOPHOLE[h.ssLimit, CARDINAL]; h.mtLimit _ BcdDefs.MTIndex.FIRST + BcdDefs.MTRecord.direct.SIZE; h.sgOffset _ h.mtOffset + LOOPHOLE[h.mtLimit, CARDINAL]; h.sgLimit _ BcdDefs.SGIndex.FIRST + 2*BcdDefs.SGRecord.SIZE; IF export # NIL THEN { h.ftOffset _ h.sgOffset + LOOPHOLE[h.sgLimit, CARDINAL]; h.ftLimit _ BcdDefs.FTIndex.FIRST + BcdDefs.FTRecord.SIZE; h.expOffset _ h.ftOffset + LOOPHOLE[h.ftLimit, CARDINAL]; h.expLimit _ BcdDefs.EXPIndex.FIRST + BcdDefs.EXPRecord.SIZE+export.size}; h.rtPages _ [0, 0]}; PutWords: PROC[out: IO.STREAM, base: LONG POINTER, words: NAT] = { out.UnsafePutBlock[[base: base, count: words*bytesPerWord]]}; PadToIndex: PROC[out: IO.STREAM, index: INT] = { here: INT ~ out.GetIndex[]; IF here>index THEN ERROR; THROUGH [here..index) DO out.PutChar[VAL[0]] ENDLOOP}; WriteBcd: PROC[out: IO.STREAM] = { ssb _ Rope.Flatten[ssb]; -- so we can blt it out PutWords[out, @bcdHeader, BcdDefs.BCD.SIZE]; PutWords[out, LOOPHOLE[ssb], StringBody[ssb.Length[]].SIZE]; moduleIndex _ IO.GetIndex[out]; PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE]; segIndex _ IO.GetIndex[out]; PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE]; PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE]; IF export # NIL THEN { PutWords[out, @defsFile, BcdDefs.FTRecord.SIZE]; PutWords[out, export, (BcdDefs.EXPRecord.SIZE+export.size)]; systemZone.FREE[@export]} }; PagesForWords: PROC[nWords: CARDINAL] RETURNS[CARDINAL] = INLINE { RETURN[(nWords + (PrincOps.wordsPerPage-1))/PrincOps.wordsPerPage]}; WriteBcdHeader: PUBLIC PROC[ outStream: IO.STREAM, tableId, binaryId: Rope.ROPE, -- file being written interfaceId, fileId: Rope.ROPE, -- interface being exported altoCode: BOOL_TRUE] = { symbols: FileSegment.Pages; out _ outStream; IF tableId # NIL THEN moduleId _ tableId ELSE { dot: INT ~ binaryId.Find["."]; IF dot < 0 THEN moduleId _ binaryId ELSE moduleId _ binaryId.Substr[len: dot]; }; InitializePackedString[]; FillInModule[AddName[moduleId], altoCode]; IF interfaceId = NIL THEN export _ NIL ELSE { dName: BcdDefs.NameRecord = AddName[interfaceId]; size, entry: CARDINAL; [defsFile.version, symbols] _ TableCommand.FindInterface[interfaceId, fileId ! TableCommand.BadInterface => { OPEN PGSConDefs; seterrstream[]; outeol[1]; outstring[id]; outstring[" cannot be opened"]; GO TO fail}]; defsFile.name _ IF fileId = NIL THEN dName ELSE AddName[fileId]; [size, entry] _ TableCommand.FindItem[symbols, moduleId ! TableCommand.BadInterface => { OPEN PGSConDefs; seterrstream[]; outeol[1]; outstring[moduleId]; outstring[" not found"]; GO TO fail}]; FillInExport[dName, size, entry]; EXITS fail => { OPEN PGSConDefs; outstring[" -- SELF used"]; outeol[2]; resetoutstream[]; warningsLogged _ TRUE; export _ NIL}}; FillInHeader[]; -- Do this after all strings entered WriteBcd[out]; PadToIndex[out, PrincOps.bytesPerPage]}; FixupBcdHeader: PUBLIC PROC = { bytesPerPage: CARDINAL = PrincOps.bytesPerPage; endIndex: StreamIndex _ IO.GetIndex[out]; nBytes: CARDINAL = endIndex - bytesPerPage; module.code.length _ nBytes; codeSeg.pages _ PagesForWords[(nBytes + (bytesPerWord-1))/bytesPerWord]; IF bcdHeader.nExports = 0 THEN { startIndex: StreamIndex; symbolBytes: CARDINAL; UNTIL (startIndex _ IO.GetIndex[out]) MOD bytesPerPage = 0 DO out.PutChar[000C]; ENDLOOP; symbolSeg _ [ class: symbols, file: BcdDefs.FTSelf, base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0]; PGSConDefs.WriteSymbols[out, moduleId]; endIndex _ IO.GetIndex[out]; symbolBytes _ endIndex-startIndex; symbolSeg.pages _ PagesForWords[(symbolBytes + (bytesPerWord-1))/bytesPerWord]}; IO.SetIndex[out, moduleIndex]; PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE]; IO.SetIndex[out, segIndex]; PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE]; PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE]; IO.SetIndex[out, endIndex] }; }. œPGSBcd.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Satterthwaite, October 18, 1985 10:09:14 am PDT Maxwell, August 8, 1983 2:34 pm Wyatt, March 16, 1984 2:20:33 pm PST Russ Atkinson (RRA) March 19, 1985 9:56:37 am PST BCD construction ssb.string.length _ 1; ssb.size[1] _ 0}; clear all fields overall control fill in interface info IF export # NIL THEN RETURN; ** from ModuleMaker ?? ΚL˜codešœ ™ Kšœ Οmœ1™˜D—˜K˜——Kšœ™˜š œžœžœ˜Kšœ žœžœ˜KšœžœŸ˜5KšœžœŸ˜=Kšœ žœžœ˜K˜Kšœ˜Kšžœ žœžœ˜(šžœ˜Kšœžœ˜Kšžœ žœ˜$Kšžœ&˜*Kšœ˜—K˜K˜*Kšœ™Kšžœžœžœ ž˜&šžœ˜K˜1Kšœ žœ˜˜˜.˜ Kšžœ ˜K˜K˜.Kšžœžœ˜ ———Kš œžœ žœžœžœ˜@˜7˜ Kšžœ ˜K˜K˜-Kšžœžœ˜ ——K˜!šž˜˜ Kšžœ ˜K˜Kšœ.žœ˜3Kšœ žœ˜———KšœŸ$˜4K˜Kšœ(˜(K˜—š œžœžœ˜Kšœžœ˜/Kšœžœ˜)Kšœžœ˜+Kšœ3™3K˜K˜Hšžœžœ˜ K˜Kšœ žœ˜šžœžœžœž˜=Kšœžœ˜—˜ K˜%K˜:—K˜'Kšœ žœ˜K˜"K˜P—Kšžœ˜Kšœ/žœ˜5Kšžœ˜Kšœ)žœ˜/Kšœ+žœ˜1Kšžœ˜Kšœ˜K˜—˜K˜————…—Ž&v