MobUtilities:
PROGRAM
IMPORTS Alloc, Basics, CountedVM, ConvertUnsafe, IO, MobErrorDefs, MobHashOps, MobMapper, VM
EXPORTS MobUtilDefs = {
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];
};