MobUtilities.mesa
Copyright Ó 1985, 1989, 1991 by Xerox Corporation. All rights reserved.
Satterthwaite on April 17, 1986 12:43:25 pm PST
Lewis on 16-Dec-80 10:47:39
Maxwell, August 4, 1983 11:54 am
Russ Atkinson (RRA) March 7, 1985 0:11:27 am PST
Andy Litman May 11, 1988 6:08:41 pm PDT
JKF July 22, 1989 3:57:29 pm PDT
Willie-s, September 25, 1991 9:33 pm PDT
DIRECTORY
Alloc USING [AddNotify, DropNotify, Handle, Notifier, Top, Units],
Basics USING [MoveBytes],
ConvertUnsafe USING [EqualSubStrings, SubString],
CountedVM,
IO,
MobDefs,
MobErrorDefs USING [Error2Versions],
MobHashOps USING [EnterString, FindEquivalentString, FindString, SubStringForHash],
MobMapper,
MobSymbols USING [CXIndex, CXRecord, HTIndex, HTNull, STIndex, stNull, STRecord],
MobTree USING [Link],
MobUtilDefs,
Rope,
Table USING [Base],
VM;
MobUtilities: PROGRAM
IMPORTS Alloc, Basics, CountedVM, ConvertUnsafe, IO, MobErrorDefs, MobHashOps, MobMapper, VM
EXPORTS MobUtilDefs = {
OPEN MobDefs;
MobHandle: TYPE ~ MobUtilDefs.MobHandle;
STIndex: TYPE ~ MobSymbols.STIndex;
stNull: STIndex ~ MobSymbols.stNull;
HTIndex: TYPE ~ MobSymbols.HTIndex;
HTNull: HTIndex ~ MobSymbols.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: 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: PUBLIC PROC[ss: SubString] RETURNS[NameRecord] ~ {
hti: HTIndex ~ MobHashOps.EnterString[ss];
RETURN[NameForHti[hti]]};
MapName: PUBLIC PROC[mobh: MobHandle, n: NameRecord] RETURNS[NameRecord] ~ {
ss: SubString ~ [base~mobh.bases.ssb, offset~n+1, length~mobh.bases.ssb[n].ORD];
RETURN[EnterName[ss]]};
MapEquivalentName: PROC[mobh: MobHandle, n: NameRecord]
RETURNS[NameRecord] ~ {
ss: SubString ~ [base~mobh.bases.ssb, offset~n+1, length~mobh.bases.ssb[n].ORD];
hti: HTIndex ¬ MobHashOps.FindString[ss];
IF hti = HTNull THEN hti ¬ MobHashOps.FindEquivalentString[ss];
RETURN[[IF hti # HTNull THEN NameForHti[hti] ELSE EnterName[ss]]]};
HtiForName: PUBLIC PROC[mobh: MobHandle, n: NameRecord] RETURNS[HTIndex] ~ {
ss: SubString ~ [base~mobh.bases.ssb, offset~n+1, length~mobh.bases.ssb[n].ORD];
RETURN[MobHashOps.EnterString[ss]]};
NameForHti: PUBLIC PROC[hti: HTIndex] RETURNS[NameRecord] ~ {
ss: SubString ~ MobHashOps.SubStringForHash[hti];
RETURN[[ss.offset-1]]};
NameForSti: PUBLIC PROC[sti: STIndex] RETURNS[NameRecord] ~ {
RETURN[NameForHti[stb[sti].hti]]};
ContextForTree: PUBLIC PROC[t: MobTree.Link] RETURNS[MobSymbols.CXIndex] ~ {
WITH t SELECT FROM
symbol => WITH stb[index] SELECT FROM local => RETURN[context]; ENDCASE => ERROR;
ENDCASE => ERROR;
};
EqVersions: PUBLIC PROC[fti1, fti2: FTIndex] RETURNS[BOOL] ~ {
RETURN[fti1 = fti2 OR ftb[fti1].version = ftb[fti2].version]};
EquivalentVersions: PUBLIC PROC[v1, v2: VersionStamp] RETURNS[BOOL] ~ {
RETURN[v1 = v2]};
InsertFile: 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.Units[fttype, FTRecord.SIZE];
ftb[fti] ¬ [name~fn, version~version];
IF mismatched THEN MobErrorDefs.Error2Versions[
class~$warning, fileName~fn, v1~version, v2~otherVersion]};
ENDLOOP;
RETURN};
MergeFile: PUBLIC PROC[mobh: MobHandle, oldFti: FTIndex] RETURNS[FTIndex] ~ {
fn: NameRecord;
IF oldFti = FTSelf OR oldFti = FTNull THEN RETURN[oldFti];
fn ¬ MapEquivalentName[mobh, mobh.bases.ftb[oldFti].name];
RETURN[InsertFile[fn, mobh.bases.ftb[oldFti].version]]};
EnterFile: PUBLIC 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~".mob", offset~0, length~4];
st: SubString ~ [base~ss.base, offset~ss.offset+ss.length-4, length~4];
IF st.EqualSubStrings[ext, FALSE] THEN ss.length ¬ ss.length-4};
hti ¬ MobHashOps.FindString[ss];
IF hti = HTNull THEN hti ¬ MobHashOps.FindEquivalentString[ss];
fn ¬ IF hti # HTNull THEN NameForHti[hti] ELSE EnterName[ss];
RETURN[InsertFile[fn, nullV]]};
SetFileVersion: PUBLIC PROC[fti: FTIndex, v: VersionStamp] ~ {
OPEN file~~ftb[fti];
SELECT TRUE FROM
(file.version = NullVersion) => file.version ¬ v;
EquivalentVersions[file.version, v] => NULL;
ENDCASE =>
MobErrorDefs.Error2Versions[
class~$warning, fileName~file.name, v1~v, v2~file.version]
};
FileForVersion: PUBLIC 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 ¬ 0;
nextDummyGfi: CARDINAL ¬ 0;
GftOverflow: PUBLIC SIGNAL ~ CODE;
GetGfi: PUBLIC PROC[n: CARDINAL] RETURNS[gfi: ModuleIndex] ~ {
gfi ¬ nextGfi;
nextGfi ¬ nextGfi + n;
IF nextGfi > ModuleIndex.LAST THEN ERROR GftOverflow;
RETURN};
GetDummyGfi: PUBLIC PROC[n: CARDINAL] RETURNS[gfi: CARDINAL] ~ {
gfi ¬ nextDummyGfi;
nextDummyGfi ¬ nextDummyGfi + n;
RETURN};
NewContext: PUBLIC PROC RETURNS[ctx: MobSymbols.CXIndex] ~ {
ctx ¬ table.Units[cxtype, MobSymbols.CXRecord.SIZE];
cxb[ctx] ¬ [link~stNull];
RETURN};
NewSemanticEntry: PUBLIC PROC[hti: HTIndex] RETURNS[sti: STIndex] ~ {
sti ¬ table.Units[sttype, MobSymbols.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: PUBLIC PROC[mobh: MobHandle, oldCti: CTIndex, name: HTIndex]
RETURNS[cti: CTIndex] ~ {
OPEN old~~mobh.bases.ctb[oldCti];
size: CARDINAL ~ CTRecord.SIZE + old.nControls*Namee.SIZE;
cti ¬ table.Units[cttype, size];
Basics.MoveBytes[srcBase~LOOPHOLE[@old], srcStart~0, dstBase~LOOPHOLE[@ctb[cti]], dstStart~0, count~size*BYTES[UNIT]];
ctb[cti].name ¬ MapName[mobh, old.name];
IF name # HTNull THEN {
ctb[cti].namedInstance ¬ TRUE; CreateInstanceName[name, [0,0,config[cti]]]}
ELSE IF old.namedInstance THEN CopyInstanceName[mobh, [0,0,config[oldCti]], [0,0,config[cti]]];
RETURN};
EnterModule: PUBLIC PROC[mobh: MobHandle, oldMti: MTIndex, name: HTIndex]
RETURNS[mti: MTIndex] ~ {
OPEN old~~mobh.bases.mtb[oldMti];
size: CARDINAL ~ MTRecord.SIZE;
mti ¬ table.Units[mttype, size];
Basics.MoveBytes[dstBase~LOOPHOLE[@mtb[mti]], dstStart~0, srcBase~LOOPHOLE[@old], srcStart~0, count~size*BYTES[UNIT]];
mtb[mti].name ¬ MapName[mobh, old.name];
IF name # HTNull THEN {
mtb[mti].namedInstance ¬ TRUE; CreateInstanceName[name, [0,0,module[mti]]]}
ELSE IF old.namedInstance THEN CopyInstanceName[mobh, [0,0,module[oldMti]], [0,0,module[mti]]];
IF old.variables # EVNull THEN mtb[mti].variables ¬ EnterVariables[mobh, old.variables];
mtb[mti].links ¬ EnterLinks[mobh, old.links];
mtb[mti].refLiterals ¬ EnterLits[mobh, old.refLiterals];
mtb[mti].types ¬ EnterTypes[mobh, old.types];
RETURN};
EnterLinks: PROC[mobh: MobHandle, oldLfi: LFIndex] RETURNS[lfi: LFIndex] ~ {
IF oldLfi = LFNull THEN lfi ¬ LFNull
ELSE {
OPEN old~~mobh.bases.lfb[oldLfi];
size: CARDINAL ~ LinkFrag[old.length].SIZE;
lfi ¬ table.Units[lftype, size];
Basics.MoveBytes[dstBase~LOOPHOLE[@lfb[lfi]], dstStart~0, srcBase~LOOPHOLE[@old], srcStart~0, count~size*BYTES[UNIT]]};
RETURN};
EnterLits: PROC[mobh: MobHandle, oldRfi: RFIndex] RETURNS[rfi: RFIndex] ~ {
IF oldRfi = RFNull THEN rfi ¬ RFNull
ELSE {
OPEN old~~mobh.bases.rfb[oldRfi];
size: CARDINAL ~ RefLitFrag[old.length].SIZE;
rfi ¬ table.Units[rftype, size];
Basics.MoveBytes[dstBase~LOOPHOLE[@rfb[rfi]], dstStart~0, srcBase~LOOPHOLE[@old], srcStart~0, count~size*BYTES[UNIT]]};
RETURN};
EnterTypes: PROC[mobh: MobHandle, oldTfi: TFIndex] RETURNS[tfi: TFIndex] ~ {
IF oldTfi = TFNull THEN tfi ¬ TFNull
ELSE {
OPEN old~~mobh.bases.tfb[oldTfi];
size: CARDINAL ~ TypeFrag[old.length].SIZE;
tfi ¬ table.Units[tftype, size];
Basics.MoveBytes[dstBase~LOOPHOLE[@tfb[tfi]], dstStart~0, srcBase~LOOPHOLE[@old], srcStart~0, count~size*BYTES[UNIT]]};
RETURN};
EnterVariables: PROC[mobh: MobHandle, oldEvi: EVIndex]
RETURNS[evi: EVIndex] ~ {
OPEN old~~mobh.bases.evb[oldEvi];
evLimit: EVIndex ~ table.Top[evtype];
oldLength: CARDINAL ~ old.length;
FOR evi ¬ EVIndex.FIRST, evi+EVRecord.SIZE+evb[evi].length*CARD.SIZE 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.Units[evtype, EVRecord.SIZE+oldLength*CARD.SIZE];
Basics.MoveBytes[dstBase~LOOPHOLE[@evb[evi]], dstStart~0, srcBase~LOOPHOLE[@old], srcStart~0, count~(EVRecord.SIZE+oldLength)*BYTES[UNIT]];
RETURN};
EnterSegment: PUBLIC 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.Units[sgtype, SGRecord.SIZE];
sgb[sgi] ¬ seg;
RETURN};
EnterImport: PUBLIC PROC[mobh: MobHandle, oldIti: IMPIndex, copyName: BOOL]
RETURNS[iti: IMPIndex] ~ {
OPEN old~~mobh.bases.itb[oldIti];
iti ¬ table.Units[imptype, IMPRecord.SIZE];
itb[iti] ¬ old;
itb[iti].name ¬ MapName[mobh, old.name];
IF copyName AND old.namedInstance THEN
CopyInstanceName[mobh, [0,0,import[oldIti]], [0,0,import[iti]]]
ELSE itb[iti].namedInstance ¬ FALSE;
RETURN};
EnterExport: PUBLIC PROC[mobh: MobHandle, oldEti: EXPIndex, copyName: BOOL]
RETURNS[eti: EXPIndex] ~ {
OPEN old~~mobh.bases.etb[oldEti];
size: CARDINAL ~ SIZE[EXPRecord[old.nLinks]];
eti ¬ table.Units[exptype, size];
Basics.MoveBytes[srcBase~LOOPHOLE[@old], srcStart~0, dstBase~LOOPHOLE[@etb[eti]], dstStart~0, count~SIZE[EXPRecord[0]]*BYTES[UNIT]];
FOR i: CARDINAL IN [0..etb[eti].nLinks) DO etb[eti].links[i] ¬ [,0,nullLink]; ENDLOOP;
etb[eti].name ¬ MapName[mobh, old.name];
IF copyName AND old.namedInstance THEN
CopyInstanceName[mobh, [0,0,export[oldEti]], [0,0,export[eti]]]
ELSE etb[eti].namedInstance ¬ FALSE;
RETURN};
EnterType: PUBLIC PROC[mobh: MobHandle, oldTypi: TYPIndex] RETURNS[typi: TYPIndex] ~ {
OPEN old~~mobh.bases.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.Units[typtype, TYPRecord.SIZE]; tyb[typi] ¬ old};
ENDLOOP;
RETURN};
EnterTypeMap: PUBLIC PROC[mobh: MobHandle, oldTmi: TMIndex] RETURNS[tmi: TMIndex] ~ {
OPEN old~~mobh.bases.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.Units[tmtype, TMRecord.SIZE];
tmb[tmi] ¬ [version~old.version, offset~old.offset, map~TYPNull]};
ENDLOOP;
RETURN};
EnterSpace: PUBLIC PROC[mobh: MobHandle, oldSpi: SPIndex] RETURNS[spi: SPIndex] ~ {
OPEN old~~mobh.bases.spb[oldSpi];
size: CARDINAL ~ SPRecord.SIZE + old.length*SpaceID.SIZE;
spi ¬ table.Units[sptype, size];
Basics.MoveBytes[srcBase~LOOPHOLE[@old], srcStart~0, dstBase~LOOPHOLE[@spb[spi]], dstStart~0, count~size*BYTES[UNIT]];
FOR i: CARDINAL IN [0 .. spb[spi].length) DO
spb[spi].spaces[i].name ¬ MapName[mobh, old.spaces[i].name];
ENDLOOP;
RETURN};
EnterFramePack: PUBLIC PROC[mobh: MobHandle, oldFpi: FPIndex] RETURNS[fpi: FPIndex] ~ {
OPEN old~~mobh.bases.fpb[oldFpi];
size: CARDINAL ~ FPRecord.SIZE + old.length*MTIndex.SIZE;
fpi ¬ table.Units[fptype, size];
Basics.MoveBytes[srcBase~LOOPHOLE[@old], srcStart~0, dstBase~LOOPHOLE[@fpb[fpi]], dstStart~0, count~size*BYTES[UNIT]];
fpb[fpi].name ¬ MapName[mobh, old.name];
RETURN};
CreateInstanceName: PUBLIC PROC[hti: HTIndex, item: Namee] ~ {
nti: NTIndex ~ table.Units[nttype, NTRecord.SIZE];
ntb[nti] ¬ [item~item, name~NameForHti[hti]]};
InstanceName: PUBLIC 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: PROC[mobh: MobHandle, old, new: Namee] ~ {
nti: NTIndex = table.Units[nttype, NTRecord.SIZE];
FOR oldNti: NTIndex ¬ NTIndex.FIRST, oldNti + NTRecord.SIZE DO
IF (mobh.bases.ntb[oldNti]).item = old THEN {
ntb[nti] ¬ [item~new, name~MapName[mobh, mobh.bases.ntb[oldNti].name]]; RETURN};
ENDLOOP
};
MobReaderErr: PUBLIC ERROR [err: Rope.ROPE] = CODE;
bytesPerWord: CARD = BYTES[WORD];
bytesPerVMWord: CARD = BYTES[WORD];
ReadMob: PUBLIC PROC [stream: IO.STREAM] RETURNS [h: MobHandle] = TRUSTED {
bytes: INT ¬ IO.GetLength[stream];
allocatedBytes: CARD ¬ VM.WordsForPages[VM.PagesForBytes[bytes]] * bytesPerVMWord;
vmh: CountedVM.Handle;
mobBase: MobDefs.MobBase;
IF bytes = 0 THEN ERROR MobReaderErr[err: "Attempt to read from 0 length stream."];
vmh ¬ CountedVM.SimpleAllocate[allocatedBytes/bytesPerWord];
Basics.Fill[where: vmh.pointer, nWords: allocatedWord32s, value: CARD.LAST];
IO.SetIndex[stream, 0];
[] ¬ IO.UnsafeGetBlock[
self: stream,
block: [base: vmh.pointer, startIndex: 0, count: bytes]];
mobBase ¬ LOOPHOLE[vmh.pointer];
IF MobMapper.AlterMob[mobBase, LOOPHOLE[mobBase], bytes/BYTES[UNIT]] = badVersion THEN
ERROR MobReaderErr[err:"MobMapper.AlterMob failed in MobUtilities.ReadMob"];
h ¬ NEW[MobUtilDefs.MobObject ¬ [
bHeader: mobBase,
countedVMHandle: vmh,
bases: [
ctb: LOOPHOLE[mobBase + mobBase.ctOffset.units],
mtb: LOOPHOLE[mobBase + mobBase.mtOffset.units],
lfb: LOOPHOLE[mobBase + mobBase.lfOffset.units],
rfb: LOOPHOLE[mobBase + mobBase.rfOffset.units],
tfb: LOOPHOLE[mobBase + mobBase.tfOffset.units],
etb: LOOPHOLE[mobBase + mobBase.expOffset.units],
itb: LOOPHOLE[mobBase + mobBase.impOffset.units],
sgb: LOOPHOLE[mobBase + mobBase.sgOffset.units],
ftb: LOOPHOLE[mobBase + mobBase.ftOffset.units],
ssb: LOOPHOLE[mobBase + mobBase.ssOffset.units],
evb: LOOPHOLE[mobBase + mobBase.evOffset.units],
tyb: LOOPHOLE[mobBase + mobBase.typOffset.units],
tmb: LOOPHOLE[mobBase + mobBase.tmOffset.units],
ntb: LOOPHOLE[mobBase + mobBase.ntOffset.units],
spb: LOOPHOLE[mobBase + mobBase.spOffset.units],
fpb: LOOPHOLE[mobBase + mobBase.fpOffset.units]
],
limits: [
ct: mobBase.ctLimit,
mt: mobBase.mtLimit,
et: mobBase.expLimit,
it: mobBase.impLimit,
sg: mobBase.sgLimit,
ft: mobBase.ftLimit,
tm: mobBase.tmLimit,
nt: mobBase.ntLimit,
sp: mobBase.spLimit,
fp: mobBase.fpLimit]
]];
};
nullBases: MobUtilDefs.MobBases = [NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL];
nullLimits: MobUtilDefs.MobLimits = [FTNull, CTNull, MTNull, EXPNull, IMPNull, SGNull, NTNull, TMNull, SPNull, FPNull];
FreeMob: PUBLIC PROC [h: MobHandle] = {
h.bHeader ¬ NIL;
h.bases ¬ nullBases;
h.limits ¬ nullLimits;
CountedVM.Free[h.countedVMHandle];
};
Administrative Procedures
Init: PUBLIC PROC[ownTable: Alloc.Handle] ~ {
table ¬ ownTable;
table.AddNotify[Notifier];
nextGfi ¬ nextDummyGfi ¬ 1};
Reset: PUBLIC PROC ~ {
table.DropNotify[Notifier];
table ¬ NIL};
}.