SMModelBcdImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
last edit by Satterthwaite, May 12, 1986 11:58:48 am PDT
DIRECTORY
Basics: TYPE USING [bytesPerWord],
BasicTime: TYPE USING [GMT, ToNSTime],
BcdDefs: TYPE USING [
Base, BCD, BcdBase, ControlItem, CTIndex, CTNull, CTRecord, EVIndex, EVRecord, EVNull,
EXPIndex, EXPRecord, FTHandle, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord,
LFIndex, LFNull, Link, LinkFrag, ModuleIndex, MTHandle, MTIndex, MTRecord, MTNull,
NameRecord, NameString, NTIndex, NTRecord, NullLink, NullModule, NullName, NullVersion,
RefLitFrag, RFIndex, RFNull, SGHandle, SGIndex, SGRecord, SGNull,
TFIndex, TFNull, TypeFrag, VersionID, VersionStamp],
BcdLiterals: TYPE USING [
LiteralState, Create, Finalize, SegmentSize, Load, MapLitLink, MapTypeLink, Unload, Write],
BcdOps: TYPE USING [ProcessFiles, ProcessModules, ProcessSegs],
FS: TYPE USING [OpenFile, Read],
IO: TYPE USING [STREAM, GetLength, SetIndex, SetLength, UnsafePutBlock],
LoaderOpsExtras: TYPE USING [AcquireFileProc],
LoadState: TYPE USING [ModuleIndex],
PrincOps: TYPE USING [bytesPerWord, wordsPerPage],
Rope: TYPE USING [ROPE, Concat, Equal, Fetch, Find, FromProc, Length, Substr],
SMModelBcd: TYPE USING [],
SMTree: TYPE Tree USING [Link],
VM: TYPE USING [AddressForPageNumber, Interval, nullInterval, Allocate, Free];
SMModelBcdImpl: PROGRAM
IMPORTS BasicTime, BcdLiterals, BcdOps, FS, IO, Rope, VM
EXPORTS SMModelBcd ~ {
OPEN Tree~~SMTree;
Bcd: TYPE~REF BcdObject;
BcdObject: PUBLIC TYPE~RECORD[
space: VM.Interval←VM.nullInterval,
base: BcdDefs.BcdBase←NIL,
literals: BcdLiterals.LiteralState←NIL];
MTHandle: PUBLIC TYPE~BcdDefs.MTIndex;
no mds usage
MTPAGE: CARDINAL ~ (BcdDefs.BCD.SIZE/PrincOps.wordsPerPage) + 1;
nmtp: CARDINAL ~ 20;
FTPAGE: CARDINAL ~ MTPAGE + nmtp;
nftp: CARDINAL ~ 6;
SGPAGE: CARDINAL ~ FTPAGE + nftp;
nsgp: CARDINAL ~ 6;
CTPAGE: CARDINAL ~ SGPAGE + nsgp;
nctp: CARDINAL ~ 1;
SSPAGE: CARDINAL ~ CTPAGE + nctp;
nssp: CARDINAL ~ 16;
IMPAGE: CARDINAL ~ SSPAGE + nssp;
nimp: CARDINAL ~ 3;
EXPAGE: CARDINAL ~ IMPAGE + nssp;
nexp: CARDINAL ~ 3;
NTPAGE: CARDINAL ~ EXPAGE + nexp;
nntp: CARDINAL ~ 1;
EVPAGE: CARDINAL ~ NTPAGE + nntp;
nevp: CARDINAL ~ 6;
LFPAGE: CARDINAL ~ EVPAGE + nevp;
nlfp: CARDINAL ~ 12;
RFPAGE: CARDINAL ~ LFPAGE + nlfp;
nrfp: CARDINAL ~ 6;
TFPAGE: CARDINAL ~ RFPAGE + nrfp;
ntfp: CARDINAL ~ 6;
BCDPAGES: CARDINAL ~ TFPAGE + ntfp;
RelPointer: TYPE~BcdDefs.Base RELATIVE POINTER [0..CARDINAL.LAST);
relZero: RelPointer ~ RelPointer.FIRST;
Overflow: PUBLIC ERROR ~ CODE;
Check: PROC[val: RelPointer, limit: CARDINAL] ~ {
IF (val - RelPointer.FIRST) > limit THEN ERROR Overflow};
AddName: PROC[bcd, iBcd: BcdDefs.BcdBase, iName: BcdDefs.NameRecord]
RETURNS[name: BcdDefs.NameRecord] ~ {
nameString: BcdDefs.NameString ~ LOOPHOLE[bcd + bcd.ssOffset];
iNameString: BcdDefs.NameString ~ LOOPHOLE[iBcd + iBcd.ssOffset];
length: CARDINAL ~ iNameString.size[iName];
nChars: CARDINAL ~ length+1; -- includes length byte
name ← [nameString.string.length];
IF StringBody[name+nChars].SIZE > nssp*PrincOps.wordsPerPage THEN ERROR Overflow;
nameString.size[name] ← length;
FOR i: CARDINAL IN [0 .. length) DO
nameString.string.text[name+i] ← iNameString.string.text[iName+i];
ENDLOOP;
nameString.string.length ← name + nChars;
RETURN};
NewName: PROC[bcd: BcdDefs.BcdBase, string: Rope.ROPE]
RETURNS[name: BcdDefs.NameRecord] ~ {
nameString: BcdDefs.NameString ~ LOOPHOLE[bcd + bcd.ssOffset];
length: CARDINAL ~ string.Length;
nChars: CARDINAL ~ length+1; -- includes length byte
name ← [nameString.string.length];
IF StringBody[name+nChars].SIZE > nssp*PrincOps.wordsPerPage THEN ERROR Overflow;
nameString.size[name] ← length;
FOR i: CARDINAL IN [0 .. length) DO
nameString.string.text[name+i] ← string.Fetch[i];
ENDLOOP;
nameString.string.length ← name + nChars;
RETURN};
NewNamed: PROC[bcd: BcdDefs.BcdBase, pair: BcdDefs.NTRecord] ~ {
ntb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.ntOffset];
nti: BcdDefs.NTIndex ~ bcd.ntLimit;
Check[nti + BcdDefs.NTRecord.SIZE, nntp*PrincOps.wordsPerPage];
ntb[nti] ← pair;
bcd.ntLimit ← bcd.ntLimit + BcdDefs.NTRecord.SIZE};
TrimFileName: PROC[name: Rope.ROPE] RETURNS[Rope.ROPE] ~ {
pos: INT ~ name.Find[s2~".bcd", case~FALSE];
RETURN[IF pos > 0 THEN name.Substr[0, pos] ELSE name]};
AddFile: PROC[bcd, iBcd: BcdDefs.BcdBase, ifti: BcdDefs.FTIndex, iFileName: Rope.ROPE]
RETURNS[fti: BcdDefs.FTIndex] ~ {
IF ifti = BcdDefs.FTNull THEN fti ← BcdDefs.FTNull
ELSE {
ftb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.ftOffset];
iFtb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.ftOffset];
version: BcdDefs.VersionStamp ~
(IF ifti = BcdDefs.FTSelf THEN iBcd.version ELSE iFtb[ifti].version);
CheckFile: PROC[fth: BcdDefs.FTHandle, fti: BcdDefs.FTIndex] RETURNS[BOOL] ~ {
RETURN[ftb[fti].version = version]};
fti ← BcdOps.ProcessFiles[bcd, CheckFile].fti;
IF fti = BcdDefs.FTNull THEN {
fti ← bcd.ftLimit;
Check[fti + BcdDefs.FTRecord.SIZE, nftp*PrincOps.wordsPerPage];
ftb[fti] ← [
name~(IF ifti = BcdDefs.FTSelf
THEN NewName[bcd, TrimFileName[iFileName]]
ELSE AddName[bcd, iBcd, iFtb[ifti].name]),
version~version];
bcd.ftLimit ← fti + BcdDefs.FTRecord.SIZE};
};
RETURN};
NewFile: PROC[bcd: BcdDefs.BcdBase, version: BcdDefs.VersionStamp, string: Rope.ROPE]
RETURNS[fti: BcdDefs.FTIndex] ~ {
ftb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.ftOffset];
CheckFile: PROC[fth: BcdDefs.FTHandle, fti: BcdDefs.FTIndex] RETURNS[BOOL] ~ {
RETURN[ftb[fti].version = version]};
fti ← BcdOps.ProcessFiles[bcd, CheckFile].fti;
IF fti = BcdDefs.FTNull THEN {
fti ← bcd.ftLimit;
Check[fti + BcdDefs.FTRecord.SIZE, nftp*PrincOps.wordsPerPage];
ftb[fti] ← [name~NewName[bcd, TrimFileName[string]], version~version];
bcd.ftLimit ← fti + BcdDefs.FTRecord.SIZE};
RETURN};
AddSegment: PROC[bcd, iBcd: BcdDefs.BcdBase, isgi: BcdDefs.SGIndex, iFileName: Rope.ROPE]
RETURNS[sgi: BcdDefs.SGIndex] ~ {
sgb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.sgOffset];
iSgb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.sgOffset];
fti: BcdDefs.FTIndex ~ AddFile[bcd, iBcd, iSgb[isgi].file, iFileName];
CheckSegment: PROC[sgh: BcdDefs.SGHandle, sgi: BcdDefs.SGIndex] RETURNS[BOOL] ~ {
RETURN[sgb[sgi].file = fti AND sgb[sgi].class = iSgb[isgi].class
AND sgb[sgi].base = iSgb[isgi].base
AND sgb[sgi].pages = iSgb[isgi].pages AND sgb[sgi].extraPages = iSgb[isgi].extraPages]
};
sgi ← BcdOps.ProcessSegs[bcd, CheckSegment].sgi;
IF sgi = BcdDefs.SGNull THEN {
sgi ← bcd.sgLimit;
Check[sgi + BcdDefs.SGRecord.SIZE, nsgp*PrincOps.wordsPerPage];
sgb[sgi] ← iSgb[isgi];
sgb[sgi].file ← fti;
bcd.sgLimit ← sgi + BcdDefs.SGRecord.SIZE};
RETURN};
AddVariables: PROC[bcd, iBcd: BcdDefs.BcdBase, ievi: BcdDefs.EVIndex]
RETURNS[evi: BcdDefs.EVIndex] ~ {
IF ievi = BcdDefs.EVNull THEN evi ← BcdDefs.EVNull
ELSE {
evb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.evOffset];
iEvb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.evOffset];
size: CARDINAL ~ BcdDefs.EVRecord.SIZE + iEvb[ievi].length*CARDINAL.SIZE;
evi ← bcd.evLimit;
Check[evi + size, nevp*PrincOps.wordsPerPage];
evb[evi] ← iEvb[ievi];
FOR i: CARDINAL IN [1..iEvb[ievi].length] DO
evb[evi].offsets[i] ← iEvb[ievi].offsets[i]
ENDLOOP;
bcd.evLimit ← evi + size};
RETURN};
IndexToMti: PROC[base: BcdDefs.BcdBase, index: BcdDefs.ModuleIndex]
RETURNS[BcdDefs.MTIndex] ~ {
TestMti: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex] RETURNS[stop: BOOL] ~ {
RETURN[index = mth.gfi]};
RETURN[BcdOps.ProcessModules[base, TestMti].mti]};
BuildBcd: PUBLIC SAFE PROC[
name: Rope.ROPE,
stamp: BasicTime.GMT,
root: Tree.Link,
EnumerateComponents: SAFE PROC[
root: Tree.Link,
ProcessComponent: SAFE PROC[BcdDefs.BcdBase, Rope.ROPE]
RETURNS[LoadState.ModuleIndex]],
oldBcd: Bcd]
RETURNS[Bcd] ~ TRUSTED {
bcdSpace: VM.Interval ← VM.nullInterval;
bcd: BcdDefs.BcdBase ← NIL;
oldSpace: VM.Interval ~ (IF oldBcd = NIL THEN VM.nullInterval ELSE oldBcd.space);
{
ENABLE
UNWIND => {
IF bcdSpace ~= VM.nullInterval AND oldSpace = VM.nullInterval THEN
bcdSpace.Free[]
};
ctb, mtb: BcdDefs.Base;
nameString: BcdDefs.NameString;
nGfi: CARDINAL ← 1;
MergeBcd: SAFE PROC[iBcd: BcdDefs.BcdBase, iFileName: Rope.ROPE]
RETURNS[relGfi: LoadState.ModuleIndex] ~ TRUSTED {
ForEachModule: PROC[imth: BcdDefs.MTHandle, imti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ {
mti: BcdDefs.MTIndex ~ bcd.mtLimit;
sgi: BcdDefs.SGIndex ~ bcd.sgLimit;
mtSize: NAT ~ BcdDefs.MTRecord.multiple.SIZE; -- always builds this variant
Check[mti + mtSize, nmtp*PrincOps.wordsPerPage];
mtb[mti] ← BcdDefs.MTRecord[
name~AddName[bcd, iBcd, imth.name],
namedInstance~FALSE,
initial~imth.initial,
file~AddFile[bcd, iBcd, imth.file, iFileName],
linkLoc~imth.linkLoc,
config~BcdDefs.CTIndex.FIRST,
code~[
sgi~AddSegment[bcd, iBcd, imth.code.sgi, iFileName],
packed~imth.code.packed, linkspace~imth.code.linkspace,
offset~imth.code.offset, length~imth.code.length],
sseg~AddSegment[bcd, iBcd, imth.sseg, iFileName],
long~imth.long, tableCompiled~imth.tableCompiled,
boundsChecks~imth.boundsChecks, nilChecks~imth.nilChecks,
frameRefs~imth.frameRefs,
frameType~imth.frameType,
framesize~imth.framesize,
altoCode~imth.altoCode, residentFrame~imth.residentFrame,
crossJumped~imth.crossJumped,
packageable~imth.packageable, -- ???
gfi~nGfi,
ngfi~imth.ngfi,
variables~AddVariables[bcd, iBcd, imth.variables],
extension~multiple[  -- this fake config has NO linkage information
links~BcdDefs.LFNull,
refLiterals~BcdDefs.RFNull,
types~BcdDefs.TFNull]];
nGfi ← nGfi + imth.ngfi;
bcd.mtLimit ← mti + mtSize;
bcd.nModules ← bcd.nModules + 1};
relGfi ← nGfi;
[] ← BcdOps.ProcessModules[iBcd, ForEachModule];
RETURN};
bcdSpace ← (IF oldSpace ~= VM.nullInterval
THEN oldSpace ELSE VM.Allocate[count~BCDPAGES]);
bcd ← VM.AddressForPageNumber[bcdSpace.page];
bcd^ ← [
versionIdent~BcdDefs.VersionID,
version~BcdDefs.NullVersion,
creator~BcdDefs.NullVersion,
sourceVersion~[net~0, host~0, time~BasicTime.ToNSTime[LOOPHOLE[stamp]]],
source~TRASH,
spare1~TRUE, spare2~FALSE,
nPages~BCDPAGES,
nConfigs~1,
nModules~0,
nImports~0, nExports~0,
definitions~FALSE, repackaged~FALSE, typeExported~FALSE, tableCompiled~FALSE,
versions~FALSE, extended~TRUE,
firstdummy~TRASH,
nDummies~TRASH,
ssOffset~SSPAGE*PrincOps.wordsPerPage, ssLimit~TRASH,
ctOffset~CTPAGE*PrincOps.wordsPerPage, ctLimit~BcdDefs.CTIndex.FIRST,
mtOffset~MTPAGE*PrincOps.wordsPerPage, mtLimit~BcdDefs.MTIndex.FIRST,
impOffset~IMPAGE*PrincOps.wordsPerPage, impLimit~BcdDefs.IMPIndex.FIRST,
expOffset~EXPAGE*PrincOps.wordsPerPage, expLimit~BcdDefs.EXPIndex.FIRST,
evOffset~EVPAGE*PrincOps.wordsPerPage, evLimit~BcdDefs.EVIndex.FIRST,
sgOffset~SGPAGE*PrincOps.wordsPerPage, sgLimit~BcdDefs.SGIndex.FIRST,
ftOffset~FTPAGE*PrincOps.wordsPerPage, ftLimit~BcdDefs.FTIndex.FIRST,
spOffset~0, spLimit~relZero,
ntOffset~NTPAGE*PrincOps.wordsPerPage, ntLimit~BcdDefs.NTIndex.FIRST,
typOffset~0, typLimit~relZero,
tmOffset~0, tmLimit~relZero,
fpOffset~0, fpLimit~relZero,
lfOffset~LFPAGE*PrincOps.wordsPerPage, lfLimit~BcdDefs.LFIndex.FIRST,
rfOffset~RFPAGE*PrincOps.wordsPerPage, rfLimit~BcdDefs.RFIndex.FIRST,
tfOffset~TFPAGE*PrincOps.wordsPerPage, tfLimit~BcdDefs.TFIndex.FIRST,
rtPages~[0, 0]];
ctb ← LOOPHOLE[bcd + bcd.ctOffset];
mtb ← LOOPHOLE[bcd + bcd.mtOffset];
nameString ← LOOPHOLE[bcd + bcd.ssOffset];
nameString.string ← [
length~BcdDefs.NullName,
maxlength~(nssp*PrincOps.wordsPerPage-StringBody[0].SIZE)*PrincOps.bytesPerWord,
text~];
nameString.size[BcdDefs.NullName] ← 0;
bcd.source ← NewName[bcd, name.Concat[".model"]];
ctb[BcdDefs.CTIndex.FIRST] ← [
name~NewName[bcd, name],
namedInstance~FALSE,
file~BcdDefs.FTNull,  -- try no backing file
config~BcdDefs.CTNull,
nControls~0, controls~];
bcd.ctLimit ← BcdDefs.CTIndex.FIRST + BcdDefs.CTRecord.SIZE;
EnumerateComponents[root, MergeBcd];
bcd.firstdummy ← nGfi; -- gfis needed
bcd.nDummies ← 0;
bcd.ssLimit ← StringBody[nameString.string.length].SIZE;
};
RETURN[NEW[BcdObject ← [space~bcdSpace, base~bcd]]]};
ReplaceComponent: PUBLIC SAFE PROC[
config: Bcd, relGfi: LoadState.ModuleIndex,
iBcd: BcdDefs.BcdBase, iFileName: Rope.ROPE] ~ TRUSTED {
bcd: BcdDefs.BcdBase~config.base;
nameString: BcdDefs.NameString ~ LOOPHOLE[bcd + bcd.ssOffset];
mtb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.mtOffset];
nGfi: CARDINAL;
ForEachModule: PROC[imth: BcdDefs.MTHandle, imti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ {
mti: BcdDefs.MTIndex ~ IndexToMti[bcd, nGfi];
sgi: BcdDefs.SGIndex ~ bcd.sgLimit;
IF mti = BcdDefs.MTNull THEN ERROR;
mtb[mti] ← BcdDefs.MTRecord[
name~AddName[bcd, iBcd, imth.name],
namedInstance~FALSE,
initial~imth.initial,
file~AddFile[bcd, iBcd, imth.file, iFileName],
linkLoc~$code, -- imth.linkLoc, *** frame links not currently supported
config~BcdDefs.CTIndex.FIRST,
code~[
sgi~AddSegment[bcd, iBcd, imth.code.sgi, iFileName],
packed~imth.code.packed, linkspace~imth.code.linkspace,
offset~imth.code.offset, length~imth.code.length],
sseg~AddSegment[bcd, iBcd, imth.sseg, iFileName],
long~imth.long, tableCompiled~imth.tableCompiled,
boundsChecks~imth.boundsChecks, nilChecks~imth.nilChecks,
frameRefs~imth.frameRefs,
frameType~imth.frameType,
framesize~imth.framesize,
altoCode~imth.altoCode, residentFrame~imth.residentFrame,
crossJumped~imth.crossJumped,
packageable~FALSE,
gfi~nGfi,
ngfi~imth.ngfi,
variables~AddVariables[bcd, iBcd, imth.variables],
extension~multiple[  -- this fake config has NO linkage information
links~BcdDefs.LFNull,
refLiterals~BcdDefs.RFNull,
types~BcdDefs.TFNull]];
nGfi ← nGfi + imth.ngfi};
nGfi ← relGfi;
[] ← BcdOps.ProcessModules[iBcd, ForEachModule];
bcd.ssLimit ← StringBody[nameString.string.length].SIZE};
WriteBcd: PUBLIC SAFE PROC[
bcd: Bcd, stream: IO.STREAM, AcquireFile: LoaderOpsExtras.AcquireFileProc] ~ TRUSTED {
base: BcdDefs.BcdBase ~ bcd.base;
next: CARDINAL ← BcdDefs.BCD.SIZE;
Chunk: TYPE~RECORD[offset: CARDINAL, size: CARDINAL, next: REF Chunk←NIL];
chunkHead, chunkTail: REF Chunk ← NIL;
LinkChunk: PROC[oldOffset: CARDINAL, limit: RelPointer] RETURNS[offset: CARDINAL] ~ {
size: CARDINAL ~ limit-RelPointer.FIRST;
node: REF Chunk ~ NEW[Chunk ← [offset~oldOffset, size~size]];
IF chunkHead = NIL THEN chunkHead ← chunkTail ← node
ELSE chunkTail ← chunkTail.next ← node;
offset ← next; next ← next + size;
RETURN};
PutBlock: PROC[addr: LONG POINTER, size: CARDINAL] ~ {
stream.UnsafePutBlock[[base~addr, startIndex~0, count~size*Basics.bytesPerWord]]};
MoveToPage: PROC[page: CARDINAL] ~ {
pos: INT ~ page.LONG*(PrincOps.wordsPerPage*Basics.bytesPerWord);
IF pos > stream.GetLength THEN stream.SetLength[pos];
stream.SetIndex[pos]};
AppendPages: PROC[file: FS.OpenFile, base, count: CARDINAL] ~ {
bufferSpace: VM.Interval ← VM.Allocate[count~count];
{
ENABLE UNWIND => bufferSpace.Free[];
buffer: LONG POINTER ~ VM.AddressForPageNumber[bufferSpace.page];
file.Read[from~base, nPages~count, to~buffer];
PutBlock[buffer, count*PrincOps.wordsPerPage];
};
VM.Free[bufferSpace]};
ctb: BcdDefs.Base ~ LOOPHOLE[base + base.ctOffset];
sgb: BcdDefs.Base ~ LOOPHOLE[base + base.sgOffset];
ftb: BcdDefs.Base ~ LOOPHOLE[base + base.ftOffset];
nameString: BcdDefs.NameString ~ LOOPHOLE[base + base.ssOffset];
basePages, rtPages, nextPage: CARDINAL;
SegLoc: TYPE~RECORD[fti: BcdDefs.FTIndex, base: CARDINAL, next: REF SegLoc←NIL];
mapHead, mapTail: REF SegLoc ← NIL;
EnumerateSegs: PROC[ForEach: PROC[sgi: BcdDefs.SGIndex]] ~ {
note: BcdOps.ProcessSegs cannot be used after base.sgOffset is updated
FOR sgi: BcdDefs.SGIndex ← BcdDefs.SGIndex.FIRST, sgi + BcdDefs.SGRecord.SIZE
UNTIL sgi = base.sgLimit DO
ForEach[sgi]
ENDLOOP
};
MapCodeSegs: PROC[sgi: BcdDefs.SGIndex]~ {
IF sgb[sgi].class = $code THEN {
node: REF SegLoc ~ NEW[SegLoc ← [fti~sgb[sgi].file, base~sgb[sgi].base]];
IF mapHead = NIL THEN mapHead ← mapTail ← node
ELSE mapTail ← mapTail.next ← node;
sgb[sgi].file ← BcdDefs.FTSelf; sgb[sgi].base ← nextPage+1; -- + 1 for old Alto confusion
nextPage ← nextPage + (sgb[sgi].pages + sgb[sgi].extraPages)};
};
MoveCodeSegs: PROC[sgi: BcdDefs.SGIndex] ~ {
IF sgb[sgi].class = $code THEN {
fti: BcdDefs.FTIndex ~ mapHead.fti;
file: FS.OpenFile ~ AcquireFile[RopeFromNS[base, ftb[fti].name], ftb[fti].version];
AppendPages[file, mapHead.base-1, sgb[sgi].pages + sgb[sgi].extraPages]; -- - 1, ditto
mapHead ← mapHead.next};
};
ctb[BcdDefs.CTIndex.FIRST].file ← BcdDefs.FTSelf;
base.ssLimit ← StringBody[nameString.string.length].SIZE;
base.ssOffset ← LinkChunk[base.ssOffset, RelPointer.FIRST+base.ssLimit];
base.ctOffset ← LinkChunk[base.ctOffset, base.ctLimit];
base.mtOffset ← LinkChunk[base.mtOffset, base.mtLimit];
base.impOffset ← LinkChunk[base.impOffset, base.impLimit];
base.expOffset ← LinkChunk[base.expOffset, base.expLimit];
base.ntOffset ← LinkChunk[base.ntOffset, base.ntLimit];
base.evOffset ← LinkChunk[base.evOffset, base.evLimit];
base.sgOffset ← LinkChunk[base.sgOffset, base.sgLimit];
base.ftOffset ← LinkChunk[base.ftOffset, base.ftLimit];
base.lfOffset ← LinkChunk[base.lfOffset, base.lfLimit];
base.rfOffset ← LinkChunk[base.rfOffset, base.rfLimit];
base.tfOffset ← LinkChunk[base.tfOffset, base.tfLimit];
basePages ← (next + (PrincOps.wordsPerPage-1))/PrincOps.wordsPerPage;
rtPages ← ((bcd.literals).SegmentSize + (PrincOps.wordsPerPage-1))/PrincOps.wordsPerPage;
base.nPages ← nextPage ← basePages + rtPages;
base.rtPages ← [relPageBase~basePages, pages~rtPages];
EnumerateSegs[MapCodeSegs];
PutBlock[base, BcdDefs.BCD.SIZE];
FOR chunk: REF Chunk ← chunkHead, chunk.next UNTIL chunk = NIL DO
PutBlock[base+chunk.offset, chunk.size];
ENDLOOP;
MoveToPage[basePages];
IF rtPages # 0 THEN {(bcd.literals).Write[stream]; MoveToPage[base.nPages]};
EnumerateSegs[MoveCodeSegs]};
DeleteBcd: PUBLIC SAFE PROC[bcd: Bcd] ~ TRUSTED {
IF bcd # NIL AND bcd.space # VM.nullInterval THEN {
IF bcd.literals # NIL THEN {(bcd.literals).Finalize[]; bcd.literals ← NIL};
bcd.space.Free[]; bcd.space ← VM.nullInterval;
bcd.base ← NIL};
};
operations used by binder only
DeclareControl: PUBLIC SAFE PROC[bcd: Bcd, module: LoadState.ModuleIndex] ~ TRUSTED {
ctb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.ctOffset];
cti: BcdDefs.CTIndex ~ BcdDefs.CTIndex.FIRST;
n: CARDINAL ~ ctb[cti].nControls;
size: CARDINAL ~ BcdDefs.CTRecord.SIZE + (n+1)*BcdDefs.ControlItem.SIZE;
Check[cti+size, nctp*PrincOps.wordsPerPage];
ctb[cti].controls[n] ← [module[IndexToMti[bcd.base, module]]]; ctb[cti].nControls ← n+1;
bcd.base.ctLimit ← cti+size};
DeclareImport: PUBLIC SAFE PROC[
bcd: Bcd, formal, type: Rope.ROPE, stamp: BcdDefs.VersionStamp]
RETURNS[index: CARDINAL] ~ TRUSTED {
impb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.impOffset];
impi: BcdDefs.IMPIndex ~ bcd.base.impLimit;
Check[impi + BcdDefs.IMPRecord.SIZE, nimp*PrincOps.wordsPerPage];
bcd.base.impLimit ← impi + BcdDefs.IMPRecord.SIZE;
impb[impi] ← [
name~NewName[bcd.base, type],
port~$interface,
namedInstance~FALSE,
file~BcdDefs.FTNull,
gfi~BcdDefs.NullModule,
ngfi~TRASH];
IF ~formal.Equal[type] THEN {
NewNamed[bcd.base, [NewName[bcd.base, formal], [import[impi]]]];
impb[impi].namedInstance ← TRUE};
bcd.base.nImports ← bcd.base.nImports+1;
RETURN[(impi-BcdDefs.IMPIndex.FIRST)/BcdDefs.IMPRecord.SIZE]};
FillImport: PUBLIC SAFE PROC[
bcd: Bcd, index: CARDINAL, iBcd: BcdDefs.BcdBase, iImpi: BcdDefs.IMPIndex]
RETURNS[BcdDefs.ModuleIndex] ~ TRUSTED {
base: BcdDefs.BcdBase ~ bcd.base;
impb: BcdDefs.Base ~ LOOPHOLE[base + base.impOffset];
impi: BcdDefs.IMPIndex ~ BcdDefs.IMPIndex.FIRST + index*BcdDefs.IMPRecord.SIZE;
iImpb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.impOffset];
impb[impi].port ← iImpb[iImpi].port;
impb[impi].file ← AddFile[base, iBcd, iImpb[iImpi].file, NIL];
impb[impi].gfi ← bcd.base.firstdummy+bcd.base.nDummies;
impb[impi].ngfi ← iImpb[iImpi].ngfi;
bcd.base.nDummies ← bcd.base.nDummies+impb[impi].ngfi;
RETURN[impb[impi].gfi]};
DeclareExport: PUBLIC SAFE PROC[
bcd: Bcd, name: Rope.ROPE, stamp: BcdDefs.VersionStamp,
size: NAT, getLink: SAFE PROC[NAT] RETURNS[BcdDefs.Link]] ~ TRUSTED {
expb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.expOffset];
expi: BcdDefs.EXPIndex ~ bcd.base.expLimit;
expSize: NAT ~ BcdDefs.EXPRecord.SIZE + size*BcdDefs.Link.SIZE;
Check[expi + expSize, nexp*PrincOps.wordsPerPage];
bcd.base.expLimit ← expi + expSize;
expb[expi] ← [
name~NewName[bcd.base, name],
size~size,
port~$interface,
namedInstance~FALSE, typeExported~FALSE,
file~NewFile[bcd.base, stamp, name],
links~TRASH];
FOR i: NAT IN [0 .. size) DO
expb[expi].links[i] ← getLink[i]  -- check for exported type here?
ENDLOOP;
bcd.base.nExports ← bcd.base.nExports+1};
OpenLinks: PUBLIC SAFE PROC[
bcd: Bcd, module: LoadState.ModuleIndex, relGfi: NAT, size: NAT]
RETURNS[h: MTHandle] ~ TRUSTED {
ForEachModule: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL] ~ {
IF module+relGfi IN [mth.gfi .. mth.gfi+mth.ngfi) THEN {
WITH m~~mth SELECT FROM
multiple => {
lfb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.lfOffset];
lfi: BcdDefs.LFIndex ~ bcd.base.lfLimit;
nw: CARDINAL ~ BcdDefs.LinkFrag[size].SIZE;
Check[lfi + nw, nlfp*PrincOps.wordsPerPage];
m.links ← lfi;
LOOPHOLE[@lfb[lfi].frag, LONG POINTER TO NAT]^ ← size;
FOR i: NAT IN [0..size) DO lfb[lfi][i] ← BcdDefs.NullLink ENDLOOP;
bcd.base.lfLimit ← lfi + nw};
ENDCASE => ERROR;
h ← mti; stop ← TRUE}
ELSE stop ← FALSE};
[] ← BcdOps.ProcessModules[bcd.base, ForEachModule];
RETURN};
ReadLink: PUBLIC SAFE PROC[bcd: Bcd, mth: MTHandle, offset: NAT]
RETURNS[BcdDefs.Link] ~ TRUSTED {
mtb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.mtOffset];
lfb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.lfOffset];
RETURN[WITH m~~mtb[mth] SELECT FROM
direct => m.frag[offset],
indirect => lfb[m.links].frag[offset],
multiple => lfb[m.links].frag[offset],
ENDCASE => BcdDefs.NullLink]
};
WriteLink: PUBLIC SAFE PROC[
bcd: Bcd, mth: MTHandle, offset: NAT, link: BcdDefs.Link] ~ TRUSTED {
mtb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.mtOffset];
lfb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.lfOffset];
WITH m~~mtb[mth] SELECT FROM
direct => m.frag[offset] ← link;
indirect => lfb[m.links].frag[offset] ← link;
multiple => lfb[m.links].frag[offset] ← link;
ENDCASE;
};
OpenLiterals: PUBLIC SAFE PROC[bcd: Bcd, iBcd: BcdDefs.BcdBase] ~ TRUSTED {
MapFile: PROC[iFti: BcdDefs.FTIndex] RETURNS[BcdDefs.FTIndex] ~ {
RETURN[AddFile[bcd.base, iBcd, iFti, NIL]]};
MapSegment: PROC[iSgi: BcdDefs.SGIndex] RETURNS[BcdDefs.SGIndex] ~ {
RETURN[AddSegment[bcd.base, iBcd, iSgi, NIL]]};
IF bcd.literals = NIL THEN bcd.literals ← BcdLiterals.Create[];
[] ← (bcd.literals).Load[iBcd, MapFile, MapSegment]};
ImportLiterals: PUBLIC SAFE PROC[
bcd: Bcd, mth: MTHandle, iBcd: BcdDefs.BcdBase, iMti: BcdDefs.MTIndex] ~ TRUSTED {
mtb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.mtOffset];
iMtb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.mtOffset];
WITH m~~mtb[mth] SELECT FROM
multiple =>
WITH iM~~iMtb[iMti] SELECT FROM
multiple => {
IF iM.refLiterals # BcdDefs.RFNull THEN {
rfb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.rfOffset];
iRfb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.rfOffset];
rfi: BcdDefs.RFIndex ~ bcd.base.rfLimit;
iRfi: BcdDefs.RFIndex ~ iM.refLiterals;
nw: CARDINAL ~ BcdDefs.RefLitFrag[iRfb[iRfi].length].SIZE;
Check[rfi + nw, nrfp*PrincOps.wordsPerPage];
m.refLiterals ← rfi;
rfb[rfi].offset ← iRfb[iRfi].offset;
LOOPHOLE[@rfb[rfi].frag, LONG POINTER TO NAT]^ ← iRfb[iRfi].length;
FOR i: NAT IN [0 .. rfb[rfi].length) DO
rfb[rfi].frag[i] ← (bcd.literals).MapLitLink[iRfb[iRfi].frag[i]]
ENDLOOP;
bcd.base.rfLimit ← rfi + nw};
IF iM.types # BcdDefs.TFNull THEN {
tfb: BcdDefs.Base ~ LOOPHOLE[bcd.base + bcd.base.tfOffset];
iTfb: BcdDefs.Base ~ LOOPHOLE[iBcd + iBcd.tfOffset];
tfi: BcdDefs.TFIndex ~ bcd.base.tfLimit;
iTfi: BcdDefs.TFIndex ~ iM.types;
nw: CARDINAL ~ BcdDefs.TypeFrag[iTfb[iTfi].length].SIZE;
Check[tfi + nw, ntfp*PrincOps.wordsPerPage];
m.types ← tfi;
tfb[tfi].offset ← iTfb[iTfi].offset;
LOOPHOLE[@tfb[tfi].frag, LONG POINTER TO NAT]^ ← iTfb[iTfi].length;
FOR i: NAT IN [0 .. tfb[tfi].length) DO
tfb[tfi].frag[i] ← (bcd.literals).MapTypeLink[iTfb[iTfi].frag[i]]
ENDLOOP;
bcd.base.tfLimit ← tfi + nw};
}
ENDCASE => NULL;
ENDCASE => ERROR
};
CloseLiterals: PUBLIC SAFE PROC[bcd: Bcd, iBcd: BcdDefs.BcdBase] ~ TRUSTED {
(bcd.literals).Unload[]};
utilities
Base: PUBLIC SAFE PROC[bcd: Bcd] RETURNS[BcdDefs.BcdBase] ~ CHECKED {
RETURN[bcd.base]};
RopeFromNS: PUBLIC SAFE PROC[bcd: BcdDefs.BcdBase, name: BcdDefs.NameRecord]
RETURNS[Rope.ROPE] ~ TRUSTED {
nameString: BcdDefs.NameString ~ LOOPHOLE[bcd+bcd.ssOffset];
i: CARDINAL ← 0;
EachChar: SAFE PROC RETURNS[c: CHAR] ~ TRUSTED {
c ← nameString.string.text[name+i]; i ← i+1; RETURN};
RETURN[Rope.FromProc[nameString.size[name], EachChar]]};
}.