DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier, Top, Words],
BcdDefs:
TYPE
USING [
ControlItem, CTIndex, CTRecord, cttype, cxtype, EVIndex, EVNull,
EVRecord, evtype, EXPIndex, EXPRecord, exptype, FPIndex, FPRecord, fptype,
FTIndex, FTNull, FTRecord, FTSelf, fttype,
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],
ConvertUnsafe: TYPE USING [EqualSubStrings, SubString],
HashOps:
TYPE
USING [
EnterString, FindEquivalentString, FindString, SubStringForHash],
PrincOps: TYPE USING [GFTIndex],
PrincOpsUtils: TYPE USING [LongCOPY],
Symbols:
TYPE
USING [
CXIndex, CXRecord, HTIndex, htNull, STIndex, stNull, STRecord],
Table: TYPE USING [Base],
Tree: TYPE USING [Link];
BcdUtilities:
PROGRAM
IMPORTS Alloc, BcdErrorDefs, ConvertUnsafe, HashOps, PrincOpsUtils
EXPORTS BcdUtilDefs = PUBLIC {
OPEN BcdUtilDefs, BcdDefs;
Copy:
PROC [from:
LONG
POINTER, nwords:
CARDINAL, to:
LONG
POINTER] ~
PrincOpsUtils.LongCOPY;
STIndex: TYPE ~ Symbols.STIndex;
stNull: STIndex ~ Symbols.stNull;
HTIndex: PRIVATE TYPE ~ Symbols.HTIndex;
htNull: HTIndex ~ Symbols.htNull;
SubString: TYPE ~ ConvertUnsafe.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: SubString;
hti: HTIndex ~ HashOps.EnterString[ss];
lss ← HashOps.SubStringForHash[hti];
RETURN [[lss.offset]]};
MapName:
PROC [bcd: BcdBasePtr, n: NameRecord]
RETURNS [NameRecord] ~ {
ss: SubString ← [
base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
RETURN [EnterName[ss]]};
MapEquivalentName:
PRIVATE
PROC [bcd: BcdBasePtr, n: NameRecord]
RETURNS [NameRecord] ~ {
ss: SubString ← [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: SubString ← [base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
RETURN [HashOps.EnterString[ss]]};
NameForHti:
PROC [hti: HTIndex]
RETURNS [NameRecord] ~ {
ss: SubString;
ss ← HashOps.SubStringForHash[hti];
RETURN [[ss.offset]]};
NameForSti:
PROC [sti: STIndex]
RETURNS [NameRecord] ~ {
RETURN [NameForHti[stb[sti].hti]]};
ContextForTree:
PROC [t: Tree.Link]
RETURNS [Symbols.CXIndex] ~ {
RETURN [
WITH t
SELECT
FROM
symbol => WITH stb[index] SELECT FROM local => context, ENDCASE => ERROR,
ENDCASE => ERROR]};
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:
LONG
STRING]
RETURNS [FTIndex] ~ {
ss: SubString ← [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: SubString ← [base~".bcd"L, offset~0, length~4];
st: SubString ← [base~ss.base, offset~ss.offset+ss.length-4, length~4];
IF ConvertUnsafe.EqualSubStrings[st, ext, FALSE] 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: PrincOps.GFTIndex] ~ {
gfi ← nextGfi;
nextGfi ← nextGfi + n;
IF nextGfi > PrincOps.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*ControlItem.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 ~ (
WITH o~~old
SELECT
FROM
direct => MTRecord.direct.SIZE + o.length*Link.SIZE,
indirect => MTRecord.indirect.SIZE,
multiple => MTRecord.multiple.SIZE,
ENDCASE => ERROR);
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];
WITH m~~mtb[mti]
SELECT
FROM
indirect =>
WITH o~~old
SELECT
FROM
indirect => m.links ← EnterLinks[bcd, o.links];
ENDCASE => ERROR;
multiple =>
WITH o~~old
SELECT
FROM
multiple => {
m.links ← EnterLinks[bcd, o.links];
m.refLiterals ← EnterLits[bcd, o.refLiterals];
m.types ← EnterTypes[bcd, o.types]};
ENDCASE => ERROR;
ENDCASE;
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};
}.