DIRECTORY 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, bytesPerWord, wordsPerPage], PrincOpsUtils: TYPE USING [LowHalf], 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, PrincOpsUtils, Rope, TableCommand, UnsafeStorage EXPORTS PGSConDefs = { StreamIndex: TYPE = INT; -- FileStream.FileByteIndex bytesPerWord: CARDINAL = PrincOps.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 _ PrincOpsUtils.LowHalf[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]}; WriteBcd: PROC [out: IO.STREAM] = { ssb _ Rope.Flatten[ssb]; -- so we can blt it out out.UnsafePutBlock[[@bcdHeader, 0, BcdDefs.BCD.SIZE*bytesPerWord]]; out.UnsafePutBlock[[LOOPHOLE[ssb], 0, StringBody[ssb.Length[]].SIZE*bytesPerWord]]; moduleIndex _ IO.GetIndex[out]; out.UnsafePutBlock[[@module, 0, BcdDefs.MTRecord.direct.SIZE*bytesPerWord]]; segIndex _ IO.GetIndex[out]; out.UnsafePutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]]; out.UnsafePutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]]; IF export # NIL THEN { out.UnsafePutBlock[[@defsFile, 0, BcdDefs.FTRecord.SIZE*bytesPerWord]]; out.UnsafePutBlock[[export, 0, (BcdDefs.EXPRecord.SIZE+export.size)*bytesPerWord]]; 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 { dotIndex: INT _ Rope.Find[binaryId, "."]; IF dotIndex < 0 THEN moduleId _ binaryId ELSE moduleId _ Rope.Substr[binaryId, 0, dotIndex]}; 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]; IO.SetIndex[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]; out.UnsafePutBlock[[@module, 0, BcdDefs.MTRecord.direct.SIZE*bytesPerWord]]; IO.SetIndex[out, segIndex]; out.UnsafePutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]]; out.UnsafePutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]]; IO.SetIndex[out, endIndex]}; }. (file PGSBcd.mesa last modified by Satterthwaite, November 2, 1982 11:19 am Last Edited by: Maxwell, August 8, 1983 2:34 pm 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 ?? ʤ˜Jšœ™Jšœ9™9J™/J˜šÏk ˜ Jšœ œ˜Jšœ œœ ˜ Jšœœœœ˜Ešœ œœ˜J˜KJ˜9—Jšœ œœ,˜@Jšœœœ ˜$Jšœœœ(œ ˜FJšœœœ)˜AJšœœœ˜7J˜—šœ˜Jšœœ>˜HJšœ˜J˜Jšœ œœÏc˜4Jšœœ˜/J˜Jšœ™˜Jšœœ˜J˜ Jšœ˜J˜J˜%Jšœ œ˜J˜Jšœœœ˜Jšœ$ž ˜0Jšœœ˜Jšœ œœ"˜˜D—˜J˜——Jšœ™˜šŸœœœ˜Jšœ œœ˜Jšœœž˜3Jšœœž˜;Jšœ œœ˜J˜Jšœ˜Jšœ œœ˜(šœ˜Jšœ œ˜)Jšœœ˜)Jšœ0˜4—J˜J˜*Jšœ™Jšœœœ ˜&šœ˜J˜1Jšœ œ˜˜˜.˜ Jšœ ˜J˜J˜.Jšœœ˜ ———Jš œœ œœœ˜@˜7˜ Jšœ ˜J˜J˜-Jšœœ˜ ——J˜!š˜˜ Jšœ ˜J˜Jšœ.œ˜3Jšœ œ˜———Jšœž$˜4J˜Jšœ'˜)J˜—šŸœœœ˜Jšœœ˜/Jšœœ˜)Jšœœ˜+Jšœ3™3J˜J˜Hšœœ˜ J˜Jšœ œ˜šœœœ˜=Jšœœ˜—˜ J˜%J˜:—J˜'Jšœ œ˜J˜"J˜P—Jšœ˜Jšœ8œ˜LJšœ˜Jšœ2œ˜FJšœ4œ˜HJšœ˜J˜J˜J˜————…—–%b