-- file PackCodeImplA.mesa
-- last edited by Lewis 6-Dec-82 14:09:07
-- last edited by Satterthwaite, December 29, 1982 12:06 pm
DIRECTORY
Alloc USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top, Words],
BcdDefs,
BcdOps USING [MTHandle, NameString],
BcdUtilDefs: TYPE USING [EnterName],
CatchFormat USING [EnableHandle, EnableItem, EnableTableBody],
CharIO,
CIFS: TYPE USING [OpenFile, GetFC],
CodePackProcs USING [
EnumerateCodePacks, EnumerateModules, EnumerateProcs, EnumerateSegments,
HtiForCodePackNode, IsDiscardCodePack, ModuleIndex, SubStringForCodePackNode,
SubStringForSegmentNode, TreeIndex],
Environment USING [Byte, bytesPerPage, bytesPerWord, wordsPerPage],
Error USING [EmptyCodePack, ErrorFile, SegmentTooLarge],
FileStream: TYPE USING [Create, GetIndex, GetLeaderProperties],
FileTable USING [HandleForFile, UnknownFile],
FramePackModules USING [
EnumerateFramePacks, EnumerateModules, SubStringForFramePackNode],
HashOps USING [HTIndex],
Inline USING [LongCOPY, LongDiv, LongDivMod, LongMult, LowHalf],
ModuleSymbols,
Mopcodes USING [zJIB],
PackagerDefs USING [packtreetype, globalData, GlobalData],
PackageSymbols,
PackCode,
PieceTable USING [
Append, AppendPage, AppendQuadWord, AppendWord, CopyFromFile, Delete,
Finalize, GetByte, GetPlace, GetVPos, GetWord, Initialize, Length,
Move, NullPiece, PieceIndex, Place, Position, PutWord, PutZeros, SetVPos, Store],
PrincOps USING [BytePC, CSegPrefix, EntryVectorItem, PrefixHeader],
SourceBcd USING [
bcdBases, bcdHeader, BcdTableLoc, CTreeIndex, Index, LookupSS, moduleCount,
ModuleNum, ModuleNumForMti, nullCTreeIndex, Prev],
Stream USING [Delete, Handle, PutByte, PutBlock],
String,
SymbolOps,
Symbols,
Table USING [Base, Limit],
Time USING [Append, Current, Packed, Unpack],
Tree: FROM "PackTree" USING [Index];
PackCodeImplA: PROGRAM
IMPORTS
Alloc, BcdUtilDefs, CharIO, CIFS, CodePackProcs, Error, FileStream, FileTable,
FramePackModules, Inline, ModuleSymbols, PackagerDefs, PackCode,
PieceTable, SourceBcd, Stream, String, SymbolOps, Time
EXPORTS PackCode =
BEGIN OPEN PackCode;
-- private data structures
WordIndexSeqBody: TYPE = RECORD [SEQUENCE COMPUTED NAT OF WordIndex];
WordIndexSeq: TYPE = LONG POINTER TO WordIndexSeqBody;
SeenModuleSeqBody: TYPE = RECORD[
SEQUENCE COMPUTED [0..1024) OF SeenModuleHandle];
SeenModuleSeq: TYPE = LONG POINTER TO SeenModuleSeqBody;
Address: TYPE = [0..77777b]; -- max of 32K
WordIndex: TYPE = PackageSymbols.WordIndex;
NullWordIndex: WordIndex = WordIndex.LAST;
BodyDataRec: TYPE = RECORD [
oldPC: PrincOps.BytePC, bytes: CARDINAL,
newPC: PrincOps.BytePC ← [0], pending: FixupHandle ← NIL];
FixupRec: TYPE = RECORD [
next: FixupHandle,
loc: LONG CARDINAL,
target: PrincOps.BytePC];
FixupHandle: TYPE = LONG POINTER TO FixupRec;
SeenModuleRecord: TYPE = RECORD [
newOffset: Address, -- of entry vector within segment
newPiece: PieceTable.PieceIndex, -- of beginning of vector
oldCodeFile: CIFS.OpenFile,
oldCodePosition: LONG CARDINAL,
newConstants: WordIndexSeq ← NIL, -- of new constant values
enablePlace: PieceTable.Place ← [PieceTable.NullPiece, 0, 0],
discarded: BOOL ← FALSE,
thisSeg: BOOL ← TRUE,
body: SEQUENCE nBodies: [0..128] OF BodyDataRec ← NULL];
SeenModuleHandle: TYPE = LONG POINTER TO SeenModuleRecord;
-- state variables
gd: PackagerDefs.GlobalData;
z: UNCOUNTED ZONE ← NIL;
table: Alloc.Handle ← NIL;
tb, spb, sgb, fpb: Table.Base;
itb, etb, ctb, mtb, ntb, lfb: Table.Base;
ssb: BcdOps.NameString;
NotifyA: Alloc.Notifier =
BEGIN
tb ← base[PackagerDefs.packtreetype];
sgb ← base[BcdDefs.sgtype];
spb ← base[BcdDefs.sptype];
fpb ← base[BcdDefs.fptype];
ssb ← base[BcdDefs.sstype];
itb ← base[BcdDefs.imptype];
etb ← base[BcdDefs.exptype];
ctb ← base[BcdDefs.cttype];
mtb ← base[BcdDefs.mttype];
ntb ← base[BcdDefs.nttype];
lfb ← base[BcdDefs.lftype];
NotifyB[base];
END;
EntryIndex: TYPE = [0..PackageSymbols.MaxEntries];
PackError: PUBLIC SIGNAL [reason: PackCode.Problem] = CODE;
cstb: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.ConstRecord;
seenModules: SeenModuleSeq ← NIL;
cur: SeenModuleHandle;
newConstants: WordIndexSeq ← NIL;
oldCodeFile: PUBLIC CIFS.OpenFile;
oldCodeBasePosition: LONG CARDINAL;
currentModule: BcdDefs.MTIndex;
currentCodePackHti: HashOps.HTIndex;
firstCodeSgi: BcdDefs.SGIndex;
currentCodeSegment: BcdDefs.SGIndex;
currentSpaceIndex: BcdDefs.SPIndex;
segmentPosition: PieceTable.Position;
codePackPosition: PieceTable.Position;
codeBasePosition: PieceTable.Position;
codeBaseOffset: Address; -- from start of code segment
procOffset, oldProcOffset: CARDINAL; -- from codeBase
procPosition: PieceTable.Position;
lastProcEnd: PieceTable.Position;
firstCodePack, currentCodePackResident: BOOL;
outStream: Stream.Handle;
WriteChar: PROC [c: CHARACTER] =
{IF gd.mapStream # NIL THEN CharIO.PutChar[gd.mapStream, c]};
WriteString: PROC [s: LONG STRING] =
{IF gd.mapStream # NIL THEN CharIO.PutString[gd.mapStream, s]};
WriteSubString: PROC [ss: String.SubString] =
BEGIN
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
WriteChar[ss.base[i]];
ENDLOOP;
END;
WriteDecimal: PROC [n: CARDINAL] =
{IF gd.mapStream # NIL THEN CharIO.PutDecimal[gd.mapStream, n]};
WriteOctal: PROC [n: CARDINAL] =
{IF gd.mapStream # NIL THEN CharIO.PutOctal[gd.mapStream, n]};
WriteNumber: PROC [n: CARDINAL, fmt: CharIO.NumberFormat] =
{IF gd.mapStream # NIL THEN CharIO.PutNumber[gd.mapStream, n, fmt]};
WriteTime: PROC [t: Time.Packed] =
BEGIN
s: STRING ← [20];
Time.Append[s, Time.Unpack[t]];
WriteString[s];
END;
PagesForWords: PROC [nWords: CARDINAL] RETURNS [CARDINAL] = {
RETURN [(nWords + (Environment.wordsPerPage-1))/Environment.wordsPerPage]};
Initialize: PROC [nModules: CARDINAL] =
BEGIN
gd ← PackagerDefs.globalData;
table ← gd.ownTable;
z ← gd.zone;
table.AddNotify[NotifyA];
PackCode.InitBcdTab[];
seenModules ← z.NEW[SeenModuleSeqBody[nModules]];
FOR i: CARDINAL IN [0..nModules) DO seenModules[i] ← NIL ENDLOOP;
nMods ← nModules;
END;
nMods: CARDINAL;
FixupCodeByteOffset: PROC =
BEGIN
loc: LONG CARDINAL = PieceTable.GetVPos[];
target: PrincOps.BytePC = PieceTable.GetWord[];
FOR ep: CARDINAL IN [0..cur.nBodies) DO
old, new: PrincOps.BytePC;
bytes: CARDINAL;
[oldPC: old, newPC: new, bytes: bytes] ← cur[ep];
IF target IN [old..old+bytes) THEN
BEGIN
IF new = 0 THEN {
f: FixupHandle = z.NEW[FixupRec ← [
next: cur[ep].pending, loc: loc, target: target]];
cur[ep].pending ← f;
RETURN};
PieceTable.Delete[-2];
PieceTable.PutWord[target - old + new];
RETURN;
END;
ENDLOOP;
ERROR PackError[StrangeLIO];
END;
NoteNewPC: PROC [ep: CARDINAL, new: PrincOps.BytePC] =
BEGIN
IF cur[ep].pending # NIL THEN
BEGIN
vicinity: PieceTable.Place ← PieceTable.GetPlace[];
savePos: LONG CARDINAL = PieceTable.GetVPos[];
old: PrincOps.BytePC;
f: FixupHandle;
[oldPC: old, pending: f] ← cur[ep];
WHILE f # NIL DO
fn: FixupHandle = f.next;
PieceTable.SetVPos[f.loc];
PieceTable.Delete[2];
PieceTable.PutWord[f.target - old + new];
z.FREE[@f];
f ← fn;
ENDLOOP;
PieceTable.SetVPos[savePos, @vicinity];
cur[ep].pending ← NIL;
END;
cur[ep].newPC ← new;
END;
FixupCodeOffset: PROC =
BEGIN
old: CARDINAL = PieceTable.GetWord[];
new: CARDINAL = NewOffset[old];
PieceTable.Delete[-2];
PieceTable.PutWord[new];
END;
Finalize: PUBLIC PROC =
BEGIN
IF table # NIL THEN table.DropNotify[NotifyA];
IF seenModules = NIL THEN RETURN;
FOR i: CARDINAL IN [0..nMods) DO
cur ← seenModules[i];
IF cur = NIL THEN LOOP;
IF cur.newConstants # NIL THEN z.FREE[@cur.newConstants];
IF cur.oldCodeFile # NIL THEN cur.oldCodeFile ← NIL;
FOR ep: CARDINAL IN [0..cur.nBodies) DO
IF cur[ep].pending # NIL THEN
BEGIN
f: FixupHandle ← cur[ep].pending;
IF ~cur.discarded THEN SIGNAL PackError[StrangeLIO];
WHILE f # NIL DO
fn: FixupHandle ← f.next;
z.FREE[@f]; f ← fn;
ENDLOOP;
END;
ENDLOOP;
z.FREE[@cur];
ENDLOOP;
PackCode.FinalizeBcdTab[];
IF seenModules # NIL THEN z.FREE[@seenModules];
table ← NIL;
END;
FixLoads: PROC [
lc: PackageSymbols.PCSeq, start: PrincOps.BytePC, bytes: CARDINAL,
FixProc: PROC] =
BEGIN
l, u, i: INTEGER;
stop: PrincOps.BytePC = [start + bytes];
pci: PrincOps.BytePC;
l ← 0; u ← lc.length;
IF u = 0 THEN RETURN;
UNTIL l > u DO
i ← (l+u)/2;
SELECT lc[i] FROM
< start => l ← i+1;
> start => u ← i-1;
ENDCASE => EXIT;
REPEAT
FINISHED => i ← l;
ENDLOOP;
-- lc[i] >= start;
WHILE CARDINAL[i] < lc.length AND (pci ← lc[i]) < stop DO
IF pci >= start THEN {
PieceTable.SetVPos[procPosition + pci - oldProcOffset + 1];
FixProc[]};
i ← i + 1;
ENDLOOP;
END;
FixJumpImmediates: PROC [
jc: PackageSymbols.JISeq, start: PrincOps.BytePC, bytes: CARDINAL] =
BEGIN
l, u, i: INTEGER;
op: Environment.Byte;
stop: PrincOps.BytePC = [start + bytes];
pci: PrincOps.BytePC;
l ← 0; u ← jc.length;
IF u = 0 THEN RETURN;
UNTIL l > u DO
i ← (l+u)/2;
SELECT jc[i].pc FROM
< start => l ← i+1;
> start => u ← i-1;
ENDCASE => EXIT;
REPEAT
FINISHED => i ← l;
ENDLOOP;
-- jc[i].pc >= start;
IF i < 0 THEN ERROR PackError[InvalidCodeOffset];
WHILE CARDINAL[i] < jc.length AND (pci ← jc[i].pc) < stop DO
IF pci >= start THEN {
size: CARDINAL ← jc[i].tableSize;
savePos: PieceTable.Position;
newTableOffset, oldTableOffset: WordIndex;
PieceTable.SetVPos[procPosition + pci - oldProcOffset];
op ← PieceTable.GetByte[];
oldTableOffset ← PieceTable.GetWord[];
savePos ← PieceTable.GetVPos[];
IF op = Mopcodes.zJIB THEN size ← (size+1)/2;
newTableOffset ← CodeOffset[PieceTable.AppendWord[]];
PieceTable.CopyFromFile[
file: oldCodeFile,
position: oldCodeBasePosition+oldTableOffset*2,
length: size*2];
PieceTable.SetVPos[savePos];
PieceTable.Delete[-2];
PieceTable.PutWord[newTableOffset]};
i ← i + 1;
ENDLOOP;
END;
NewOffset: PROC [old: WordIndex] RETURNS [WordIndex] =
BEGIN -- address in new segment of multiword constant a "old" in old
l, u, i: INTEGER;
delta: CARDINAL;
l ← 0; u ← LENGTH[cstb];
UNTIL l > u DO
i ← (l+u)/2;
SELECT cstb[i].offset FROM
< old => l ← i+1;
> old => u ← i-1;
ENDCASE => EXIT;
REPEAT
FINISHED => i ← u;
ENDLOOP;
IF i < 0 THEN ERROR PackError[InvalidCodeOffset];
delta ← old - cstb[i].offset;
IF delta > cstb[i].length THEN ERROR PackError[InvalidCodeOffset];
IF newConstants[i] = NullWordIndex THEN
BEGIN
savePos: PieceTable.Position = PieceTable.GetVPos[];
newConstants[i] ← CodeOffset[PieceTable.AppendWord[]];
PieceTable.CopyFromFile[
file: oldCodeFile,
position: oldCodeBasePosition + cstb[i].offset*2,
length: cstb[i].length*2];
PieceTable.SetVPos[savePos];
END;
RETURN[newConstants[i] + delta];
END;
firstBody: BOOL;
CopyModuleBodies: PROC [root: PackageSymbols.OPIndex] RETURNS [stop: BOOL] =
BEGIN OPEN PackageSymbols;
SELECT root FROM
OPEntry => CopyEV[currentModule];
OPCatch => {
length: CARDINAL = cur[cur.nBodies-1].bytes;
IF length # 0
AND cur[cur.nBodies-1].oldPC # 0
THEN {
IF gd.printMap THEN DisplayNumbers[
ep: epCatch, length: length, hti: Symbols.HTNull];
IF firstBody THEN SetupCurrentOffsets[];
CopyOneBody[ep: cur.nBodies-1, length: length,
catch: TRUE, needsFixup: TRUE];
CopyNestedBodies[LENGTH[ModuleSymbols.outerPackArray]-1]}};
ENDCASE => {
IF firstBody THEN SetupCurrentOffsets[];
CopyBodies[root]};
RETURN[FALSE];
END;
SetupCurrentOffsets: PROC =
BEGIN
IF cur = NIL THEN ERROR PackError[EVNotPlaced];
[newOffset: codeBaseOffset,
newPiece: evPlace.pi,
oldCodeFile: oldCodeFile,
oldCodePosition: oldCodeBasePosition,
newConstants: newConstants] ← cur↑;
codeBasePosition ← segmentPosition + 2*codeBaseOffset;
evPlace.pos ← codeBasePosition;
evPlace.filePos ← evPlace.pi.position; -- first two words don't get deleted
firstBody ← FALSE;
END;
CopyBodies: PROC [root: PackageSymbols.OPIndex] =
BEGIN -- copy procedure (and any nested below unless main body)
IF gd.printMap THEN DisplayNumbers[
ep: ModuleSymbols.outerPackArray[root].entryIndex,
length: ModuleSymbols.outerPackArray[root].length,
hti: ModuleSymbols.outerPackArray[root].hti];
CopyOneBody[
ep: ModuleSymbols.outerPackArray[root].entryIndex,
length: ModuleSymbols.outerPackArray[root].length,
catch: FALSE,
needsFixup: ModuleSymbols.outerPackArray[root].needsFixup];
CopyNestedBodies[root];
END;
CopyNestedBodies: PROC [root: PackageSymbols.OPIndex] =
BEGIN
i: PackageSymbols.IPIndex ← ModuleSymbols.outerPackArray[root].firstSon;
IF i # PackageSymbols.IPNull THEN
DO
IF gd.printMap THEN DisplayNumbers[
ep: ModuleSymbols.innerPackArray[i].entryIndex,
length: ModuleSymbols.innerPackArray[i].length,
hti: Symbols.HTNull];
CopyOneBody[
ep: ModuleSymbols.innerPackArray[i].entryIndex,
length: ModuleSymbols.innerPackArray[i].length,
catch: FALSE,
needsFixup: ModuleSymbols.innerPackArray[i].needsFixup];
IF ModuleSymbols.innerPackArray[i].lastSon THEN EXIT;
i ← i+1;
ENDLOOP;
END;
SegmentOffset: PROC [pos: PieceTable.Position] RETURNS [WordIndex] =
BEGIN
new: LONG CARDINAL = pos - segmentPosition;
IF new > LAST[CARDINAL] THEN SIGNAL PackError[SegmentTooBig];
RETURN [Inline.LowHalf[new]/2];
END;
CodeByteOffset: PROC [pos: PieceTable.Position] RETURNS [CARDINAL] =
BEGIN
new: LONG CARDINAL = pos - codeBasePosition;
IF new > LAST[CARDINAL] THEN SIGNAL PackError[SegmentTooBig];
RETURN [Inline.LowHalf[new]];
END;
CodeOffset: PROC [pos: PieceTable.Position] RETURNS [WordIndex] = INLINE
BEGIN
RETURN [CodeByteOffset[pos]/2];
END;
ProcessEnables: PROC [mod: SeenModuleHandle] =
BEGIN
ep: PieceTable.Place;
cLength: CARDINAL;
alsoNested: BOOL ← TRUE;
et: CatchFormat.EnableHandle;
buffer: RECORD [SELECT OVERLAID * FROM
ei => [item: CatchFormat.EnableItem],
aa => [a: ARRAY [0..SIZE[CatchFormat.EnableItem]) OF CARDINAL],
ENDCASE];
cur ← mod;
cur.thisSeg ← FALSE;
ep ← cur.enablePlace;
IF ep.pi = PieceTable.NullPiece THEN RETURN;
SetupCurrentOffsets[];
PieceTable.SetVPos[ep.pos, @ep];
WHILE alsoNested DO
cLength ← PieceTable.GetWord[];
alsoNested ← FALSE;
THROUGH [0..cLength) DO -- assumes SIZE[EnableItem] = 3
temp: CARDINAL;
FixupCodeByteOffset[];
[] ← PieceTable.GetWord[];
temp ← PieceTable.GetWord[];
alsoNested ← alsoNested OR (temp MOD 2 # 0);
ENDLOOP;
-- ****** Now sort the damned things *****
IF cLength = 0 THEN EXIT;
PieceTable.Move[-cLength*SIZE[CatchFormat.EnableItem]*2];
et ← z.NEW[CatchFormat.EnableTableBody[cLength]];
FOR i: CARDINAL IN [0..cLength) DO
FOR j: CARDINAL IN [0..SIZE[CatchFormat.EnableItem]) DO
buffer.a[j] ← PieceTable.GetWord[];
ENDLOOP;
et[i] ← buffer.item;
ENDLOOP;
SortEnables[et];
PieceTable.Delete[-cLength*SIZE[CatchFormat.EnableItem]*2];
FOR i: CARDINAL IN [0..cLength) DO
buffer.item ← et[i];
FOR j: CARDINAL IN [0..SIZE[CatchFormat.EnableItem]) DO
PieceTable.PutWord[buffer.a[j]];
ENDLOOP;
ENDLOOP;
z.FREE[@et];
ENDLOOP;
END;
SortEnables: PROC [et: CatchFormat.EnableHandle] =
BEGIN
n: CARDINAL = et.count;
i: CARDINAL;
temp: CatchFormat.EnableItem;
SiftUp: PROC [l, u: CARDINAL] =
BEGIN
s: CARDINAL;
key: CatchFormat.EnableItem ← et[l-1];
DO
s ← l*2;
IF s > u THEN EXIT;
IF s < u AND et[s+1-1].start > et[s-1].start THEN s ← s+1;
IF key.start > et[s-1].start THEN EXIT;
et[l-1] ← et[s-1];
l ← s;
ENDLOOP;
et[l-1] ← key;
END;
FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
FOR i DECREASING IN [2..n] DO
SiftUp[1, i];
temp ← et[1-1];
et[1-1] ← et[i-1];
et[i-1] ← temp;
ENDLOOP;
END;
CopyOneBody: PROC [ep: EntryIndex, length: CARDINAL, catch, needsFixup: BOOL] =
BEGIN
eviOffset: POINTER;
codeLength: CARDINAL ← length;
vicinity: PieceTable.Place;
-- copy code into output file
procPosition ← IF catch THEN PieceTable.AppendWord[] ELSE PieceTable.Append[];
procOffset ← CodeByteOffset[procPosition];
vicinity ← PieceTable.GetPlace[];
-- fix up entry vector for module
eviOffset ← @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep]) - 1;
PieceTable.SetVPos[
codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL], @evPlace];
oldProcOffset ← PieceTable.GetWord[];
PieceTable.Delete[-2];
IF catch AND length = 0 THEN procOffset ← 0;
PieceTable.PutWord[procOffset];
PieceTable.SetVPos[procPosition, @vicinity];
IF catch AND length = 0 THEN RETURN;
PieceTable.CopyFromFile[
file: oldCodeFile,
position: oldProcOffset + oldCodeBasePosition,
length: length];
NoteNewPC[ep: ep, new: [procOffset]];
IF catch THEN
BEGIN
cLength: CARDINAL;
delta: CARDINAL = procOffset - oldProcOffset;
-- update entry vector, etc.
PieceTable.SetVPos[procPosition, @vicinity];
-- we are at the catch entry vector
cLength ← PieceTable.GetWord[];
THROUGH [0..cLength) DO
cOffset: CARDINAL = PieceTable.GetWord[];
PieceTable.Delete[-2];
PieceTable.PutWord[cOffset + delta];
ENDLOOP;
-- wait to do enables until we are sure of no pending fixups
cLength ← PieceTable.GetWord[];
IF cLength # 0 THEN cur.enablePlace ← PieceTable.GetPlace[];
END;
-- now get ready to look for multiword constants
IF needsFixup THEN {
FixLoads[
lc: ModuleSymbols.loadCodeOffsetTable,
start: [oldProcOffset],
bytes: length,
FixProc: FixupCodeOffset];
FixLoads[
lc: ModuleSymbols.loadCodeByteOffsetTable,
start: [oldProcOffset],
bytes: length,
FixProc: FixupCodeByteOffset];
FixJumpImmediates[
jc: ModuleSymbols.jumpIndirectTable,
start: [oldProcOffset],
bytes: length]};
END;
CreateNewSegment: PROC [segNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
BEGIN
endPosition: PieceTable.Position;
base, pages: CARDINAL;
desc: String.SubStringDescriptor;
CodePackProcs.SubStringForSegmentNode[@desc, segNode];
IF gd.printMap THEN
BEGIN
WriteString["\nSegment: "L]; WriteSubString[@desc];
WriteChar['\n];
WriteChar['\n];
END;
currentCodeSegment ← table.Words[BcdDefs.sgtype, SIZE[BcdDefs.SGRecord]];
currentSpaceIndex ← table.Words[BcdDefs.sptype, SIZE[BcdDefs.SPRecord]];
spb[currentSpaceIndex] ← [
name: BcdUtilDefs.EnterName[@desc], seg: currentCodeSegment,
length: 0, spaces: NULL];
segmentPosition ← PieceTable.AppendPage[];
firstCodePack ← TRUE;
CodePackProcs.EnumerateCodePacks[segNode, CreateCodePack
! PackError =>
IF reason = SegmentTooBig THEN Error.SegmentTooLarge[error, @desc]];
IF ~firstCodePack THEN FinishCodePack[];
endPosition ← PieceTable.Length[];
base ← Inline.LongDiv[segmentPosition, Environment.bytesPerPage];
pages ← PagesForWords[(CARDINAL[endPosition - segmentPosition]+1)/2];
sgb[currentCodeSegment] ← [
class: code,
file: BcdDefs.FTSelf,
base: base,
pages: pages,
extraPages: 0];
FOR i: CARDINAL IN [0..nMods) DO
mod: SeenModuleHandle = seenModules[i];
IF mod # NIL AND mod.thisSeg THEN ProcessEnables[mod];
ENDLOOP;
RETURN[FALSE];
END;
CreateFramePack: PROC [fpNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
BEGIN
fpi: BcdDefs.FPIndex = table.Words[BcdDefs.fptype, SIZE[BcdDefs.FPRecord]];
desc: String.SubStringDescriptor;
name: BcdDefs.NameRecord;
totalWordsWCodeLinks, totalWordsWFrameLinks, inLastPage: CARDINAL ← 0;
AddModToPack: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOL] = {
n: CARDINAL = fpb[fpi].length;
offset: CARDINAL ← 0;
[] ← table.Words[BcdDefs.fptype, SIZE[BcdDefs.MTIndex]];
fpb[fpi].modules[n] ← mti;
fpb[fpi].length ← n+1;
IF gd.printMap THEN {
mth: BcdOps.MTHandle = @mtb[mti];
linkArea: CARDINAL =
(IF mth.links # BcdDefs.LFNull
THEN lfb[mth.links].length*SIZE[BcdDefs.Link]
ELSE 0);
-- print frame size and offset assuming codelinks
IF (mth.linkLoc = code AND mth.code.linkspace) THEN
offset ← ((totalWordsWCodeLinks+3)/4)*4
ELSE -- links before frame
offset ← ((totalWordsWCodeLinks + linkArea+3)/4)*4;
WriteNumber[mth.framesize, Decimal6];
WriteNumber[offset, Octal7]; WriteChar['B];
totalWordsWCodeLinks ← offset + mth.framesize;
-- now, assuming framelinks only
offset ← ((totalWordsWFrameLinks + linkArea+3)/4)*4;
WriteNumber[mth.framesize, Decimal6];
WriteNumber[offset, Octal7]; WriteChar['B];
totalWordsWFrameLinks ← (offset + mth.framesize);
WriteString[" "L];
[] ← WriteName[mth.name];
WriteChar['\n]};
RETURN[FALSE]};
FramePackModules.SubStringForFramePackNode[@desc, fpNode];
fpb[fpi].name ← name ← BcdUtilDefs.EnterName[@desc];
IF gd.printMap THEN {
WriteString["\nFrame Pack: "L];
[] ← WriteName[name];
WriteString["\nLoad description\n"L];
WriteString["w/ codelinks framelinks only\n"L];
WriteString["Length offset length offset Module\n"L]};
fpb[fpi].length ← 0;
FramePackModules.EnumerateModules[fpNode, AddModToPack];
IF gd.printMap THEN {
inLastPage ← totalWordsWCodeLinks MOD Environment.wordsPerPage;
WriteNumber[Environment.wordsPerPage - inLastPage, Decimal6];
WriteString[" "L];
inLastPage ← totalWordsWFrameLinks MOD Environment.wordsPerPage;
WriteNumber[Environment.wordsPerPage - inLastPage, Decimal6];
WriteString[" unused\n"L];
WriteNumber[PagesForWords[totalWordsWCodeLinks], Decimal6];
WriteString[" "L];
WriteNumber[PagesForWords[totalWordsWFrameLinks], Decimal6];
WriteString[" frame pack pages\n\n"L]};
RETURN[FALSE];
END;
StartModule: PROC [mti: BcdDefs.MTIndex] =
BEGIN
mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
currentModule ← mti;
cur ← seenModules[mNum];
cstb ← ModuleSymbols.constArray;
firstBody ← TRUE;
END;
CopyEV: PROC [mti: BcdDefs.MTIndex] =
BEGIN
mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
mth: BcdOps.MTHandle = @mtb[mti];
cd: BcdDefs.CodeDesc ← mth.code;
file: BcdDefs.FTIndex = mth.file;
name: BcdDefs.NameRecord = mth.name;
sgr: BcdDefs.SGRecord = SourceBcd.bcdBases.sgb[cd.sgi];
nEntries: CARDINAL = LENGTH[ModuleSymbols.outerPackArray] +
LENGTH[ModuleSymbols.innerPackArray];
evWords: CARDINAL = SIZE[PrincOps.CSegPrefix] +
nEntries * SIZE[PrincOps.EntryVectorItem];
oldCodeFile ← FileTable.HandleForFile[sgr.file];
oldCodeBasePosition ← 2 *
(Inline.LongMult[sgr.base-1, Environment.wordsPerPage] + LONG[cd.offset]);
IF mth.linkLoc = code THEN
BEGIN
pos: LONG CARDINAL ← PieceTable.AppendWord[];
lfi: BcdDefs.LFIndex = mth.links;
fLength: CARDINAL = lfb[lfi].length;
delta: CARDINAL ← (CARDINAL[Inline.LowHalf[pos]] + fLength) MOD 4;
IF delta # 0 THEN delta ← 4 - delta;
PieceTable.PutZeros[(fLength + delta)*2];
cd.linkspace ← TRUE;
END;
codeBasePosition ← PieceTable.AppendQuadWord[];
codeBaseOffset ← SegmentOffset[codeBasePosition];
IF gd.printMap THEN
DisplayNumbers[ep: epEv, length: evWords*2, hti: Symbols.HTNull];
PieceTable.CopyFromFile[
file: oldCodeFile,
position: oldCodeBasePosition,
length: evWords*2];
evPlace ← PieceTable.GetPlace[];
-- update seenModules array entry
IF LENGTH[cstb] = 0 THEN newConstants ← NIL
ELSE
BEGIN
SetBlock: PROC [p: LONG POINTER, v: UNSPECIFIED, n: CARDINAL] = INLINE {
p↑ ← v; Inline.LongCOPY[from: p, to: (p+1), nwords: (n-1)]};
newConstants ← z.NEW[WordIndexSeqBody[LENGTH[cstb]]];
SetBlock[
p: newConstants,
v: NullWordIndex,
n: LENGTH[cstb] * SIZE[WordIndex]];
END;
cur ← z.NEW[SeenModuleRecord[nEntries] ← [
newOffset: codeBaseOffset,
newPiece: evPlace.pi,
oldCodeFile: oldCodeFile,
oldCodePosition: oldCodeBasePosition,
newConstants: newConstants]];
PieceTable.SetVPos[codeBasePosition + SIZE[PrincOps.PrefixHeader]*2];
FOR ep: NAT IN [0..nEntries) DO
cur[ep] ← [oldPC: PieceTable.GetWord[], bytes: ];
ENDLOOP;
FOR i: NAT IN [0..LENGTH[ModuleSymbols.outerPackArray]) DO
ep: EntryIndex;
bytes: CARDINAL;
[entryIndex: ep, length: bytes] ← ModuleSymbols.outerPackArray[i];
cur[ep].bytes ← bytes;
ENDLOOP;
FOR i: NAT IN [0..LENGTH[ModuleSymbols.innerPackArray]) DO
ep: EntryIndex;
bytes: CARDINAL;
[entryIndex: ep, length: bytes] ← ModuleSymbols.innerPackArray[i];
cur[ep].bytes ← bytes;
ENDLOOP;
seenModules[mNum] ← cur;
-- update module table in bcd
cd.offset ← codeBaseOffset;
cd.sgi ← currentCodeSegment;
cd.length ← 0;
BEGIN -- look for all prototypes of this name
desc: String.SubStringDescriptor ← [
base: @ssb.string,
offset: name,
length: ssb.size[name]];
cTreeNode: SourceBcd.CTreeIndex ← SourceBcd.LookupSS[@desc, prototype];
WHILE cTreeNode # SourceBcd.nullCTreeIndex DO
index: SourceBcd.BcdTableLoc = cTreeNode.Index;
WITH ctr: index SELECT FROM
module =>
BEGIN
pmth: BcdOps.MTHandle = @mtb[ctr.mti];
IF pmth.file = file THEN pmth.code ← cd;
END;
ENDCASE;
cTreeNode ← cTreeNode.Prev[$prototype];
ENDLOOP;
END;
END;
evPlace: PieceTable.Place;
CopyFakeModule: PROC [mti: BcdDefs.MTIndex] =
BEGIN
mth: BcdOps.MTHandle = @mtb[mti];
cd: BcdDefs.CodeDesc ← mth.code;
file: BcdDefs.FTIndex = mth.file;
name: BcdDefs.NameRecord = mth.name;
sgr: BcdDefs.SGRecord = SourceBcd.bcdBases.sgb[cd.sgi];
oldCodeFile ← FileTable.HandleForFile[sgr.file];
oldCodeBasePosition ← 2 *
(Inline.LongMult[sgr.base-1, Environment.wordsPerPage] + LONG[cd.offset]);
codeBasePosition ← PieceTable.AppendQuadWord[];
codeBaseOffset ← SegmentOffset[codeBasePosition];
IF gd.printMap THEN
DisplayNumbers[ep: epEv, length: cd.length, hti: Symbols.HTNull];
PieceTable.CopyFromFile[
file: oldCodeFile,
position: oldCodeBasePosition,
length: cd.length];
IF (codeBaseOffset + cd.length) > LAST[CARDINAL] THEN PackError[SegmentTooBig];
-- update module table in bcd
cd.offset ← codeBaseOffset;
cd.sgi ← currentCodeSegment;
cd.length ← 0;
BEGIN -- look for all prototypes of this name
desc: String.SubStringDescriptor ← [
base: @ssb.string,
offset: name,
length: ssb.size[name]];
cTreeNode: SourceBcd.CTreeIndex ← SourceBcd.LookupSS[@desc, prototype];
WHILE cTreeNode # SourceBcd.nullCTreeIndex DO
index: SourceBcd.BcdTableLoc = cTreeNode.Index;
WITH ctr: index SELECT FROM
module =>
BEGIN
pmth: BcdOps.MTHandle = @mtb[ctr.mti];
IF pmth.file = file THEN pmth.code ← cd;
END;
ENDCASE;
cTreeNode ← cTreeNode.Prev[$prototype];
ENDLOOP;
END;
END;
DiscardAllInPack: PROC [cpNode: CodePackProcs.TreeIndex] =
BEGIN
CodePackProcs.EnumerateModules[cpNode, DiscardThisModule];
END;
DiscardThisModule: PROC [mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
RETURNS [BOOL] =
BEGIN
StartModule[mti];
SetupCurrentOffsets[]; -- you can't discard the EV, it should be already out
CodePackProcs.EnumerateProcs[module, DiscardModuleProc];
newConstants ← NIL;
RETURN[FALSE]
END;
DiscardModuleProc: PROC [root: PackageSymbols.OPIndex] RETURNS [stop: BOOL] =
BEGIN
SELECT root FROM
PackageSymbols.OPEntry => ERROR PackError[EVNotPlaced];
PackageSymbols.OPCatch =>
DiscardThisProc[LENGTH[ModuleSymbols.outerPackArray]-1];
ENDCASE => DiscardThisProc[root];
RETURN[FALSE];
END;
DiscardThisProc: PROC [root: PackageSymbols.OPIndex] =
BEGIN -- copy procedure (and any nested below unless main body)
DiscardOneBody[ModuleSymbols.outerPackArray[root].entryIndex];
DiscardNested[root];
END;
DiscardNested: PROC [root: PackageSymbols.OPIndex] =
BEGIN
i: PackageSymbols.IPIndex ← ModuleSymbols.outerPackArray[root].firstSon;
IF i # PackageSymbols.IPNull THEN
DO
DiscardOneBody[ModuleSymbols.innerPackArray[i].entryIndex];
IF ModuleSymbols.innerPackArray[i].lastSon THEN EXIT;
i ← i+1;
ENDLOOP;
END;
DiscardOneBody: PROC [ep: EntryIndex] =
BEGIN
eviOffset: POINTER;
-- fix up entry vector for module (works for catch stuff, too)
eviOffset ← @(LOOPHOLE[1, POINTER TO PrincOps.CSegPrefix].entry[ep]) - 1;
PieceTable.SetVPos[codeBasePosition + 2*LOOPHOLE[eviOffset, CARDINAL]];
PieceTable.Delete[2];
PieceTable.PutWord[0];
cur.discarded ← TRUE; -- something is discarded from this module
END;
CreateCodePack: PROC [cpNode: CodePackProcs.TreeIndex] RETURNS [BOOL] =
BEGIN
saveIndex: CARDINAL = gd.textIndex;
offset, pages: CARDINAL;
spii: Table.Base RELATIVE POINTER [0..Table.Limit) TO BcdDefs.SpaceID;
name: BcdDefs.NameRecord;
nameCopy: STRING ← [80];
desc: String.SubStringDescriptor;
endPosition: PieceTable.Position;
discard: BOOL = CodePackProcs.IsDiscardCodePack[cpNode];
gd.textIndex ← tb[LOOPHOLE[cpNode, Tree.Index]].info;
CodePackProcs.SubStringForCodePackNode[@desc, cpNode];
String.AppendSubString[nameCopy, @desc];
desc ← [base: nameCopy, offset: 0, length: nameCopy.length];
name ← BcdUtilDefs.EnterName[@desc];
IF gd.printMap THEN
BEGIN
IF firstCodePack THEN firstCodePack ← FALSE
ELSE FinishCodePack[];
WriteString["Code Pack: "L];
[] ← WriteName[name];
WriteChar['\n];
PrintHeader[];
END;
currentCodePackHti ← CodePackProcs.HtiForCodePackNode[cpNode];
IF discard THEN {DiscardAllInPack[cpNode]; RETURN [FALSE]};
currentCodePackResident ← FALSE; -- set TRUE if any modules resident
lastProcEnd ← codePackPosition ← PieceTable.AppendPage[];
CodePackProcs.EnumerateModules[cpNode, CopyModuleToPack];
endPosition ← PieceTable.Length[];
offset ← Inline.LongDiv[
codePackPosition - segmentPosition, Environment.bytesPerPage];
pages ← PagesForWords[(CARDINAL[endPosition - codePackPosition]+1)/2];
spii ← table.Words[BcdDefs.sptype, SIZE[BcdDefs.SpaceID]];
spb[spii] ← [
name: name, resident: currentCodePackResident,
offset: offset, pages: pages];
spb[currentSpaceIndex].length ← spb[currentSpaceIndex].length + 1;
gd.textIndex ← saveIndex;
RETURN[FALSE]
END;
FinishCodePack: PROC =
BEGIN
endPosition: PieceTable.Position = PieceTable.Append[];
totalBytes: CARDINAL ← Inline.LowHalf[endPosition - codePackPosition];
pages: CARDINAL =
(totalBytes + Environment.bytesPerPage-1)/Environment.bytesPerPage;
gap: CARDINAL;
delta: CARDINAL =
CARDINAL[Inline.LowHalf[endPosition]] MOD Environment.bytesPerPage;
IF gd.printMap THEN {
IF lastProcEnd # 0 AND endPosition > lastProcEnd THEN
NoteData[
offset: SegmentOffset[lastProcEnd],
length: Inline.LowHalf[endPosition-lastProcEnd]];
WriteString["------------\n"L];
IF delta # 0 THEN {
gap ← Environment.bytesPerPage - delta;
WriteNumber[gap, Octal5];
IF gap > 7 THEN WriteChar['B] ELSE WriteChar[' ];
WriteString[" unused bytes (last page has "L];
WriteOctal[delta]; IF delta > 7 THEN WriteChar['B];
WriteString[" bytes)\n"L]};
WriteString["Code pack pages: "L];
WriteDecimal[pages];
WriteChar['\n]; WriteChar['\n]};
IF pages = 0 THEN Error.EmptyCodePack[class: error, cpId: currentCodePackHti];
firstCodePack ← FALSE;
END;
CopyModuleToPack: PROC [mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex]
RETURNS [stop: BOOL] = {
BEGIN
currentModule ← mti;
IF mtb[mti].tableCompiled THEN
CopyFakeModule[mti
! FileTable.UnknownFile --[fti]-- => {
Error.ErrorFile[error, "was needed for code but could not be found"L, fti];
GOTO CodeFileNotFound}]
ELSE {
IF mtb[mti].residentFrame THEN currentCodePackResident ← TRUE;
StartModule[mti
! FileTable.UnknownFile --[fti]-- => {
Error.ErrorFile[error, "was needed for code but could not be found"L, fti];
newConstants ← NIL;
GOTO CodeFileNotFound}];
CodePackProcs.EnumerateProcs[module, CopyModuleBodies];
newConstants ← NIL};
EXITS
CodeFileNotFound => NULL;
END;
RETURN[FALSE]};
ComputeCodePlacement: PUBLIC PROC =
BEGIN ENABLE UNWIND =>
CleanupCodePlacementComputation[ ! PackError => RESUME];
Initialize[SourceBcd.moduleCount];
RemapOldBcd[];
IF gd.errors THEN RETURN;
firstCodeSgi ← LOOPHOLE[table.Top[BcdDefs.sgtype]];
PieceTable.Initialize[];
firstCodePack ← TRUE;
lastProcEnd ← 0;
IF gd.printMap THEN {
WriteString["\nFile "L]; WriteString[gd.mapFileName];
WriteString[" created by Packager from "L]; WriteString[gd.packName];
WriteString[" on "L]; WriteTime[Time.Current[]]; WriteChar['\n]};
CodePackProcs.EnumerateSegments[CreateNewSegment];
FramePackModules.EnumerateFramePacks[CreateFramePack];
IF gd.printMap AND gd.mapStream # NIL THEN {
gd.mapStream.Delete[]; gd.mapStream ← NIL};
END;
CleanupCodePlacementComputation: PROC = {
IF gd.printMap AND gd.mapStream # NIL THEN {
gd.mapStream.Delete[]; gd.mapStream ← NIL};
PieceTable.Finalize[]; Finalize[]};
WriteBcdToFile: PUBLIC PROC =
BEGIN
limitSgi: BcdDefs.SGIndex;
bcdPages, bcdPos, size: CARDINAL;
desc: String.SubStringDescriptor;
byte: CARDINAL;
newHeader: LONG POINTER TO BcdDefs.BCD;
-- open output stream as a byte stream
IF gd.errors THEN RETURN;
outStream ← FileStream.Create[gd.outputBcdFile.GetFC];
-- compute size of new bcd
bcdPos ← SIZE[BcdDefs.BCD];
newHeader ← z.NEW[BcdDefs.BCD ← SourceBcd.bcdHeader↑];
desc ← [base: gd.packName, offset: 0, length: gd.packName.length];
newHeader.source ← BcdUtilDefs.EnterName[@desc];
newHeader.creator ← gd.packagerVersion;
newHeader.sourceVersion ← gd.packVersion;
newHeader.version ← [
time: FileStream.GetLeaderProperties[outStream].create,
net: gd.network,
host: gd.host];
newHeader.repackaged ← TRUE;
size ← table.Bounds[BcdDefs.sstype].size;
newHeader.ssOffset ← bcdPos;
newHeader.ssLimit ← LOOPHOLE[size];
bcdPos ← bcdPos + size;
newHeader.ctOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.ctLimit, CARDINAL];
newHeader.mtOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.mtLimit, CARDINAL];
newHeader.lfOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.lfLimit, CARDINAL];
newHeader.impOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.impLimit, CARDINAL];
newHeader.expOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.expLimit, CARDINAL];
newHeader.evOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.evLimit, CARDINAL];
size ← table.Bounds[BcdDefs.sgtype].size;
newHeader.sgOffset ← bcdPos;
newHeader.sgLimit ← LOOPHOLE[size];
bcdPos ← bcdPos + size;
size ← table.Bounds[BcdDefs.fttype].size;
newHeader.ftOffset ← bcdPos;
newHeader.ftLimit ← LOOPHOLE[size];
bcdPos ← bcdPos + size;
size ← table.Bounds[BcdDefs.sptype].size;
newHeader.spOffset ← bcdPos;
newHeader.spLimit ← LOOPHOLE[size];
bcdPos ← bcdPos + size;
newHeader.ntOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.ntLimit, CARDINAL];
newHeader.typOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.typLimit, CARDINAL];
newHeader.tmOffset ← bcdPos;
bcdPos ← bcdPos + LOOPHOLE[newHeader.tmLimit, CARDINAL];
size ← table.Bounds[BcdDefs.fptype].size;
newHeader.fpOffset ← bcdPos;
newHeader.fpLimit ← LOOPHOLE[size];
bcdPos ← bcdPos + size;
bcdPages ← PagesForWords[bcdPos];
newHeader.nPages ← bcdPages;
limitSgi ← LOOPHOLE[table.Top[BcdDefs.sgtype]];
FOR sgi: BcdDefs.SGIndex ← firstCodeSgi, sgi+SIZE[BcdDefs.SGRecord]
UNTIL sgi = limitSgi DO
sgb[sgi].base ← sgb[sgi].base + bcdPages + 1;
ENDLOOP;
-- write bcd to stream
[] ← PutBlock[
outStream,
newHeader,
SIZE[BcdDefs.BCD]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.sstype].base,
LOOPHOLE[newHeader.ssLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.cttype].base,
LOOPHOLE[newHeader.ctLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.mttype].base,
LOOPHOLE[newHeader.mtLimit]];
[] ← PutBlock[
outStream,
SourceBcd.bcdHeader + SourceBcd.bcdHeader.lfOffset,
LOOPHOLE[newHeader.lfLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.imptype].base,
LOOPHOLE[newHeader.impLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.exptype].base,
LOOPHOLE[newHeader.expLimit]];
[] ← PutBlock[
outStream,
SourceBcd.bcdHeader + SourceBcd.bcdHeader.evOffset,
LOOPHOLE[newHeader.evLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.sgtype].base,
LOOPHOLE[newHeader.sgLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.fttype].base,
LOOPHOLE[newHeader.ftLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.sptype].base,
LOOPHOLE[newHeader.spLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.nttype].base,
LOOPHOLE[newHeader.ntLimit]];
[] ← PutBlock[
outStream,
SourceBcd.bcdHeader + SourceBcd.bcdHeader.typOffset,
LOOPHOLE[newHeader.typLimit]];
[] ← PutBlock[
outStream,
SourceBcd.bcdHeader + SourceBcd.bcdHeader.tmOffset,
LOOPHOLE[newHeader.tmLimit]];
[] ← PutBlock[
outStream,
table.Bounds[BcdDefs.fptype].base,
LOOPHOLE[newHeader.fpLimit]];
z.FREE[@newHeader];
-- fill out to a page boundary
byte ← Inline.LongDivMod[
num: FileStream.GetIndex[outStream],
den: Environment.bytesPerPage].remainder;
IF byte # 0 THEN
THROUGH (byte..Environment.bytesPerPage] DO
outStream.PutByte[0];
ENDLOOP;
-- throw out allocator space and source bcd
END;
PutBlock: PROC [stream: Stream.Handle, p: LONG POINTER, n: CARDINAL] = {
stream.PutBlock[[LOOPHOLE[p], 0, n*Environment.bytesPerWord]]};
WriteCodeToBcdFile: PUBLIC PROC =
BEGIN ENABLE UNWIND => {
PieceTable.Finalize[]; Finalize[]};
-- close piece table
IF ~gd.errors THEN PieceTable.Store[outStream]
ELSE PieceTable.Finalize[];
outStream.Delete[]; outStream ← NIL;
Finalize[];
END;
-- procedures to create new name, file, and segment tables for output bcd
-- update source bcd in place, creating new tables:
-- name table (ssb), file table, and segment table
-- after this update, the following is true:
-- All "name" fields refer to new NameRecords
-- In module table,
-- "sseg" refers to new segment table
-- "code.sgi" refers to old segment table
-- In new segment table, "file" refers to new file table
-- In old segment table, "file" refers to old file table
PrintHeader: PROC =
BEGIN
-- should print bcd version in file
WriteString["Bytes EVI Offset IPC Module"L];
THROUGH [("Module"L).length..modCols] DO WriteChar[' ] ENDLOOP;
WriteString["Procedure\n\n"L];
END;
-- ** Loadmap stuff
modCols: CARDINAL ← 20;
Decimal4: CharIO.NumberFormat =
[base: 10, zerofill: FALSE, unsigned: TRUE, columns: 4];
Decimal5: CharIO.NumberFormat =
[base: 10, zerofill: FALSE, unsigned: TRUE, columns: 5];
Decimal6: CharIO.NumberFormat =
[base: 10, zerofill: FALSE, unsigned: TRUE, columns: 6];
Octal5: CharIO.NumberFormat =
[base: 8, zerofill: FALSE, unsigned: TRUE, columns: 5];
Octal7: CharIO.NumberFormat =
[base: 8, zerofill: FALSE, unsigned: TRUE, columns: 7];
NoteData: PROC [offset, length: CARDINAL] =
BEGIN
WriteNumber[length, Decimal5];
WriteString[" -"L];
WriteNumber[offset, Octal7];
WriteChar['B];
WriteString[" <data>\n"L];
END;
epEv: INTEGER = -1;
epCatch: INTEGER = -2;
epLinks: INTEGER = -3;
DisplayNumbers: PROC [ep: INTEGER, length: CARDINAL, hti: Symbols.HTIndex] =
BEGIN
-- write out module, entry, segOffset, codeOffset
-- called when codeBasePosition and segmentPosition are valid
pos: PieceTable.Position ← PieceTable.Append[];
offset, cols: CARDINAL;
IF lastProcEnd # 0 AND pos > lastProcEnd THEN
NoteData[
offset: SegmentOffset[lastProcEnd],
length: Inline.LowHalf[pos-lastProcEnd]];
lastProcEnd ← pos + length;
WriteNumber[length, Octal5];
IF length > 7 THEN WriteChar['B] ELSE WriteChar[' ];
SELECT ep FROM
epEv => WriteString[" EV"L];
epCatch => WriteString[" Cat"L];
epLinks => WriteString[" LNKS"L];
ENDCASE => WriteNumber[ep, Decimal5];
offset ← Inline.LowHalf[pos - segmentPosition];
WriteNumber[offset, Octal7];
WriteChar['B];
IF ep = epEv OR ep = epLinks THEN
WriteString[" "L]
ELSE
BEGIN
offset ← CodeByteOffset[pos];
WriteNumber[offset, Octal7];
WriteChar['B];
END;
WriteString[" "L];
cols ← WriteName[mtb[currentModule].name];
IF ep >= 0 THEN
BEGIN
THROUGH [cols..modCols) DO WriteChar[' ] ENDLOOP;
WriteChar[' ];
IF ep = 0 THEN WriteString["MAIN"L]
ELSE IF hti = Symbols.HTNull THEN
WriteString[" <nested>"L]
ELSE [] ← WriteProcName[hti]
END;
WriteChar['\n];
END;
WriteName: PROC [name: BcdDefs.NameRecord] RETURNS [length: CARDINAL] =
BEGIN
desc: String.SubStringDescriptor;
desc ← [base: @ssb.string, offset: name, length: ssb.size[name]];
WriteSubString[@desc];
RETURN [desc.length];
END;
WriteProcName: PROC [hti: Symbols.HTIndex] RETURNS [length: CARDINAL] =
BEGIN
desc: String.SubStringDescriptor;
IF hti = Symbols.HTNull THEN RETURN[0];
SymbolOps.SubStringForHash[@desc, hti];
WriteSubString[@desc];
RETURN [desc.length];
END;
END.