
<<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]]};

}.