-- BcdUtilities.mesa
-- Last edited by Satterthwaite on August 1, 1983 11:59 am
-- Last edited by Lewis on 16-Dec-80 10:47:39
DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier, Top, Words],
BcdDefs: TYPE USING [
CTIndex, CTRecord, cttype, cxtype, EVIndex, EVNull,
EVRecord, evtype, EXPIndex, EXPRecord, exptype, FPIndex, FPRecord, fptype,
FTIndex, FTNull, FTRecord, FTSelf, fttype, GFTIndex,
IMPIndex, IMPNull, IMPRecord, imptype, LFIndex, LFNull, lftype, Link, LinkFrag,
MTIndex, MTRecord, mttype, Namee, NameRecord, NTIndex, NTRecord, nttype,
NullLink, NullName, NullVersion, RFIndex, RFNull, rftype, RefLitFrag,
SGIndex, SGRecord, sgtype, SpaceID, SPIndex, SPRecord, sptype, sttype,
TFIndex, TFNull, tftype, TMIndex, TMRecord, tmtype, TypeFrag,
TYPIndex, TYPNull, TYPRecord, typtype, VersionStamp],
BcdErrorDefs: TYPE USING [Error2Versions],
BcdUtilDefs: TYPE USING [BcdBasePtr],
HashOps: TYPE USING [
EnterString, FindEquivalentString, FindString, SubStringForHash],
Inline: TYPE USING [LongCOPY],
Strings: TYPE USING [EquivalentSubString, String, SubString, SubStringDescriptor],
Symbols: TYPE USING [
CXIndex, CXRecord, HTIndex, htNull, STIndex, stNull, STRecord],
Table: TYPE USING [Base],
Tree: TYPE USING [Link];
BcdUtilities: PROGRAM
IMPORTS Alloc, BcdErrorDefs, HashOps, Inline, Strings
EXPORTS BcdUtilDefs = PUBLIC {
OPEN BcdUtilDefs, BcdDefs;
Copy: PROC [from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] ~
Inline.LongCOPY;
STIndex: TYPE ~ Symbols.STIndex;
stNull: STIndex ~ Symbols.stNull;
HTIndex: PRIVATE TYPE ~ Symbols.HTIndex;
htNull: HTIndex ~ Symbols.htNull;
SubStringDescriptor: TYPE ~ Strings.SubStringDescriptor;
SubString: TYPE ~ Strings.SubString;
table: Alloc.Handle;
ctb, mtb, lfb, rfb, tfb: Table.Base;
sgb, ftb, itb, etb, ntb, stb, cxb, evb, tyb, tmb, spb, fpb: Table.Base;
Notifier: PRIVATE Alloc.Notifier ~ {
ctb ← base[cttype]; mtb ← base[mttype];
lfb ← base[lftype]; rfb ← base[rftype]; tfb ← base[tftype];
sgb ← base[sgtype]; ftb ← base[fttype]; itb ← base[imptype]; etb ← base[exptype];
ntb ← base[nttype]; stb ← base[sttype]; cxb ← base[cxtype]; evb ← base[evtype];
tyb ← base[typtype]; tmb ← base[tmtype]; spb ← base[sptype]; fpb ← base[fptype]};
EnterName: PROC [ss: SubString] RETURNS [NameRecord] ~ {
lss: SubStringDescriptor;
hti: HTIndex ~ HashOps.EnterString[ss];
HashOps.SubStringForHash[@lss, hti];
RETURN [[lss.offset]]};
MapName: PROC [bcd: BcdBasePtr, n: NameRecord] RETURNS [NameRecord] ~ {
ss: SubStringDescriptor ← [
base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
RETURN [EnterName[@ss]]};
MapEquivalentName: PRIVATE PROC [bcd: BcdBasePtr, n: NameRecord]
RETURNS [NameRecord] ~ {
ss: SubStringDescriptor ← [base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
hti: HTIndex;
hti ← HashOps.FindString[@ss];
IF hti = htNull THEN hti ← HashOps.FindEquivalentString[@ss];
RETURN [[IF hti # htNull THEN NameForHti[hti] ELSE EnterName[@ss]]]};
HtiForName: PROC [bcd: BcdBasePtr, n: NameRecord] RETURNS [HTIndex] ~ {
ss: SubStringDescriptor ← [base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
RETURN [HashOps.EnterString[@ss]]};
NameForHti: PROC [hti: HTIndex] RETURNS [NameRecord] ~ {
ss: SubStringDescriptor;
HashOps.SubStringForHash[@ss, hti];
RETURN [[ss.offset]]};
NameForSti: PROC [sti: STIndex] RETURNS [NameRecord] ~ {
RETURN [NameForHti[stb[sti].hti]]};
ContextForTree: PROC [t: Tree.Link] RETURNS [Symbols.CXIndex] ~ {
sti: STIndex ~ NARROW[t, Tree.Link.symbol].index;
RETURN [NARROW[stb[sti], Symbols.STRecord.local].context]};
EqVersions: PROC [fti1, fti2: FTIndex] RETURNS [BOOL] ~ {
RETURN [fti1 = fti2 OR ftb[fti1].version = ftb[fti2].version]};
EquivalentVersions: PROC [v1, v2: VersionStamp] RETURNS [BOOL] ~ {
RETURN [v1 = v2]};
InsertFile: PRIVATE PROC [
fn: NameRecord, version: VersionStamp] RETURNS [fti: FTIndex] ~ {
ftLimit: FTIndex ~ table.Top[fttype];
mismatched: BOOL ← FALSE;
otherVersion: VersionStamp;
FOR fti ← FTIndex.FIRST, fti+FTRecord.SIZE UNTIL fti = ftLimit DO
IF ftb[fti].name = fn THEN
SELECT TRUE FROM
(ftb[fti].version = NullVersion) => {ftb[fti].version ← version; EXIT};
EquivalentVersions[ftb[fti].version, version],
(version = NullVersion) => EXIT;
ENDCASE => {mismatched ← TRUE; otherVersion ← ftb[fti].version};
REPEAT
FINISHED => {
fti ← table.Words[fttype, FTRecord.SIZE];
ftb[fti] ← [name~fn, version~version];
IF mismatched THEN BcdErrorDefs.Error2Versions[
class~$warning, fileName~fn, v1~version, v2~otherVersion]};
ENDLOOP;
RETURN};
MergeFile: PROC [bcd: BcdBasePtr, oldFti: FTIndex] RETURNS [FTIndex] ~ {
fn: NameRecord;
IF oldFti = FTSelf OR oldFti = FTNull THEN RETURN [oldFti];
fn ← MapEquivalentName[bcd, bcd.ftb[oldFti].name];
RETURN [InsertFile[fn, bcd.ftb[oldFti].version]]};
EnterFile: PROC [name: Strings.String] RETURNS [FTIndex] ~ {
ss: SubStringDescriptor ← [base~name, offset~0, length~name.length];
fn: NameRecord;
hti: HTIndex;
nullV: VersionStamp ← NullVersion;
IF ss.base[ss.offset+ss.length-1] = '. THEN ss.length ← ss.length-1;
IF ss.length > 4 THEN {
ext: SubStringDescriptor ← [base~".bcd"L, offset~0, length~4];
st: SubStringDescriptor ← [base~ss.base, offset~ss.offset+ss.length-4, length~4];
IF Strings.EquivalentSubString[@st, @ext] THEN ss.length ← ss.length-4};
hti ← HashOps.FindString[@ss];
IF hti = htNull THEN hti ← HashOps.FindEquivalentString[@ss];
fn ← IF hti # htNull THEN NameForHti[hti] ELSE EnterName[@ss];
RETURN [InsertFile[fn, nullV]]};
SetFileVersion: PROC [fti: FTIndex, v: VersionStamp] ~ {
OPEN file~~ftb[fti];
SELECT TRUE FROM
(file.version = NullVersion) => file.version ← v;
EquivalentVersions[file.version, v] => NULL;
ENDCASE =>
BcdErrorDefs.Error2Versions[
class~$warning, fileName~file.name, v1~v, v2~file.version]};
FileForVersion: PROC [v: VersionStamp] RETURNS [fti: FTIndex] ~ {
ftLimit: FTIndex ~ table.Top[fttype];
FOR fti ← FTIndex.FIRST, fti+FTRecord.SIZE UNTIL fti = ftLimit DO
IF ftb[fti].version = v THEN EXIT;
REPEAT
FINISHED => fti ← FTNull;
ENDLOOP;
RETURN};
nextGfi: CARDINAL;
nextDummyGfi: CARDINAL;
GftOverflow: PUBLIC SIGNAL ~ CODE;
GetGfi: PROC [n: CARDINAL] RETURNS [gfi: GFTIndex] ~ {
gfi ← nextGfi;
nextGfi ← nextGfi + n;
IF nextGfi > GFTIndex.LAST THEN ERROR GftOverflow;
RETURN};
GetDummyGfi: PROC [n: CARDINAL] RETURNS [gfi: CARDINAL] ~ {
gfi ← nextDummyGfi;
nextDummyGfi ← nextDummyGfi + n;
RETURN};
NewContext: PROC RETURNS [ctx: Symbols.CXIndex] ~ {
ctx ← table.Words[cxtype, Symbols.CXRecord.SIZE];
cxb[ctx] ← [link~stNull];
RETURN};
NewSemanticEntry: PROC [hti: HTIndex] RETURNS [sti: STIndex] ~ {
sti ← table.Words[sttype, Symbols.STRecord.SIZE];
stb[sti] ← [
filename~FALSE, assigned~FALSE,
imported~FALSE, exported~FALSE,
hti~htNull,
link~stNull,
impi~IMPNull, impgfi~0,
body~unknown[]];
stb[sti].hti ← hti;
RETURN};
EnterConfig: PROC [bcd: BcdBasePtr, oldCti: CTIndex, name: HTIndex]
RETURNS [cti: CTIndex] ~ {
OPEN old~~bcd.ctb[oldCti];
size: CARDINAL ~ CTRecord.SIZE + old.nControls*Namee.SIZE;
cti ← table.Words[cttype, size];
Copy[from~@old, to~@ctb[cti], nwords~size];
ctb[cti].name ← MapName[bcd, old.name];
IF name # htNull THEN {
ctb[cti].namedInstance ← TRUE; CreateInstanceName[name, [config[cti]]]}
ELSE IF old.namedInstance THEN CopyInstanceName[bcd, [config[oldCti]], [config[cti]]];
RETURN};
EnterModule: PROC [bcd: BcdBasePtr, oldMti: MTIndex, name: HTIndex]
RETURNS [mti: MTIndex] ~ {
OPEN old~~bcd.mtb[oldMti];
size: CARDINAL ~ MTRecord.SIZE;
mti ← table.Words[mttype, size];
Copy[to~@mtb[mti], from~@old, nwords~size];
mtb[mti].name ← MapName[bcd, old.name];
IF name # htNull THEN {
mtb[mti].namedInstance ← TRUE; CreateInstanceName[name, [module[mti]]]}
ELSE IF old.namedInstance THEN CopyInstanceName[bcd, [module[oldMti]], [module[mti]]];
IF old.variables # EVNull THEN mtb[mti].variables ← EnterVariables[bcd, old.variables];
mtb[mti].links ← EnterLinks[bcd, old.links];
mtb[mti].refLiterals ← EnterLits[bcd, old.refLiterals];
mtb[mti].types ← EnterTypes[bcd, old.types];
RETURN};
EnterLinks: PRIVATE PROC [bcd: BcdBasePtr, oldLfi: LFIndex] RETURNS [lfi: LFIndex] ~ {
IF oldLfi = LFNull THEN lfi ← LFNull
ELSE {
OPEN old~~bcd.lfb[oldLfi];
size: CARDINAL ~ LinkFrag[old.length].SIZE;
lfi ← table.Words[lftype, size];
Copy[to~@lfb[lfi], from~@old, nwords~size]};
RETURN};
EnterLits: PRIVATE PROC [bcd: BcdBasePtr, oldRfi: RFIndex] RETURNS [rfi: RFIndex] ~ {
IF oldRfi = RFNull THEN rfi ← RFNull
ELSE {
OPEN old~~bcd.rfb[oldRfi];
size: CARDINAL ~ RefLitFrag[old.length].SIZE;
rfi ← table.Words[rftype, size];
Copy[to~@rfb[rfi], from~@old, nwords~size]};
RETURN};
EnterTypes: PRIVATE PROC [bcd: BcdBasePtr, oldTfi: TFIndex] RETURNS [tfi: TFIndex] ~ {
IF oldTfi = TFNull THEN tfi ← TFNull
ELSE {
OPEN old~~bcd.tfb[oldTfi];
size: CARDINAL ~ TypeFrag[old.length].SIZE;
tfi ← table.Words[tftype, size];
Copy[to~@tfb[tfi], from~@old, nwords~size]};
RETURN};
EnterVariables: PRIVATE PROC [bcd: BcdBasePtr, oldEvi: EVIndex]
RETURNS [evi: EVIndex] ~ {
OPEN old~~bcd.evb[oldEvi];
evLimit: EVIndex ~ table.Top[evtype];
oldLength: CARDINAL ~ old.length;
FOR evi ← EVIndex.FIRST, evi+EVRecord.SIZE+evb[evi].length UNTIL evi = evLimit DO
IF evb[evi].length >= oldLength THEN
FOR i: CARDINAL DECREASING IN [1..oldLength] DO
IF evb[evi].offsets[i] # old.offsets[i] THEN EXIT;
REPEAT
FINISHED => RETURN;
ENDLOOP;
ENDLOOP;
evi ← table.Words[evtype, EVRecord.SIZE+oldLength];
Copy[to~@evb[evi], from~@old, nwords~EVRecord.SIZE+oldLength];
RETURN};
EnterSegment: PROC [seg: SGRecord] RETURNS [sgi: SGIndex] ~ {
sgLimit: SGIndex ~ table.Top[sgtype];
FOR sgi ← SGIndex.FIRST, sgi+SGRecord.SIZE UNTIL sgi = sgLimit DO
IF sgb[sgi] = seg THEN RETURN ENDLOOP;
sgi ← table.Words[sgtype, SGRecord.SIZE];
sgb[sgi] ← seg;
RETURN};
EnterImport: PROC [bcd: BcdBasePtr, oldIti: IMPIndex, copyName: BOOL]
RETURNS [iti: IMPIndex] ~ {
OPEN old~~bcd.itb[oldIti];
iti ← table.Words[imptype, IMPRecord.SIZE];
itb[iti] ← old;
itb[iti].name ← MapName[bcd, old.name];
IF copyName AND old.namedInstance THEN
CopyInstanceName[bcd, [import[oldIti]], [import[iti]]]
ELSE itb[iti].namedInstance ← FALSE;
RETURN};
EnterExport: PROC [bcd: BcdBasePtr, oldEti: EXPIndex, copyName: BOOL]
RETURNS [eti: EXPIndex] ~ {
OPEN old~~bcd.etb[oldEti];
size: CARDINAL ~ old.size + EXPRecord.SIZE;
eti ← table.Words[exptype, size];
etb[eti] ← old;
FOR i: CARDINAL IN [0..etb[eti].size) DO etb[eti].links[i] ← NullLink ENDLOOP;
etb[eti].name ← MapName[bcd, old.name];
IF copyName AND old.namedInstance THEN
CopyInstanceName[bcd, [export[oldEti]], [export[eti]]]
ELSE etb[eti].namedInstance ← FALSE;
RETURN};
EnterType: PROC [bcd: BcdBasePtr, oldTypi: TYPIndex] RETURNS [typi: TYPIndex] ~ {
OPEN old~~bcd.tyb[oldTypi];
typLimit: TYPIndex ~ table.Top[typtype];
FOR typi ← TYPIndex.FIRST, typi +TYPRecord.SIZE UNTIL typi = typLimit DO
IF tyb[typi] = old THEN EXIT;
REPEAT FINISHED => {
typi ← table.Words[typtype, TYPRecord.SIZE]; tyb[typi] ← old};
ENDLOOP;
RETURN};
EnterTypeMap: PROC [bcd: BcdBasePtr, oldTmi: TMIndex] RETURNS [tmi: TMIndex] ~ {
OPEN old~~bcd.tmb[oldTmi];
tmLimit: TMIndex ~ table.Top[tmtype];
FOR tmi ← TMIndex.FIRST, tmi + TMRecord.SIZE UNTIL tmi = tmLimit DO
IF tmb[tmi].offset = old.offset AND tmb[tmi].version = old.version THEN EXIT;
REPEAT
FINISHED => {
tmi ← table.Words[tmtype, TMRecord.SIZE];
tmb[tmi] ← [version~old.version, offset~old.offset, map~TYPNull]};
ENDLOOP;
RETURN};
EnterSpace: PROC [bcd: BcdBasePtr, oldSpi: SPIndex] RETURNS [spi: SPIndex] ~ {
OPEN old~~bcd.spb[oldSpi];
size: CARDINAL ~ SPRecord.SIZE + old.length*SpaceID.SIZE;
spi ← table.Words[sptype, size];
Copy[from~@old, to~@spb[spi], nwords~size];
FOR i: CARDINAL IN [0 .. spb[spi].length) DO
spb[spi].spaces[i].name ← MapName[bcd, old.spaces[i].name];
ENDLOOP;
RETURN};
EnterFramePack: PROC [bcd: BcdBasePtr, oldFpi: FPIndex] RETURNS [fpi: FPIndex] ~ {
OPEN old~~bcd.fpb[oldFpi];
size: CARDINAL ~ FPRecord.SIZE + old.length*MTIndex.SIZE;
fpi ← table.Words[fptype, size];
Copy[from~@old, to~@fpb[fpi], nwords~size];
fpb[fpi].name ← MapName[bcd, old.name];
RETURN};
CreateInstanceName: PROC [hti: HTIndex, item: Namee] ~ {
nti: NTIndex ~ table.Words[nttype, NTRecord.SIZE];
ntb[nti] ← [item~item, name~NameForHti[hti]]};
InstanceName: PROC [item: Namee] RETURNS [NameRecord] ~ {
ntLimit: NTIndex ~ table.Top[nttype];
FOR nti: NTIndex ← NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = ntLimit DO
IF ntb[nti].item = item THEN RETURN [ntb[nti].name] ENDLOOP;
RETURN [NullName]};
CopyInstanceName: PRIVATE PROC [bcd: BcdBasePtr, old, new: Namee] ~ {
nti: NTIndex = table.Words[nttype, NTRecord.SIZE];
FOR oldNti: NTIndex ← NTIndex.FIRST, oldNti + NTRecord.SIZE DO
IF (bcd.ntb[oldNti]).item = old THEN {
ntb[nti] ← [item~new, name~MapName[bcd, bcd.ntb[oldNti].name]]; RETURN};
ENDLOOP};
-- Administrative Procedures
Init: PROC [ownTable: Alloc.Handle] ~ {
table ← ownTable;
table.AddNotify[Notifier]; nextGfi ← nextDummyGfi ← 1};
Reset: PROC ~ {table.DropNotify[Notifier]; table ← NIL};
}.