MobLoad:
PROGRAM
IMPORTS Alloc, ConvertUnsafe, MobErrorDefs, MobFileDefs, MobUtilDefs, --MobLiterals,-- OSMiscOps, MobTreeOps, MobComData
EXPORTS MobControlDefs = {
OPEN MobDefs;
TYPES
Sons: TYPE = MobTree.ConfigSons;
FileMapItem: TYPE ~ RECORD [old, new: FTIndex];
InterfaceOp: TYPE ~ MobTree.NodeName [$plus..$then];
ExportAssigner: TYPE ~ PROC[mobh: MobHandle];
MobHandle: TYPE = MobUtilDefs.MobHandle;
MobObject: TYPE = MobUtilDefs.MobObject;
MobRelocations: TYPE ~ MobBindDefs.Relocations;
FileMap: TYPE ~ RECORD [SEQUENCE length: CARDINAL OF FTIndex];
State:
TYPE =
RECORD[
SELECT tag:*
FROM
first => [root: MobTree.Link], -- passed in by client
more => [root, current: MobTree.Link, n: CARDINAL],
done => [last: MobTree.Link],
ENDCASE];
Errors
LoadError: PUBLIC ERROR ~ CODE;
Globals
currentCx, loadCx: MobSymbols.CXIndex ¬ MobSymbols.cxNull;
loadMobTree: MobTree.Index;
loadExpi: EXPIndex;
packSti: MobSymbols.STIndex;
currentOp: InterfaceOp;
table: Alloc.Handle;
tb, stb, cxb: Table.Base;
exportsALL: BOOL;
localMobH: MobUtilDefs.MobHandle ¬ NEW[MobObject ¬ [NIL, NIL, MobUtilDefs.nullBases, MobUtilDefs.nullLimits]];
currentLinkLoc: LinkLocKind ¬ $framePrefix;
explicitLinkLoc: BOOL ¬ FALSE;
relocationHead: MobBindDefs.RelocHandle;
rel: MobBindDefs.RelocHandle;
fileMap: REF FileMap ¬ NIL;
processExports: ExportAssigner;
mobFti: FTIndex ¬ FTNull;
nextLocalGfi: CARDINAL ¬ 0;
lhs: MobTree.Link ¬ MobTree.null;
currentParms: MobTree.Link;
Constants
Notifier: Alloc.Notifier ~ {
tb ¬ base[treetype];
stb ¬ base[sttype];
cxb ¬ base[cxtype];
localMobH.bases ¬ [
ssb: base[sstype],
ctb: base[cttype],
mtb: base[mttype],
lfb: base[lftype],
rfb: base[rftype],
tfb: base[tftype],
etb: base[exptype],
evb: base[evtype],
itb: base[imptype],
sgb: base[sgtype],
ftb: base[fttype],
tyb: base[typtype],
tmb: base[tmtype],
ntb: base[nttype],
spb: base[sptype],
fpb: base[fptype]]
};
Error:
PROC ~ {
ERROR LoadError};
LoadRoot:
PUBLIC
PROC [root: MobTree.Link]
RETURNS [MobBindDefs.RelocHandle] ~ {
node: MobTree.Index;
table ¬ MobComData.data.table;
table.AddNotify[Notifier];
currentOp ¬ $plus;
currentParms ¬ MobTree.null;
processExports ¬ VerifyExports;
relocationHead ¬ NIL;
loadExpi ¬ EXPNull;
loadMobTree ¬ MobTree.nullIndex;
loadCx ¬ MobSymbols.cxNull;
exportsALL ¬ FALSE;
MobComData.data.typeExported ¬ FALSE;
node ¬ MobTreeOps.GetNode[root];
SELECT tb[node].name
FROM
$source => {
packSti ¬ FindSti[tb[node].son[2]];
[] ¬ LoadLocalConfig[MobTreeOps.GetNode[tb[node].son[3]], $outer, MobSymbols.HTNull, localMobH];
};
ENDCASE => Error[];
table.DropNotify[Notifier];
table ¬ NIL;
RETURN [relocationHead];
};
UnloadRoot:
PUBLIC
PROC = {
relocationHead ¬ NIL;
localMobH.bases ¬ MobUtilDefs.nullBases;
localMobH.limits ¬ MobUtilDefs.nullLimits;
localMobH.bHeader ¬ NIL;
--IF localMobH.countedVMHandle # NIL THEN CountedVM.Free[localMobH];
localMobH ¬ NIL;
};
FindSti:
PROC [t: MobTree.Link]
RETURNS [MobSymbols.STIndex] ~ {
RETURN [
IF t = MobTree.null
THEN MobSymbols.stNull
ELSE
WITH t
SELECT
FROM
symbol => index,
subtree => FindSti[tb[index].son[1]],
ENDCASE => ERROR LoadError]
};
LoadLocalConfig:
PROC [node: MobTree.Index, level: MobBindDefs.RelocType, name: MobSymbols.HTIndex, mobh: MobHandle]
RETURNS [MobSymbols.STMap] ~ {
BodyWalk: MobTree.Scan ~ {
WITH t
SELECT
FROM
symbol => LoadSti[index, MobSymbols.HTNull, mobh];
subtree => {
node: MobTree.Index ~ index;
saveIndex: INT ~ MobComData.data.textIndex;
MobComData.data.textIndex ¬ tb[node].info;
SELECT tb[node].name
FROM
$list => MobTreeOps.ScanList[t, BodyWalk];
$item => LoadItem[t, mobh];
$config => NULL;
$assign => LoadAssign[t, mobh];
$module => {currentParms ¬ tb[node].son[2]; LoadItem[tb[node].son[1], mobh]};
ENDCASE => Error[];
MobComData.data.textIndex ¬ saveIndex;
};
ENDCASE => Error[];
saveCx: MobSymbols.CXIndex ~ currentCx;
saveLhs: MobTree.Link ~ lhs;
saveAssigner: ExportAssigner ~ processExports;
saveName: NameRecord ~ MobComData.data.currentName;
saveIndex: INT ~ MobComData.data.textIndex;
currentCti: CTIndex;
firstConfig: CTIndex ~ table.Top[cttype];
firstModule: MTIndex ~ table.Top[mttype];
localRel: MobBindDefs.RelocHandle;
firstImport: IMPIndex ~ table.Top[imptype];
MobComData.data.textIndex ¬ tb[node].info;
lhs ¬ MobTree.null;
processExports ¬ NormalExports;
currentCx ¬ MobUtilDefs.ContextForTree[tb[node].son[Sons.name.ORD]];
AllocateRelocations[level];
localRel ¬ rel;
localRel.parentcx ¬ saveCx;
BodyWalk[tb[node].son[Sons.body.ORD]]; -- process body of config
IF MobComData.data.op = $bind
THEN {
nControls: CARDINAL ¬ 0;
CountControl:
PROC [item: Namee, sti: MobSymbols.STIndex] ~ {
nControls ¬ nControls + 1;
IF item = [0,0,module[MTNull]]
AND sti # MobSymbols.stNull
THEN
MobErrorDefs.ErrorHti[$error, "is not valid as a CONTROL module", stb[sti].hti];
};
EnumerateControls[tb[node].son[Sons.control.ORD], CountControl, mobh];
currentCti ¬ table.Units[cttype, CTRecord.SIZE + nControls*Namee.SIZE];
BEGIN
OPEN newConfig: localMobH.bases.ctb[currentCti];
i: CARDINAL ¬ 0;
AssignControl:
PROC [item: Namee, sti: MobSymbols.STIndex] ~ {
newConfig.controls[i] ¬ item;
i ¬ i+1;
};
MobComData.data.currentName ¬ newConfig.name ¬ NameForLink[tb[node].son[Sons.name.ORD]];
IF name = MobSymbols.HTNull
THEN newConfig.namedInstance ¬ FALSE
ELSE {
newConfig.namedInstance ¬ TRUE;
MobUtilDefs.CreateInstanceName[name, [0,0,config[currentCti]]];
};
newConfig.file ¬ FTSelf;
newConfig.config ¬ CTNull;
UpdateConfigParent[currentCti, firstConfig, currentCti];
UpdateModuleParent[currentCti, firstModule, table.Top[mttype]];
newConfig.nControls ¬ nControls;
EnumerateControls[tb[node].son[Sons.control.ORD], AssignControl, mobh];
END;
};
lhs ¬ saveLhs; processExports ¬ saveAssigner;
loadMobTree ¬ node;
loadCx ¬ currentCx;
currentCx ¬ saveCx;
exportsALL ¬ tb[node].attrs[$exportsALL];
processExports[mobh];
currentCx ¬ loadCx;
localRel.import ¬ table.Bounds[imptype].size;
localRel.dummygfi ¬ MobUtilDefs.GetDummyGfi[0];
ProcessLocalImports[firstImport];
localRel.importLimit ¬ table.Top[imptype];
loadMobTree ¬ MobTree.nullIndex;
loadCx ¬ MobSymbols.cxNull;
currentCx ¬ saveCx;
MobComData.data.currentName ¬ saveName;
MobComData.data.textIndex ¬ saveIndex;
RETURN [[config[currentCti]]];
};
EnumerateControls:
PROC [t: MobTree.Link, proc:
PROC [Namee, MobSymbols.STIndex], mobh: MobHandle] ~ {
Item: MobTree.Scan ~ {
WITH t
SELECT
FROM
symbol => {
sti: MobSymbols.STIndex ~ index;
BEGIN
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
module => proc[[0,0,module[m.mti]], sti];
interface =>
IF localMobH.bases.etb[m.expi].port = $module
THEN {
gfi: ModuleIndex ~ localMobH.bases.etb[m.expi].links[0].from.modIndex;
FindModule:
PROC [mti: MTIndex]
RETURNS [stop:
BOOL] ~ {
RETURN [localMobH.bases.mtb[mti].modIndex = gfi];
};
mobh.limits.mt ¬ table.Top[mttype];
proc[[0,0,module[EnumerateModules[FindModule, mobh]]], sti];
}
ELSE GOTO notvalid;
config =>
-- proc[[0,0,config[m.cti]], sti];
FOR i:
CARDINAL
IN [0 .. localMobH.bases.ctb[m.cti].nControls)
DO
proc[localMobH.bases.ctb[m.cti].controls[i], MobSymbols.stNull];
ENDLOOP;
ENDCASE => GOTO notvalid;
local =>
WITH m~~s.map
SELECT
FROM
config =>
-- proc[[0,0,config[m.cti]], sti];
FOR i:
CARDINAL
IN [0 .. localMobH.bases.ctb[m.cti].nControls)
DO
proc[localMobH.bases.ctb[m.cti].controls[i], MobSymbols.stNull];
ENDLOOP;
ENDCASE => GOTO notvalid;
ENDCASE => GOTO notvalid;
EXITS
notvalid => proc[[0,0,module[MTNull]], sti];
END;
};
ENDCASE => Error[];
};
MobTreeOps.ScanList[t, Item];
};
NameForLink:
PROC [t: MobTree.Link]
RETURNS [NameRecord] ~ {
RETURN [
WITH t
SELECT
FROM
symbol => MobUtilDefs.NameForSti[index],
ENDCASE => NullName];
};
LoadSti:
PROC [sti: MobSymbols.STIndex, name: MobSymbols.HTIndex, mobh: MobHandle] ~ {
ENABLE MobErrorDefs.GetSti => {RESUME [sti]};
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH p~~s
SELECT
FROM
file => s.map ¬ Load[sti, name];
instance => s.map ¬ Load[p.sti, name];
ENDCASE => Error[];
local => s.map ¬ LoadLocalConfig[s.info, $inner, name, mobh];
ENDCASE => NotLoadable[sti];
};
NotLoadable:
PROC [sti: MobSymbols.STIndex] ~ {
MobErrorDefs.ErrorSti[$error, "is not loadable (probably needs ""[]"")", sti];
};
FileForSti:
PROC [sti: MobSymbols.STIndex]
RETURNS [FTIndex] ~ {
RETURN [
IF sti = MobSymbols.stNull THEN FTNull
ELSE
WITH s~~stb[sti]
SELECT
FROM
unknown => FTNull,
external =>
WITH p~~s
SELECT
FROM
file => p.fti,
instance => FileForSti[p.sti],
ENDCASE => ERROR LoadError,
ENDCASE => ERROR LoadError];
};
FileForPortableItem:
PROC [p: PortableItem, mobh: MobHandle]
RETURNS [FTIndex] ~ {
RETURN [
WITH p
SELECT
FROM
interface => MapFile[mobh.bases.etb[expi].file, mobh],
module => MapFile[mobh.bases.mtb[mti].file, mobh],
ENDCASE => ERROR LoadError];
};
DeclarePortableItem:
PROC [sti: MobSymbols.STIndex, p: PortableItem, mobh: MobHandle] ~ {
WITH p
SELECT
FROM
interface => DeclareInterface[sti, expi, TRUE, mobh];
module => DeclareModule[sti, mti, TRUE, mobh];
ENDCASE => Error[];
};
DeclareInterface:
PROC [sti: MobSymbols.STIndex, eti: EXPIndex, setMap:
BOOL, mobh: MobHandle] ~ {
fti: FTIndex ~ MapFile[mobh.bases.etb[eti].file, mobh];
WITH s~~stb[sti]
SELECT
FROM
external => {
IF setMap THEN s.map ¬ [interface[EXPNull]];
WITH p~~s
SELECT
FROM
instance =>
IF p.sti = MobSymbols.stNull THEN s.pointer ¬ file[fti] ELSE DeclareInterface[p.sti, eti, FALSE, mobh];
file => p.fti ¬ fti;
ENDCASE => Error[];
};
unknown =>
stb[sti].body ¬ external[
pointer~file[fti],
map~(IF setMap THEN [interface[EXPNull]] ELSE [unknown[]])];
ENDCASE => Error[];
};
DeclareModule:
PROC [sti: MobSymbols.STIndex, mti: MTIndex, setMap:
BOOL, mobh: MobHandle] ~ {
WITH s~~stb[sti]
SELECT
FROM
external => {
IF setMap THEN s.map ¬ [module[MTNull]];
WITH p~~s
SELECT
FROM
instance => DeclareModule[p.sti, mti, FALSE, mobh];
file => p.fti ¬ MapFile[mobh.bases.mtb[mti].file, mobh];
ENDCASE => Error[];
};
unknown => {
fti: FTIndex ~ MapFile[mobh.bases.mtb[mti].file, mobh];
stb[sti].body ¬ external[
pointer~file[fti],
map~(IF setMap THEN [module[MTNull]] ELSE [unknown[]])];
};
ENDCASE => Error[];
};
LoadItem:
PROC [t: MobTree.Link, mobh: MobHandle] ~ {
node: MobTree.Index ~ MobTreeOps.GetNode[t];
IF tb[node].name # $item THEN Error[];
WITH s1~~tb[node].son[1]
SELECT
FROM
symbol => {
sti: MobSymbols.STIndex ~ s1.index;
currentLinkLoc ¬ IF tb[node].attrs[$codeLinks] THEN $codePrefix ELSE $framePrefix;
explicitLinkLoc ¬ tb[node].attrs[$explicitLinkLoc];
LoadSti[sti, (IF tb[node].son[2] = MobTree.null THEN MobSymbols.HTNull ELSE stb[sti].hti), mobh];
};
ENDCASE => Error[];
};
MapFile:
PROC[fti: MobDefs.FTIndex, mobh: MobHandle]
RETURNS[MobDefs.FTIndex] ~ {
SELECT
TRUE
FROM
(mobh.bases = localMobH.bases) => RETURN [fti]; -- CHECK THIS (perf problem)
(fti = FTSelf) => RETURN [mobFti];
(fti = FTNull) => RETURN [FTNull];
ENDCASE => {
fileIndex: CARD ~ LOOPHOLE[fti, CARD]/FTRecord.SIZE;
IF fileMap[fileIndex] = FTNull THEN fileMap[fileIndex] ¬ MobUtilDefs.MergeFile[mobh, fti];
RETURN [fileMap[fileIndex]]
};
};
AllocateRelocations:
PROC [type: MobBindDefs.RelocType] ~ {
p: MobBindDefs.RelocHandle ~ NEW[MobRelocations];
IF relocationHead = NIL THEN relocationHead ¬ p ELSE rel.link ¬ p;
rel ¬ p;
IF (rel.type ¬ type) = $file
THEN {
rel.firstgfi ¬ rel.lastgfi ¬ MobUtilDefs.GetGfi[0];
rel.dummygfi ¬ MobUtilDefs.GetDummyGfi[0];
rel.import ¬ table.Bounds[imptype].size;
rel.importLimit ¬ LOOPHOLE[rel.import];
rel.module ¬ table.Bounds[mttype].size;
rel.config ¬ table.Bounds[cttype].size;
rel.parentcx ¬ MobSymbols.cxNull;
}
ELSE rel.originalfirstdummy ¬ 1;
rel.textIndex ¬ MobComData.data.textIndex;
rel.context ¬ currentCx;
rel.parameters ¬ currentParms;
currentParms ¬ MobTree.null;
};
Load:
PROC [sti: MobSymbols.STIndex, name: MobSymbols.HTIndex]
RETURNS [map: MobSymbols.STMap] ~ {
mobh: MobHandle ¬ NIL;
mob: MobUtilDefs.MobBasePtr ¬ NIL;
fti: FTIndex ~ FileForSti[sti];
nFiles: CARD;
BEGIN
IF fti = FTNull
THEN {
NotLoadable[SIGNAL MobErrorDefs.GetSti];
GOTO fail;
};
IF fti = MobComData.data.outputFti
THEN
MobErrorDefs.Error[$error, "Output file referenced as input"];
mobh ¬ LoadMob[fti
!
MobFileDefs.UnknownFile => {
MobErrorDefs.ErrorFile[$error, "cannot be opened", fti];
GOTO fail;
};
MobFileDefs.MobFileErr => {
s: STRING ¬ [200];
ConvertUnsafe.AppendRope[s, err];
MobErrorDefs.ErrorFile[$error, s, fti];
GOTO fail;
};
EmptyMobFile => {
MobErrorDefs.ErrorFile[$error, "is empty", fti];
GOTO fail;
};
DefsFile => {
MobErrorDefs.ErrorFile[$error, "is a definitions file", fti];
GOTO fail;
};
NonDefsFile => {
MobErrorDefs.ErrorFile[$error, "is not a definitions file", fti];
GOTO fail;
};
IncompatibleVersion => {
MobErrorDefs.ErrorFile[$error, "has an incompatible version", fti];
GOTO fail;
}];
EXITS fail => RETURN [[unknown[]]];
END;
nFiles ¬ LOOPHOLE[mobh.limits.ft, CARD]/FTRecord.SIZE;
fileMap ¬ NEW[FileMap[nFiles]];
FOR i: CARDINAL IN [0..fileMap.length) DO fileMap[i] ¬ FTNull ENDLOOP;
<<
IF mobh.bHeader.extended
THEN
IF ~MobLiterals.Load[MobComData.data.literals, mobh, MapFile, MapSegment].success
THEN
MobErrorDefs.ErrorFile[$error, "has an incompatible version", fti];
>>
IF mobh.limits.ct # CTIndex.
FIRST
THEN {
configuration
map ¬ LoadConfigs[name, sti, mobh];
[] ¬ LoadModules[MobSymbols.HTNull, sti, mobh];
}
ELSE
map ¬ LoadModules[name, sti, mobh];
ProcessTypeMap[mobh];
processExports[mobh];
ProcessImports[mobh];
LoadSpaces[mobh];
LoadFramePacks[mobh];
rel.lastgfi ¬ MobUtilDefs.GetGfi[0]-1;
rel.importLimit ¬ LOOPHOLE[table.Bounds[imptype].size];
IF mobh.bHeader.typeExported THEN MobComData.data.typeExported ¬ TRUE;
--IF mobh.bHeader.extended THEN MobLiterals.Unload[MobComData.data.literals];
UnloadMob[mobh];
fileMap ¬ NIL;
};
CheckInternalName:
PROC [name: NameRecord, sti: MobSymbols.STIndex] ~ {
IF name # MobUtilDefs.NameForSti[sti]
THEN
MobErrorDefs.ErrorSti[$error,
"does not match the module or configuration name in the Mob", sti];
};
EmptyMobFile: ERROR ~ CODE;
DefsFile: ERROR ~ CODE;
NonDefsFile: ERROR ~ CODE;
IncompatibleVersion: ERROR ~ CODE;
LoadMob:
PROC [fti: FTIndex]
RETURNS [mobh: MobHandle] ~ {
mobh ¬ MobFileDefs.CapabilityForFile[fti]; -- CHECK THIS (what about errors?)
SELECT MobComData.data.op
FROM
$bind => IF mobh.bHeader.definitions THEN {UnloadMob[NIL]; ERROR DefsFile};
$conc => IF ~mobh.bHeader.definitions THEN {UnloadMob[NIL]; ERROR NonDefsFile};
ENDCASE;
mobFti ¬ fti;
MobUtilDefs.SetFileVersion[fti, mobh.bHeader.version];
MobComData.data.objectStamp ¬ OSMiscOps.MergeStamps[
MobComData.data.objectStamp, OSMiscOps.TimeToStamp[mobh.bHeader.version]];
AllocateRelocations[$file];
rel.originalfirstdummy ¬ mobh.bHeader.firstdummy;
};
UnloadMob:
PROC [mobh: MobHandle] ~ {
IF mobh # NIL THEN MobUtilDefs.FreeMob[mobh];
};
CTRecordSize:
PROC [ctb: Table.Base, cti: CTIndex]
RETURNS [
NAT] ~ {
RETURN [CTRecord.SIZE + ctb[cti].nControls*Namee.SIZE];
};
EnumerateConfigurations:
PROC [proc:
PROC [CTIndex], mobh: MobHandle] ~ {
cti: CTIndex ¬ CTIndex.FIRST;
UNTIL cti = mobh.limits.ct
DO
proc[cti];
cti ¬ cti + CTRecordSize[mobh.bases.ctb, cti];
ENDLOOP;
};
LoadConfigs:
PROC [name: MobSymbols.HTIndex, sti: MobSymbols.STIndex, mobh: MobHandle]
RETURNS [MobSymbols.STMap] ~ {
rootCti: CTIndex ¬ CTNull;
LoadConfig:
PROC [cti: CTIndex] ~ {
root: BOOL ~ mobh.bases.ctb[cti].config = CTNull;
newCti: CTIndex ~ MobUtilDefs.EnterConfig[mobh, cti,
IF root
THEN name
ELSE MobSymbols.HTNull];
BEGIN OPEN new~~localMobH.bases.ctb[newCti];
IF ~root THEN new.config ¬ new.config + rel.config
ELSE {
CheckInternalName[new.name, sti];
IF rootCti # CTNull
THEN
MobErrorDefs.ErrorSti[$warning, "contains multiple root configs", sti];
rootCti ¬ newCti; new.config ¬ CTNull};
new.file ¬ MapFile[new.file, mobh];
FOR i:
CARDINAL
IN [0 .. new.nControls)
DO
WITH c~~new.controls[i]
SELECT
FROM
module => c.mti ¬ c.mti + rel.module;
config => c.cti ¬ c.cti + rel.config;
ENDCASE => ERROR;
ENDLOOP;
END};
EnumerateConfigurations[LoadConfig, mobh];
RETURN [[config[rootCti]]];
};
UpdateConfigParent:
PROC [parent: CTIndex, first, limit: CTIndex] ~ {
FOR cti: CTIndex ¬ first, cti + CTRecordSize[localMobH.bases.ctb, cti]
UNTIL cti = limit
DO
OPEN new~~localMobH.bases.ctb[cti];
IF new.config = CTNull THEN new.config ¬ parent;
ENDLOOP;
};
EnumerateModules:
PROC
[proc:
PROC [MTIndex]
RETURNS [
BOOL], mobh: MobHandle]
RETURNS [mti: MTIndex] ~ {
mti ¬ MTIndex.FIRST;
UNTIL mti = mobh.limits.mt
DO
IF proc[mti] THEN RETURN;
mti ¬ mti + MTRecord.SIZE;
ENDLOOP;
RETURN [MTNull];
};
CheckPacking:
PROC [mti: MTIndex] ~ {
name: NameRecord ~ localMobH.bases.mtb[mti].name;
FOR sti: MobSymbols.STIndex ¬ packSti, stb[sti].link
UNTIL sti = MobSymbols.stNull
DO
IF MobUtilDefs.NameForSti[sti] = name
THEN {
stb[sti].body ¬ external[
map~[module[mti]], pointer~file[localMobH.bases.mtb[mti].file]];
EXIT};
ENDLOOP;
};
MapSegment:
PROC [sgi: MobDefs.SGIndex, mobh: MobHandle]
RETURNS[MobDefs.SGIndex] ~ {
seg: SGRecord ¬ mobh.bases.sgb[sgi];
seg.file ¬ MapFile[seg.file, mobh];
RETURN [MobUtilDefs.EnterSegment[seg]];
};
LoadModules:
PROC [name: MobSymbols.HTIndex, sti: MobSymbols.STIndex, mobh: MobHandle]
RETURNS [MobSymbols.STMap] ~ {
rootMti: MTIndex ¬ MTNull;
LoadModule:
PROC [mti: MTIndex]
RETURNS [
BOOL ¬
FALSE] ~ {
root: BOOL ~ mobh.bases.mtb[mti].config = CTNull;
newMti: MTIndex = MobUtilDefs.EnterModule[mobh, mti,
IF root
THEN name
ELSE MobSymbols.HTNull];
BEGIN OPEN new~~localMobH.bases.mtb[newMti];
name ¬ MobSymbols.HTNull;
IF ~root THEN new.config ¬ new.config + rel.config
ELSE {
CheckInternalName[new.name, sti];
IF rootMti # MTNull
THEN
MobErrorDefs.ErrorSti[$warning, "contains multiple modules", sti];
rootMti ¬ newMti; new.config ¬ CTNull};
new.modIndex ¬ MobUtilDefs.GetGfi[1];
new.file ¬ MapFile[new.file, mobh];
new.code.sgi ¬ MapSegment[new.code.sgi, mobh];
new.sseg ¬ MapSegment[new.sseg, mobh];
CheckPacking[newMti];
IF root THEN new.linkLoc ¬ currentLinkLoc
ELSE
IF explicitLinkLoc
AND currentLinkLoc # new.linkLoc
THEN
NULL;
MobErrorDefs.ErrorModule[
warning," has already been bound with a different link location", newMti];
<<
IF new.types # TFNull
THEN {
OPEN tfh~~localMobH.bases.tfb[new.types];
FOR i:
NAT
IN [0..tfh.length)
DO
tfh.frag[i] ¬ MobLiterals.MapTypeLink[MobComData.data.literals, tfh.frag[i]];
ENDLOOP
};
IF new.refLiterals # RFNull
THEN {
OPEN rfh~~localMobH.bases.rfb[new.refLiterals];
FOR i:
NAT
IN [0..rfh.length)
DO
rfh.frag[i] ¬ MobLiterals.MapLitLink[MobComData.data.literals, rfh.frag[i]];
ENDLOOP
};
>>
END;
};
[] ¬ EnumerateModules[LoadModule, mobh];
RETURN [[module[rootMti]]];
};
UpdateModuleParent:
PROC [parent: CTIndex, first, limit: MTIndex] ~ {
FOR mti: MTIndex ¬ first, mti + MTRecord.
SIZE
UNTIL mti = limit
DO
OPEN new~~localMobH.bases.mtb[mti];
IF new.config = CTNull THEN new.config ¬ parent;
ENDLOOP;
};
ProcessTypeMap:
PROC [mobh: MobHandle] ~ {
FOR tmi: TMIndex ¬ TMIndex.
FIRST, tmi + TMRecord.
SIZE
UNTIL tmi = mobh.limits.tm
DO
newTypi: TYPIndex ~ MobUtilDefs.EnterType[mobh, mobh.bases.tmb[tmi].map];
newTmi: TMIndex ~ MobUtilDefs.EnterTypeMap[mobh, tmi];
BEGIN OPEN new~~localMobH.bases.tmb[newTmi];
SELECT new.map
FROM
TYPNull => new.map ¬ newTypi;
newTypi => NULL;
ENDCASE => {
fti: FTIndex ~ MobUtilDefs.FileForVersion[new.version];
MobErrorDefs.ErrorItem[$error,
"is an exported type with clashing definitions", [NullName, fti], new.offset]};
END;
ENDLOOP;
};
EnumerateSpaces:
PROC [proc:
PROC [SPIndex]
RETURNS [
BOOL], mobh: MobHandle]
RETURNS [spi: SPIndex] ~ {
spi ¬ SPIndex.FIRST;
UNTIL spi = mobh.limits.sp
DO
IF proc[spi] THEN RETURN;
spi ¬ spi + SPRecord.SIZE + mobh.bases.spb[spi].length*SpaceID.SIZE;
ENDLOOP;
RETURN [SPNull];
};
LoadSpaces:
PROC [mobh: MobHandle] ~ {
LoadSpace:
PROC [spi: SPIndex]
RETURNS [
BOOL ¬
FALSE] ~ {
newSpi: SPIndex ~ MobUtilDefs.EnterSpace[mobh, spi];
localMobH.bases.spb[newSpi].seg ¬ MapSegment[mobh.bases.spb[spi].seg, mobh];
};
[] ¬ EnumerateSpaces[LoadSpace, mobh];
};
EnumerateFramePacks:
PROC
[proc:
PROC [FPIndex]
RETURNS [
BOOL], mobh: MobHandle]
RETURNS [fpi: FPIndex] ~ {
fpi ¬ FPIndex.FIRST;
UNTIL fpi = mobh.limits.fp
DO
IF proc[fpi] THEN RETURN;
fpi ¬ fpi + FPRecord.SIZE + mobh.bases.fpb[fpi].length*MTIndex.SIZE;
ENDLOOP;
RETURN [FPNull];
};
LoadFramePacks:
PROC [mobh: MobHandle] ~ {
LoadFramePack:
PROC [fpi: FPIndex]
RETURNS [
BOOL ¬
FALSE] ~ {
newFpi: FPIndex ~ MobUtilDefs.EnterFramePack[mobh, fpi];
FOR i:
CARDINAL
IN [0 .. localMobH.bases.fpb[newFpi].length)
DO
localMobH.bases.fpb[newFpi].modules[i] ¬ localMobH.bases.fpb[newFpi].modules[i] + rel.module;
ENDLOOP;
};
[] ¬ EnumerateFramePacks[LoadFramePack, mobh];
};
ProcessImports:
PROC [mobh: MobHandle] ~ {
FOR impi: IMPIndex ¬ FirstImport[mobh], NextImport[impi, mobh]
UNTIL impi = IMPNull
DO
newImpi: IMPIndex ~ MobUtilDefs.EnterImport[mobh, impi, TRUE];
localMobH.bases.itb[newImpi].file ¬ MapFile[localMobH.bases.itb[newImpi].file, mobh];
[] ¬ MobUtilDefs.GetDummyGfi[1];
ENDLOOP;
};
FirstImport:
PROC[mobh: MobHandle]
RETURNS [IMPIndex] ~ {
RETURN [IF mobh.limits.it = IMPIndex.FIRST THEN IMPNull ELSE IMPIndex.FIRST];
};
NextImport:
PROC [impi: IMPIndex, mobh: MobHandle]
RETURNS [IMPIndex] ~ {
IF impi = IMPNull THEN RETURN [IMPNull];
impi ¬ impi + IMPRecord.SIZE;
RETURN [IF impi = mobh.limits.it THEN IMPNull ELSE impi];
};
GetLocalGfi:
PROC [n:
CARDINAL]
RETURNS [gfi: ModuleIndex] ~ {
gfi ¬ nextLocalGfi;
nextLocalGfi ¬ nextLocalGfi + n;
[] ¬ MobUtilDefs.GetDummyGfi[n];
};
ProcessLocalImports:
PROC [start: IMPIndex] ~ {
nextLocalGfi ¬ 1;
FOR sti: MobSymbols.STIndex ¬ FirstLocalImport[], NextLocalImport[sti]
UNTIL sti = MobSymbols.stNull
DO
WITH s~~stb[sti]
SELECT
FROM
unknown => DeclareImportByName[sti, start];
external =>
WITH m~~s.map
SELECT
FROM
interface => DeclareImport[sti, m.expi];
unknown => DeclareImportByName[sti, start];
config, module => MobErrorDefs.ErrorSti[$error,
"is both a component and an import of the config", sti];
ENDCASE => Error[];
ENDCASE => Error[];
ENDLOOP;
};
FirstLocalImport:
PROC
RETURNS [MobSymbols.STIndex] ~ {
OPEN localMobH.bases; -- I'd comment this out, but then the compiler doesn't complain (?)
FOR sti: MobSymbols.STIndex ¬ cxb[loadCx].link, stb[sti].link
UNTIL sti = MobSymbols.stNull
DO
IF stb[sti].imported THEN RETURN [sti];
ENDLOOP;
RETURN [MobSymbols.stNull];
};
NextLocalImport:
PROC [sti: MobSymbols.STIndex]
RETURNS [MobSymbols.STIndex] ~ {
OPEN localMobH.bases;
IF sti = MobSymbols.stNull THEN RETURN [MobSymbols.stNull];
UNTIL (sti ¬ stb[sti].link) = MobSymbols.stNull
DO
IF stb[sti].imported THEN RETURN [sti];
ENDLOOP;
RETURN [MobSymbols.stNull];
};
DeclareImportByName:
PROC [sti: MobSymbols.STIndex, start: IMPIndex] ~ {
impi: IMPIndex;
maxNgfi: INT ¬ 1;
firstImpi: IMPIndex ¬ IMPNull;
impLimit: IMPIndex ~ LOOPHOLE[table.Bounds[imptype].size];
name: NameRecord ~
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH p~~s
SELECT
FROM
file => MobUtilDefs.NameForSti[sti],
instance => MobUtilDefs.NameForSti[p.sti],
ENDCASE => ERROR LoadError,
unknown => MobUtilDefs.NameForSti[sti],
ENDCASE => ERROR LoadError;
FOR impi ¬ start, impi+IMPRecord.
SIZE
UNTIL impi = impLimit
DO
IF localMobH.bases.itb[impi].name = name
THEN {
IF firstImpi = IMPNull THEN firstImpi ¬ impi;
maxNgfi ¬ MAX[maxNgfi, 1]};
ENDLOOP;
IF firstImpi = IMPNull
THEN {
MobErrorDefs.ErrorName[$warning, "is not IMPORTed by any modules", name];
stb[sti].imported ¬ FALSE;
RETURN;
};
stb[sti].impi ¬ impi ¬ MobUtilDefs.EnterImport[localMobH, firstImpi, FALSE];
WITH s~~stb[sti]
SELECT
FROM
external =>
IF s.ptype = $instance
THEN {
MobUtilDefs.CreateInstanceName[s.hti, [0,0,import[impi]]];
localMobH.bases.itb[impi].namedInstance ¬ TRUE;
};
ENDCASE;
localMobH.bases.itb[impi].modIndex ¬ GetLocalGfi[maxNgfi];
IF stb[sti].type = $unknown
THEN
stb[sti].body ¬ external[
map~[unknown[]], pointer~file[localMobH.bases.itb[impi].file]];
};
DeclareImport:
PROC [sti: MobSymbols.STIndex, expi: EXPIndex] ~ {
OPEN localMobH.bases, exp~~localMobH.bases.etb[expi];
impi: IMPIndex ~ table.Units[imptype, IMPRecord.SIZE];
ngfi: INT ~ 1;
itb[impi] ¬ [
port~$interface, namedInstance~FALSE, file~exp.file,
name~MobUtilDefs.NameForSti[sti], modIndex~GetLocalGfi[ngfi],
offset: 0 -- is this right? --];
stb[sti].impi ¬ impi;
IF stb[sti].type = $unknown
THEN
stb[sti].body ¬ external[map~[unknown[]], pointer~file[exp.file]];
};
Lookup:
PROC [hti: MobSymbols.HTIndex]
RETURNS [sti: MobSymbols.STIndex] ~ {
last: MobSymbols.STIndex;
IF hti = MobSymbols.HTNull THEN RETURN [MobSymbols.stNull];
FOR sti ¬ cxb[currentCx].link, stb[sti].link
UNTIL sti = MobSymbols.stNull
DO
IF stb[sti].hti = hti THEN EXIT;
last ¬ sti;
REPEAT
FINISHED => {
sti ¬ MobUtilDefs.NewSemanticEntry[hti];
stb[sti].hti ¬ hti; stb[last].link ¬ sti};
ENDLOOP;
};
PortableItem:
TYPE ~
RECORD [
SELECT type: *
FROM
interface => [expi: EXPIndex],
module => [mti: MTIndex],
unknown => [name: MobSymbols.HTIndex],
null => [],
ENDCASE];
PortNull: PortableItem ~ [null[]];
HtiForPortable:
PROC [p: PortableItem, mobh: MobHandle]
RETURNS [MobSymbols.HTIndex] ~ {
RETURN [
WITH p
SELECT
FROM
interface => MobUtilDefs.HtiForName[mobh, mobh.bases.etb[expi].name],
module => MobUtilDefs.HtiForName[mobh, mobh.bases.mtb[mti].name],
ENDCASE => MobSymbols.HTNull];
};
EnumerateExports:
PROC [proc:
PROC [PortableItem], mobh: MobHandle]
RETURNS [PortableItem] ~ {
OPEN localMobH.bases;
FindItem: MobTree.Scan ~ {
sti: MobSymbols.STIndex ~ FindSti[t];
IF stb[sti].exported
THEN
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
interface => proc[[interface[m.expi]]];
module => proc[[module[m.mti]]];
ENDCASE => proc[[unknown[s.hti]]];
ENDCASE => proc[[unknown[s.hti]]];
};
SELECT
TRUE
FROM
(loadExpi # EXPNull) => proc[[interface[loadExpi]]];
(loadMobTree = MobTree.nullIndex) =>
FOR eti: EXPIndex ¬ EXPIndex.
FIRST, eti+
SIZE[EXPRecord[mobh.bases.etb[eti].nLinks]]
UNTIL eti = mobh.limits.et
DO
proc[[interface[eti]]] ENDLOOP;
ENDCASE => {
IF exportsALL
THEN {
FOR sti: MobSymbols.STIndex ¬ cxb[loadCx].link, stb[sti].link
UNTIL sti = MobSymbols.stNull
DO
IF ~stb[sti].filename
THEN
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
interface => {s.exported ¬ TRUE; proc[[interface[m.expi]]]};
ENDCASE;
ENDCASE
ENDLOOP};
MobTreeOps.ScanList[tb[loadMobTree].son[2], FindItem]};
RETURN [PortNull];
};
VerifyExports: ExportAssigner ~ {
VerifyExport:
PROC [p: PortableItem] ~ {
WITH p
SELECT
FROM
unknown =>
MobErrorDefs.ErrorHti[$warning, "is not EXPORTed by any modules", name];
ENDCASE;
};
[] ¬ EnumerateExports[VerifyExport, mobh];
};
NormalExports: ExportAssigner ~ {
NormalExport:
PROC [p: PortableItem] ~ {
CombineExport[Lookup[HtiForPortable[p, mobh]], p, currentOp, mobh];
};
[] ¬ EnumerateExports[NormalExport, mobh];
};
AssignedExports: ExportAssigner ~ {
nExports: CARDINAL ¬ 0;
state: State ¬ [first[lhs]];
OneExport:
PROC [p: PortableItem] = {
t: MobTree.Link;
nExports ¬ nExports+1;
state ¬ UpdateList[state];
WITH state
SELECT
FROM
more => t ¬ current;
done => t ¬ last;
ENDCASE => ERROR;
IF t # MobTree.null
THEN {
WITH t
SELECT
FROM
symbol => CombineExport[index, p, currentOp, mobh];
subtree => {
OPEN tb[index];
IF name # $item THEN Error[];
WITH son[1]
SELECT
FROM
symbol => CombineExport[index, p, currentOp, mobh];
ENDCASE => Error[]};
ENDCASE => Error[];
};
};
[] ¬ EnumerateExports[OneExport, mobh];
SELECT MobTreeOps.ListLength[lhs]
FROM
< nExports =>
MobErrorDefs.Error[$error, "The right hand side exports more interfaces than required by the left hand side"];
> nExports =>
MobErrorDefs.Error[$error, "The left hand side requires more interfaces than exported by the right hand side"];
ENDCASE;
};
UpdateList:
PROC [state: State]
RETURNS [State] = {
WITH state
SELECT
FROM
first => {
IF root = MobTree.null THEN RETURN [[done[MobTree.null]]];
WITH root
SELECT
FROM
subtree => {
IF tb[index].name # $list THEN RETURN [[done[root]]];
IF tb[index].nSons = 1
THEN RETURN [[done[tb[index].son[1]]]]
ELSE RETURN [[more[root, tb[index].son[1], 1]]]};
ENDCASE => RETURN [[done[root]]];
};
more => {
WITH root
SELECT
FROM
subtree => {
IF tb[index].nSons = 0
THEN {
endMark: MobTree.Link = [subtree[index: MobTree.Index.LAST]];
IF tb[index].son[n+2] = endMark
THEN RETURN [[done[tb[index].son[n+1]]]]
ELSE RETURN [[more[root, tb[index].son[n+1], n+1]]];
}
ELSE {
IF n+1 = tb[index].nSons
THEN RETURN [[done[tb[index].son[n+1]]]]
ELSE RETURN [[more[root, tb[index].son[n+1], n+1]]];
};
};
ENDCASE => ERROR;
};
ENDCASE => RETURN [[done[MobTree.null]]];
};
LoadAssign:
PROC [t: MobTree.Link, mobh: MobHandle] ~ {
node: MobTree.Index ~ MobTreeOps.GetNode[t];
saveAssigner: ExportAssigner ~ processExports;
processExports ¬ AssignedExports;
lhs ¬ tb[node].son[1]; LoadRhs[tb[node].son[2], mobh];
processExports ¬ saveAssigner;
};
NewExport:
PROC [expi: EXPIndex, mobh: MobHandle]
RETURNS [newExpi: EXPIndex] ~ {
newExpi ¬ MobUtilDefs.EnterExport[mobh, expi, TRUE];
localMobH.bases.etb[newExpi].file ¬ MapFile[localMobH.bases.etb[newExpi].file, mobh];
};
CombineExport:
PROC [sti: MobSymbols.STIndex, p: PortableItem, op: InterfaceOp, mobh: MobHandle] ~ {
target: FTIndex ~ FileForSti[sti];
WITH p
SELECT
FROM
unknown => {
MobErrorDefs.ErrorHti[$warning, "is not EXPORTed by any modules", name];
RETURN;
};
ENDCASE;
IF target = FTNull
THEN DeclarePortableItem[sti, p, mobh]
ELSE {
source: FTIndex ~ FileForPortableItem[p, mobh];
IF ~MobUtilDefs.EqVersions[source, target]
THEN
MobErrorDefs.Error2Files[
class~$error,
s~"is being exported, but required version is",
ft1~source, ft2~target];
};
WITH p
SELECT
FROM
interface => CombineInterface[sti, expi, op, mobh];
module => CombineModule[sti, mti, op, mobh];
ENDCASE;
};
CombineModule:
PROC [sti: MobSymbols.STIndex, mti: MTIndex, op: InterfaceOp, mobh: MobHandle] ~ {
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
module =>
IF m.mti = MTNull THEN m.mti ¬ mti
ELSE
IF op = $plus
THEN
MobErrorDefs.ErrorModule[$warning, "is a duplicate export", m.mti];
unknown => s.map ¬ [module[MobUtilDefs.EnterModule[mobh, mti, MobSymbols.HTNull]]];
ENDCASE => Error[];
ENDCASE => Error[];
};
CombineInterface:
PROC [sti: MobSymbols.STIndex, eti: EXPIndex, op: InterfaceOp, mobh: MobHandle] ~ {
newEti: EXPIndex;
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
interface => {
IF m.expi = EXPNull THEN m.expi ¬ NewExport[eti, mobh];
newEti ¬ m.expi};
unknown => {
newEti ¬ NewExport[eti, mobh];
s.map ¬ [interface[newEti]]};
ENDCASE => NotOperand[sti, mobh];
ENDCASE => Error[];
BEGIN
OPEN old~~mobh.bases.etb[eti], new~~localMobH.bases.etb[newEti];
FOR i:
CARDINAL
IN [0..old.nLinks)
DO
IF old.links[i].from # nullLink
THEN
SELECT
TRUE
FROM
(old.links[i].from.tag = $type) => {
cl: MobDefs.Link ~ [
tag: type,
offset~TYPIndexToOffset[MobUtilDefs.EnterType[mobh,
OffsetToTYPIndex[old.links[i].from.offset]]]];
IF new.links[i].from # nullLink
AND new.links[i].from # cl
THEN
MobErrorDefs.ErrorItem[$error,
"is an incompatible type definition",
[name~localMobH.bases.etb[newEti].name, fti~localMobH.bases.etb[newEti].file], i];
new.links[i].from ¬ cl};
(new.links[i].from = nullLink) =>
new.links[i].from ¬ RelocateExportLink[old.links[i].from];
(op = $plus) =>
MobErrorDefs.ErrorItem[$warning, "is a duplicate export",
[name~localMobH.bases.etb[newEti].name, fti~localMobH.bases.etb[newEti].file], i];
ENDCASE;
ENDLOOP;
END;
};
TYPIndexToOffset:
PROC [typIndex: TYPIndex]
RETURNS [LinkOffset] = {
RETURN [LOOPHOLE[typIndex, CARD]/SIZE[TYPRecord]];
};
OffsetToTYPIndex:
PROC [offset: LinkOffset]
RETURNS [TYPIndex] = {
RETURN [LOOPHOLE[offset*SIZE[TYPRecord]]];
};
RelocateExportLink:
PROC [cl: MobDefs.Link]
RETURNS [MobDefs.Link] ~ {
IF loadExpi = EXPNull
AND loadCx = MobSymbols.cxNull
THEN
SELECT cl.tag
FROM
$var => cl.modIndex ¬ cl.modIndex + rel.firstgfi-1;
$proc => cl.modIndex ¬ cl.modIndex + rel.firstgfi-1;
$type => ERROR;
ENDCASE;
RETURN [cl];
};
LoadRhs:
PROC [exp: MobTree.Link, mobh: MobHandle] ~ {
WITH exp
SELECT
FROM
subtree =>
SELECT tb[index].name
FROM
$module => {currentParms ¬ tb[index].son[2]; LoadItem[tb[index].son[1], mobh]};
ENDCASE => LoadOperand[exp, mobh];
ENDCASE => LoadOperand[exp, mobh];
};
LoadOperand:
PROC [exp: MobTree.Link, mobh: MobHandle] ~ {
WITH exp
SELECT
FROM
symbol => LoadOperandSti[index, mobh];
subtree =>
SELECT tb[index].name
FROM
$item =>
WITH s1~~tb[index].son[1]
SELECT
FROM
symbol => LoadOperandSti[s1.index, mobh];
ENDCASE => Error[];
$module => {
MobErrorDefs.ErrorSti[$error,
"must name an interface (no ""[]"")",
FindSti[tb[index].son[1]]];
currentParms ¬ tb[index].son[2]; LoadItem[tb[index].son[1], mobh]};
$plus, $then => {
LoadOperand[tb[index].son[1], mobh];
currentOp ¬ tb[index].name;
LoadOperand[tb[index].son[2], mobh];
currentOp ¬ $plus};
ENDCASE => Error[];
ENDCASE => Error[];
};
NotOperand:
PROC [sti: MobSymbols.STIndex, mobh: MobHandle] ~ {
MobErrorDefs.ErrorSti[$error, "must name an interface", sti];
LoadSti[sti, MobSymbols.HTNull, mobh];
};
LoadOperandSti:
PROC [sti: MobSymbols.STIndex, mobh: MobHandle] ~ {
WITH s~~stb[sti]
SELECT
FROM
external =>
WITH m~~s.map
SELECT
FROM
interface => {
IF m.expi = EXPNull THEN Error[];
loadExpi ¬ m.expi;
processExports[mobh];
loadExpi ¬ EXPNull;
};
unknown => MobErrorDefs.ErrorSti[$error, "cannot be an operand", sti];
ENDCASE => NotOperand[sti, mobh];
unknown =>
IF s.imported
THEN MobErrorDefs.ErrorSti[$error, "is imported and cannot be an operand", sti]
ELSE NotOperand[sti, mobh];
ENDCASE => NotOperand[sti, mobh];
};
}.