-- MDLoadImpl.Mesa
-- last edit by Schmidt, January 4, 1983 3:11 pm
-- last edit by Satterthwaite, February 17, 1983 4:03 pm
-- Mesa 7.0/ Pilot 6.0
-- procedures to load and start modules in a Model
-- can't use PilotLoaderOps since it is not exported by CoPilotDorado.Config
-- may use PilotLoadStateOps, however
-- links:
-- IF gfi > firstdummy, then gfi is index into Import table
-- and ep is index into the export record pared with that import
-- binding is simply to copy control link in the export record
-- into this link
-- IF gfi < firstdummy, then gfi in this link is an index into the config's
-- moduletable. Do not alter the ep
-- spaces:
-- assume there are n modules
-- there will be
-- 1 space in MDS for all the frames (and frame links)
-- 1 space in VM for the Fake Config Bcd for the load state
-- n ReadOnly spaces for Code
-- n (up to n) subspaces for the code links
-- n subspaces for the code segments
-- (unless the bcd is Binder-output)
-- n spaces for the Bcd headers
-- (deleted on UnLoad)
DIRECTORY
BcdDefs: TYPE USING [Base, BCD, EPLimit, EXPIndex, EXPRecord,
FTIndex, FTRecord, GFTIndex, IMPIndex, IMPRecord,
Link, MTIndex, MTRecord, NameRecord],
BcdOps: TYPE USING [BcdBase, EXPHandle, FTHandle, IMPHandle, MTHandle, NameString,
ProcessExports, ProcessImports, ProcessModules],
CWF: TYPE USING [FWF1, FWF2, FWF3, WF0, WF1, WF2, WF3, WF4],
Dir: TYPE USING [FileInfo],
Environment: TYPE USING [wordsPerPage],
File: TYPE USING [Capability],
Heap: TYPE USING [FreeMDSNode, MakeMDSNode],
IO: TYPE USING[Handle],
LowLoader: TYPE USING [AddToLoadState, AllocateInterfaceSeq, BuildFramePtrInterface,
BuildInterface, CloseLinkSpace, ConvertLink, CopyNStoLS, DummyMapSeq, EqualStringAndName,
FindVariableLink, FreeInterfaceSeq, FreeLoadInfoSeq, GetIntFromLoadState, ImpExpSeq,
IncorporateLoadStateChanges, InterfaceSeq, IthLink, LinkSegmentLength,
LoadBcdAndCount, LoadFrame, LoadIncremental,
LoadInfoSeq, OpenLinkSpace, ReadLink, ReplaceResult, WriteLink, Zero],
LongString: TYPE USING[EquivalentString],
MDComp: TYPE USING [HandlePlus, SetVersAndModulename],
MDLoad: TYPE USING [BuildFakeBcd],
MDMain: TYPE USING [DebugWP, modellerIsIdle, PrintSeparatorLine],
MDModel: TYPE USING [AddToEndOfList, APPLSymbol, GetFileInfo, LISTSymbol, LocForAppl,
LocForType, LOCSymbol, LookForInstBcd, MODELSymbol, NarrowToAPPL, NarrowToLIST,
NarrowToLOC, NarrowToPROC, NarrowToTYPE, numberofbcdsmapped, numberofsourcesparsed,
PROCSymbol, Symbol, SymbolSeq, TraverseList, TraverseTree, TYPESymbol],
PilotLoadStateOps: TYPE USING [ConfigIndex, GetMap, InputLoadState, Map, NullConfig,
ReleaseLoadState, ReleaseMap, RemoveConfig],
PrincOps: TYPE USING [ControlLink, GFTIndex, GFTNull, GlobalFrameHandle, NullLink,
UnboundLink],
Process: TYPE USING [Detach],
RTOS: TYPE USING[GetCurrent, RegisterCedarProcess],
RTLoader USING [AcquireTypesAndLiterals],
Runtime: TYPE USING [IsBound, ValidateGlobalFrame],
RuntimeInternal: TYPE USING [Codebase],
Space: TYPE USING [Create, Delete, GetHandle, Handle, Map, mds,
nullHandle, PageFromLongPointer, Pointer, virtualMemory, wordsPerPage],
Subr: TYPE USING [FindMappedSpace, TTYProcs],
System: TYPE USING [GetClockPulses, PulsesToMicroseconds],
Time: TYPE USING [Current],
TimeStamp: TYPE USING [Null];
MDLoadImpl: PROGRAM
IMPORTS BcdOps, CWF, Heap, LowLoader, LongString, MDComp,
MDLoad, MDMain, MDModel, PilotLoadStateOps, Process,
RTLoader, RTOS, Runtime, RuntimeInternal, Space, Subr, System, Time
EXPORTS MDLoad = {
-- no MDS usage!
LoadBcdsAndResolveImports: PUBLIC PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq, tryreplacement: BOOL,
tty: Subr.TTYProcs, window: IO.Handle] = {
ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
p: LONG CARDINAL;
time: LONG CARDINAL ← Time.Current[];
MDModel.numberofbcdsmapped ← MDModel.numberofsourcesparsed ← 0;
-- unload any bcds that may be around from the last invocation
-- regardless of "replacement", old config in load state is unloaded
-- IF NOT tryreplacement THEN UnLoad[spmodel, symbolseq, FALSE]
-- ELSE -- IF spmodel.configindex ~= PilotLoadStateOps.NullConfig THEN
DeleteLoadStateEntry[spmodel.configindex];
spmodel.configindex ← PilotLoadStateOps.NullConfig;
-- fix up PLUS and THEN
MDComp.HandlePlus[symbolseq];
-- this will build all interface records
LoadBcds[spmodel, symbolseq, window];
-- now fill in parameters
p ← System.PulsesToMicroseconds[System.GetClockPulses[]];
CWF.WF0["Phase 3: Fill in interface records... \n"L];
FillInFromLoadState[spmodel, symbolseq, tty];
-- fill in any PLUS nodes (may plus together load state parameters)
FillInPLUSandTHEN[spmodel, symbolseq, tryreplacement];
-- IF Subr.debugflg THEN PrintInterfaceSeqs[spmodel, symbolseq];
-- this will build a bcd with everything we need
spmodel.configindex ← PilotLoadStateOps.InputLoadState[];
MDLoad.BuildFakeBcd[spmodel, symbolseq];
p ← (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
CWF.WF1["done (%lu millisec).\nPhase 4: Fill in imports (links) ... \n"L, @p];
p ← System.PulsesToMicroseconds[System.GetClockPulses[]];
-- now fill in all the frame links
ResolveImports[spmodel, symbolseq];
-- IF Subr.debugflg THEN PrintFrames[spmodel, symbolseq];
-- now put all the exported interface records into the modeller load state
PutExportsInModellerLoadState[spmodel, symbolseq];
-- now call Cedar related procedures to finish the loading
ProcessCedarBcds[spmodel, symbolseq, tryreplacement];
time ← Time.Current[] - time;
p ← (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
CWF.WF2["done (%lu millisec).\nTotal time to load: %lu seconds.\n"L, @p, @time];
CWF.FWF2[MDMain.DebugWP, "# bcds mapped in %u, # sources parsed %u.\n"L, @MDModel.numberofbcdsmapped,
@MDModel.numberofsourcesparsed];
};
MAXCONTROL: CARDINAL = 30;
StartArray: TYPE = ARRAY[0 .. MAXCONTROL) OF RECORD[
prog: PROGRAM,
frame: PrincOps.GlobalFrameHandle
];
StartAllControlBcds: PUBLIC PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq] = {
starr: StartArray;
nst: CARDINAL ← 0;
p: PROCESS;
-- calls itself recursively
OnAList: PROC[sp: MDModel.Symbol] = {
WITH spt: sp SELECT FROM
typeAPPL => IF spt.appltype = symbolseq.controlv THEN
TryToStart[MDModel.LocForAppl[MDModel.NarrowToAPPL[sp]]];
typeLET => MDModel.TraverseList[spt.letgrp, OnAList];
typePROC => MDModel.TraverseList[MDModel.NarrowToLIST[spt.procval],
OnAList];
typeMODEL => MDModel.TraverseList[spt.model, OnAList];
ENDCASE => NULL;
};
TryToStart: PROC[sploc1: MDModel.Symbol] = {
prog: PROGRAM;
sploc: MDModel.LOCSymbol;
IF sploc1 = NIL OR sploc1.stype ~= typeLOC THEN RETURN;
sploc ← MDModel.NarrowToLOC[sploc1];
IF sploc.fi = NIL OR sploc.fi.loadInfoSeq = NIL THEN RETURN;
FOR i: CARDINAL IN [0 .. sploc.fi.loadInfoSeq.size) DO
Runtime.ValidateGlobalFrame[sploc.fi.loadInfoSeq[i].frame];
IF sploc.fi.loadInfoSeq[i].frame.started THEN {
CWF.WF1["Error - %s.Bcd has already been started.\n"L,
sploc.tail];
RETURN;
};
ENDLOOP;
CWF.WF1["Will start %s.Bcd\n"L, sploc.tail];
prog ← LOOPHOLE[sploc.fi.loadInfoSeq.cm];
IF nst >= LENGTH[starr] THEN
CWF.WF0["Too many control modules.\n"L]
ELSE {
starr[nst] ← [prog: prog, frame: sploc.fi.loadInfoSeq[0].frame];
nst ← nst + 1;
};
};
MDModel.TraverseList[spmodel.model, OnAList];
CWF.WF0["Starting modules ... \n"L];
MDMain.modellerIsIdle ← TRUE;
MDMain.PrintSeparatorLine[];
p ← FORK StartProcedure[starr, nst];
Process.Detach[p];
};
UnLoad: PUBLIC PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq, unloadthebcd: BOOL] = {
nunl: CARDINAL ← 0;
frameptr: PrincOps.GlobalFrameHandle ← NIL;
ProcAnalyze: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
WITH spt: sp SELECT FROM
typeAPPL => {
IF spt.interfaceseq ~= NIL THEN
LowLoader.FreeInterfaceSeq[spt.interfaceseq];
spt.interfaceseq ← NIL;
};
typeLOC => {
IF spt.fi ~= NIL AND spt.fi.loadInfoSeq ~= NIL THEN {
nunl ← nunl + 1;
IF unloadthebcd THEN {
-- remember that a binder bcd loaded by
-- the modeller will have only ONE mapped
-- space for all its code
FOR i: CARDINAL IN [0 .. spt.fi.loadInfoSeq.size) DO
prog: PROGRAM ← LOOPHOLE[spt.fi.loadInfoSeq[i].frame];
space: Space.Handle;
IF frameptr = NIL THEN
frameptr ← spt.fi.loadInfoSeq[i].frame;
IF RuntimeInternal.Codebase[prog] ~= NIL THEN {
space ← Space.GetHandle[
Space.PageFromLongPointer[
RuntimeInternal.Codebase[prog]]];
IF space ~= Space.nullHandle
AND space ~= Space.virtualMemory THEN
Space.Delete[Subr.FindMappedSpace[space]];
};
ENDLOOP;
};
LowLoader.FreeLoadInfoSeq[spt.fi.loadInfoSeq];
spt.fi.loadInfoSeq ← NIL;
};
};
ENDCASE => NULL;
};
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];
IF unloadthebcd THEN {
IF spmodel.configindex ~= PilotLoadStateOps.NullConfig THEN {
DeleteLoadStateEntry[spmodel.configindex];
spmodel.configindex ← PilotLoadStateOps.NullConfig;
};
IF frameptr ~= NIL THEN {
space: Space.Handle;
space ← Space.GetHandle[Space.PageFromLongPointer[frameptr]];
IF space ~= Space.nullHandle
AND space ~= Space.virtualMemory
AND space ~= Space.mds THEN
Space.Delete[Subr.FindMappedSpace[space]];
};
IF spmodel.fakebcdspace ~= Space.nullHandle THEN {
Space.Delete[spmodel.fakebcdspace];
spmodel.fakebcdspace ← Space.nullHandle;
};
IF nunl > 0 THEN {
CWF.WF2["%u Module%s unloaded.\n"L, @nunl,
IF nunl > 1 THEN "s"L ELSE ""L];
CWF.WF0["All code spaces and frames have been freed. DO NOT TRY TO USE THEM!*N"L];
};
};
};
-- internal procedures
DeleteLoadStateEntry: PROC[index: PilotLoadStateOps.ConfigIndex] = {
ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
map: PilotLoadStateOps.Map;
[] ← PilotLoadStateOps.InputLoadState[];
map ← PilotLoadStateOps.GetMap[index];
PilotLoadStateOps.RemoveConfig[map, index];
PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
};
-- the parameter array is passed by value!
StartProcedure: PROC[starr: StartArray, nst: CARDINAL] = {
{
ENABLE ABORTED => GOTO out;
i: CARDINAL;
IF FALSE AND Runtime.IsBound[RTOS.RegisterCedarProcess] THEN
RTOS.RegisterCedarProcess[RTOS.GetCurrent[]];
FOR i IN [0 .. nst) DO
IF starr[i].frame.started THEN
CWF.WF1["Error - %u element of start list has already been started.\n"L, @i]
ELSE START starr[i].prog;
ENDLOOP;
EXITS
out => NULL;
};
CWF.WF1["All %u modules have been started.\n"L, @nst];
};
LoadBcds: PROC[spmodel: MDModel.MODELSymbol, symbolseq: MDModel.SymbolSeq,
window: IO.Handle] = {
nwordstotal: CARDINAL ← 0;
frameptr: POINTER ← NIL;
beginning, ending: LONG CARDINAL ← 0;
bcdpages, codepages: CARDINAL ← 0;
p: LONG CARDINAL;
configGfi: PrincOps.GFTIndex ← 1;
ProcAnalyzeSum: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
fi: Dir.FileInfo;
np, ncp: CARDINAL;
sploc: MDModel.LOCSymbol;
shouldLoad: BOOL;
IF sptop.stype ~= typeAPPL AND sptop.stype ~= typeLET THEN RETURN[TRUE];
[shouldLoad, , sploc] ← SplitUpLoc[sptop];
IF NOT shouldLoad THEN RETURN[TRUE];
fi ← MDModel.GetFileInfo[sploc];
IF NOT fi.bcdPresent THEN RETURN[TRUE]; -- can't load it
IF fi.bcdFileName.length < 4 THEN ERROR;
np ← ncp ← 0;
IF NOT fi.bcdPresent THEN
CWF.WF1["Error - can't load %s since its not on the disk.\n"L,
fi.bcdFileName]
ELSE {
IF fi.loadInfoSeq = NIL THEN {
[fi.loadInfoSeq, nwordstotal, np, ncp] ←
LowLoader.LoadBcdAndCount[fi.bcdCap, fi.bcdFileName,
nwordstotal];
MDModel.numberofbcdsmapped ← MDModel.numberofbcdsmapped + 1;
}
ELSE IF fi.loadInfoSeq.mustreplace THEN {
replaceResult: LowLoader.ReplaceResult;
replaceResult ← LowLoader.LoadIncremental[fi.bcdCap, fi.loadInfoSeq, window];
SELECT replaceResult FROM
ok => fi.loadInfoSeq.mustreplace ← FALSE;
configNotReplaceable => CWF.WF1["Load of %s failed, is a config.\n"L, fi.bcdFileName];
frameTooBig => CWF.WF1["Load of %s failed, frame too big.\n"L, fi.bcdFileName];
ngfiTooBig => CWF.WF1["Load of %s failed, # gfis too big.\n"L, fi.bcdFileName];
checkForMRFailed => CWF.WF1["Load of %s failed, outstanding local frames(?).\n"L, fi.bcdFileName];
ENDCASE => ERROR;
MDModel.numberofbcdsmapped ← MDModel.numberofbcdsmapped + 1;
}
ELSE CWF.FWF1[MDMain.DebugWP, "%s does not need to be reloaded.\n"L,
fi.bcdFileName];
};
-- CWF.WF2["%s: %u code pages.\n"L, sploc.tail, @ncp];
bcdpages ← bcdpages + np;
codepages ← codepages + ncp;
RETURN[TRUE];
};
ProcAnalyzeLoad: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
fi: Dir.FileInfo;
sploc: MDModel.LOCSymbol;
splist: MDModel.LISTSymbol;
shouldLoad: BOOL;
IF sptop.stype ~= typeAPPL AND sptop.stype ~= typeLET THEN RETURN[TRUE];
[shouldLoad, splist, sploc] ← SplitUpLoc[sptop];
IF NOT shouldLoad THEN RETURN[TRUE];
fi ← MDModel.GetFileInfo[sploc];
IF fi.loadInfoSeq ~= NIL AND fi.loadInfoSeq.size = 0 THEN {
[frameptr, configGfi] ← LowLoader.LoadFrame[fi.loadInfoSeq,
frameptr, window, fi.bcdCap, beginning, ending, configGfi];
SetUpExports[splist, sploc];
};
RETURN[TRUE];
};
-- determines whether a bcd should be loaded based on whether it exports an interface record or not
SplitUpLoc: PROC[sptop: MDModel.Symbol]
RETURNS[shouldLoad: BOOL, splist: MDModel.LISTSymbol, sploc: MDModel.LOCSymbol] = {
shouldLoad ← FALSE;
splist ← NIL;
sploc ← NIL;
WITH spt: sptop SELECT FROM
typeAPPL => {
IF spt.applval = NIL THEN RETURN; -- must be parameter
IF spt.applval.stype = typeLIST THEN RETURN; -- must be PLUS
sploc ← MDModel.NarrowToLOC[spt.applval];
splist ← MDModel.AddToEndOfList[NIL, sptop, normal, symbolseq];
shouldLoad ← TRUE;
};
typeLET => {
sploc ← MDModel.NarrowToLOC[spt.letval];
splist ← spt.letgrp;
WHILE splist ~= NIL DO
-- should load only if LET has at least one interface record in it
IF splist.first.stype = typeAPPL THEN {
shouldLoad ← TRUE;
EXIT;
};
splist ← splist.rest;
ENDLOOP;
splist ← spt.letgrp;
};
ENDCASE => NULL;
};
p ← System.PulsesToMicroseconds[System.GetClockPulses[]];
CWF.WF0["Phase 1: Load in bcd headers... \n"L];
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyzeSum, TRUE];
CWF.WF0["done.\n"L];
IF nwordstotal > 0 THEN {
space: Space.Handle;
npages: CARDINAL ← (nwordstotal + Space.wordsPerPage - 1)
/ Space.wordsPerPage;
CWF.WF1["%u pages for bcd headers, "L, @bcdpages];
space ← Space.Create[size: npages, parent: Space.mds];
Space.Map[space];
frameptr ← Space.Pointer[space];
LowLoader.Zero[frameptr, npages * Environment.wordsPerPage];
beginning ← LOOPHOLE[LONG[frameptr]];
ending ← beginning + nwordstotal;
CWF.WF2["total MDS for frames: %u words, %u pages.\n"L, @nwordstotal,
@npages];
};
p ← (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
CWF.WF2["Total pages for code: %u pages (%lu millisec).\n"L, @codepages, @p];
p ← System.PulsesToMicroseconds[System.GetClockPulses[]];
CWF.WF0["Phase 2: Allocate frames and map in code... \n"L];
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyzeLoad, TRUE];
p ← (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
CWF.WF1["done (%lu millisec).\n"L, @p];
};
PutExportsInModellerLoadState: PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq] = {
spproc: MDModel.PROCSymbol;
splist: MDModel.LISTSymbol;
splist ← spmodel.model;
WHILE splist ~= NIL DO
IF splist.first.stype = typePROC THEN {
spproc ← MDModel.NarrowToPROC[splist.first];
EXIT;
};
splist ← splist.rest;
ENDLOOP;
IF spproc = NIL THEN RETURN;
splist ← spproc.procret;
WHILE splist ~= NIL DO
IF splist.first.stype = typeAPPL THEN {
spappl: MDModel.APPLSymbol;
spappl ← MDModel.NarrowToAPPL[splist.first];
IF spappl.interfaceseq ~= NIL THEN
LowLoader.AddToLoadState[spappl.interfaceseq];
};
splist ← splist.rest;
ENDLOOP;
};
-- fill in links
ResolveImports: PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq] = {
ProcAnalyze: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
-- calls itself recursively
-- spmodel, sptop is passed in
ProcLoc: PROC[spl: MDModel.Symbol] = {
IF spl = NIL THEN RETURN;
IF spl.stype = typeLIST THEN
MDModel.TraverseList[MDModel.NarrowToLIST[spl], ProcLoc]
ELSE IF spl.stype = typeLOC THEN {
fi: Dir.FileInfo;
sploc: MDModel.LOCSymbol;
sploc ← MDModel.NarrowToLOC[spl];
fi ← MDModel.GetFileInfo[sploc];
IF fi.loadInfoSeq ~= NIL THEN {
-- only for things loaded
FillInImports[sploc, spmodel, symbolseq];
};
};
};
WITH spt: sptop SELECT FROM
typeAPPL => ProcLoc[spt.applval];
typeLET => ProcLoc[spt.letval];
ENDCASE => NULL;
RETURN[TRUE];
};
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];
};
FillInFromLoadState: PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq, window: Subr.TTYProcs] = {
askCompiler: BOOL ← LongString.EquivalentString[spmodel.modelfilename, "model.model"L];
ProcAnal: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
fi: Dir.FileInfo;
sploc: MDModel.LOCSymbol;
spappl: MDModel.APPLSymbol;
sptype: MDModel.TYPESymbol;
IF sp.stype ~= typeAPPL THEN RETURN;
spappl ← MDModel.NarrowToAPPL[sp];
-- LocForAppl won't work since the value may be a list
IF spappl.applval ~= NIL OR spappl.letparent ~= NIL THEN RETURN;
-- must be a parameter as it has no value
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
sploc ← MDModel.LocForType[sptype];
IF sploc = NIL THEN {
CWF.WF3["Error - %s in parameter (%s: %s) is undefined.\n"L,
sptype.typesym, spappl.applsym, sptype.typesym];
RETURN;
};
-- this handles the case where the file has not been
-- analyzed at all or the bcdvers has been set to the create time
fi← MDModel.GetFileInfo[sploc];
IF fi.bcdVers.net = 0 THEN
-- may not have been set before
MDComp.SetVersAndModulename[sploc];
spappl.interfaceseq ← LowLoader.GetIntFromLoadState[sptype.typeName, fi.bcdVers];
IF spappl.interfaceseq = NIL THEN
NULL -- commented out, since unbound link error messages will be printed later
-- CWF.WF1["Warning - can't import %s from load state.\n"L, sptype.typeName]
ELSE fi.bcdVers ← spappl.interfaceseq.versstamp; -- just in case it was Null
};
LowLoader.IncorporateLoadStateChanges[window, askCompiler]; -- looks for new additions
MDModel.TraverseTree[spmodel, symbolseq, ProcAnal];
};
EmptyLink: PROC[link: PrincOps.ControlLink] RETURNS[empty: BOOL] = {
RETURN[link = PrincOps.UnboundLink OR link = PrincOps.NullLink];
};
FillInPLUSandTHEN: PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq, tryreplacement: BOOL] = {
ProcAnal: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
from, target: LowLoader.InterfaceSeq;
mode: {plus, then};
spappl, targetappl: MDModel.APPLSymbol;
splist: MDModel.LISTSymbol;
IF sp.stype ~= typeAPPL THEN RETURN;
targetappl ← MDModel.NarrowToAPPL[sp];
IF targetappl.applval = NIL
OR targetappl.applval.stype ~= typeLIST THEN RETURN;
target ← targetappl.interfaceseq;
splist ← MDModel.NarrowToLIST[targetappl.applval];
mode ← IF splist.listtype = plus THEN plus ELSE then;
IF -- tryreplacement AND -- target ~= NIL THEN {
-- force recomputation in repl mode
LowLoader.FreeInterfaceSeq[target];
targetappl.interfaceseq ← target ← NIL;
};
WHILE splist ~= NIL DO
spappl ← MDModel.NarrowToAPPL[splist.first];
from ← spappl.interfaceseq;
IF from = NIL THEN {
IF spappl.applval = NIL THEN
CWF.WF2["Error - unable to %s together export %s, it has no exporter.\n"L,
IF mode = plus THEN "PLUS"L ELSE "THEN"L, spappl.applsym]
ELSE {
sploc: MDModel.LOCSymbol ← MDModel.NarrowToLOC[spappl.applval];
fi: Dir.FileInfo ← sploc.fi;
CWF.WF3["Error - unable to %s together export %s from %s\n"L,
IF mode = plus THEN "PLUS"L ELSE "THEN"L,
spappl.applsym, fi.bcdFileName];
};
splist ← splist.rest;
LOOP;
};
IF target = NIL THEN {
-- must fill in from scratch
targetappl.interfaceseq ← target ←
LowLoader.AllocateInterfaceSeq[from.intname,
from.size];
target.versstamp ← from.versstamp;
target.size ← from.size;
FOR i: CARDINAL IN [0 .. from.size) DO
target[i] ← from[i];
ENDLOOP;
}
ELSE {
-- fill in already existing
IF from.size ~= target.size THEN ERROR;
IF mode = then THEN {
FOR i: CARDINAL IN [0 .. from.size) DO
IF (target[i].clink = PrincOps.NullLink
AND from[i].clink ~= PrincOps.UnboundLink)
OR (target[i].clink = PrincOps.UnboundLink
AND from[i].clink ~= PrincOps.NullLink) THEN
target[i] ← from[i];
ENDLOOP;
}
ELSE { -- PLUS
i: CARDINAL;
sptype: MDModel.TYPESymbol;
FOR i IN [0 .. from.size) DO
IF NOT EmptyLink[target[i].clink]
AND NOT EmptyLink[from[i].clink] THEN {
sptype ← MDModel.NarrowToTYPE[
spappl.appltype];
CWF.WF2["Error -- more than one exporter of item #%u in interface %s.\n"L,
@i, sptype.typeName];
}
ELSE IF EmptyLink[target[i].clink] THEN
target[i] ← from[i];
ENDLOOP;
};
};
splist ← splist.rest;
ENDLOOP;
};
MDModel.TraverseTree[spmodel, symbolseq, ProcAnal];
};
-- fill in exported interface records from the bcd
SetUpExports: PROC[splist: MDModel.LISTSymbol, sploc: MDModel.LOCSymbol] = {
sptype: MDModel.TYPESymbol;
spappl: MDModel.APPLSymbol;
fi: Dir.FileInfo ← MDModel.GetFileInfo[sploc];
WHILE splist ~= NIL DO
IF splist.first.stype ~= typeAPPL THEN {
splist ← splist.rest;
LOOP;
};
spappl ← MDModel.NarrowToAPPL[splist.first];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
IF MDModel.LocForType[sptype] = NIL THEN {
splist ← splist.rest;
LOOP;
};
IF MDModel.LocForAppl[spappl] = MDModel.LocForType[sptype] THEN
-- when type and value are the same then this is a module frampe ptr
spappl.interfaceseq ← LowLoader.BuildFramePtrInterface[
fi.loadInfoSeq.bcdbase, fi.loadInfoSeq[0].frame]
ELSE {
eth: BcdOps.EXPHandle;
eth ← LookForExport[fi.loadInfoSeq.bcdbase, spappl, sptype];
IF eth ~= NIL THEN
spappl.interfaceseq ← LowLoader.BuildInterface[fi.loadInfoSeq,
eth];
};
splist ← splist.rest;
ENDLOOP;
};
-- if there is no time stamp (bcd not present) then sticks in the one that is exported
LookForExport: PROC[bcdbase: BcdOps.BcdBase, spappl: MDModel.APPLSymbol,
sptype: MDModel.TYPESymbol] RETURNS[eth: BcdOps.EXPHandle] = {
namestring: BcdOps.NameString;
sploc: MDModel.LOCSymbol;
fi: Dir.FileInfo;
fillIn: BOOL ← FALSE;
ForEachExports: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex]
RETURNS[stop: BOOL] = {
fth: BcdOps.FTHandle;
fth ← @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][eth.file];
-- only examine time since sploc.bcdVers may be from a bcd that's not on the local disk
-- fth.version may be Null, e.g. SequinImpl.Bcd
IF (fillIn OR fth.version.time = fi.bcdVers.time OR fth.version = TimeStamp.Null)
AND LowLoader.EqualStringAndName[sptype.typeName, namestring, eth.name]
THEN {
-- stick in version being exported
fi.bcdVers ← fth.version;
RETURN[TRUE];
};
RETURN[FALSE];
};
sploc ← MDModel.LocForType[sptype];
fi ← MDModel.GetFileInfo[sploc];
IF fi.bcdVers = TimeStamp.Null THEN
-- may not have been set before
MDComp.SetVersAndModulename[sploc];
fillIn ← NOT fi.bcdPresent AND fi.bcdVers = TimeStamp.Null;
namestring ← LOOPHOLE[bcdbase + bcdbase.ssOffset];
eth ← BcdOps.ProcessExports[bcdbase, ForEachExports].eth;
IF eth = NIL THEN {
exporter: STRING ← [100];
LowLoader.CopyNStoLS[exporter, bcdbase, bcdbase.source];
CWF.WF3["Warning - can't match %s of %v with any export of %s.\n"L,
fi.bcdFileName, @fi.bcdVers, exporter];
};
};
-- called for loaded bcd to fill in all its links!
FillInImports: PROC[sploc: MDModel.LOCSymbol, spmodel: MDModel.MODELSymbol, symbolseq: MDModel.SymbolSeq] = {
bcdbase: BcdOps.BcdBase;
dummymapseq: LowLoader.DummyMapSeq;
impexpseq: LowLoader.ImpExpSeq;
mod, imp: CARDINAL ← 0;
fi: Dir.FileInfo ← sploc.fi;
bcdFileName: STRING ← [100];
namestring: BcdOps.NameString;
splist: MDModel.LISTSymbol;
-- assumes parmlist is in same order as the bcd import table, which is assumed
-- to be in the order as the source file
-- for each import we setup correspondence with parameter list
-- if not on parameter list, we add it
ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex]
RETURNS[stop: BOOL] = {
spappl: MDModel.APPLSymbol ← NIL;
fth: BcdOps.FTHandle;
stop ← FALSE;
FOR i: CARDINAL IN [0 .. ith.ngfi) DO
dummymapseq[ith.gfi + i] ← [ind: imp, whichone: i];
ENDLOOP;
-- handle funny cases where two instances are imported
-- of the same interface
IF ith.gfi = dummymapseq.size THEN
dummymapseq.size ← dummymapseq.size + ith.ngfi;
fth ← @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][ith.file];
WHILE splist ~= NIL AND splist.first.stype ~= typeAPPL DO
splist ← splist.rest;
ENDLOOP;
{
impexpseq[imp] ← NIL;
IF splist ~= NIL THEN {
-- found import on list
sptype: MDModel.TYPESymbol;
splocinner: MDModel.LOCSymbol;
spappl ← MDModel.NarrowToAPPL[splist.first];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
splocinner ← MDModel.LocForType[sptype];
IF splocinner = NIL THEN
CWF.WF3["Error - in the parameter list of @%s, %s, the type of parameter %s, is undefined.\n"L,
fi.bcdFileName, sptype.typesym, spappl.applsym]
ELSE {
fiInner: Dir.FileInfo ← MDModel.GetFileInfo[splocinner];
IF fiInner.bcdVers = TimeStamp.Null THEN
MDComp.SetVersAndModulename[splocinner];
IF fiInner.bcdVers = TimeStamp.Null THEN {
IF LowLoader.EqualStringAndName[sptype.typeName,
namestring, ith.name] THEN {
fiInner.bcdVers ← fth.version;
impexpseq[imp] ← spappl.interfaceseq;
};
}
-- only check time since fi.bcdVers may be from a bcd not on the
-- local disk
ELSE IF fth.version.time = fiInner.bcdVers.time THEN
impexpseq[imp] ← spappl.interfaceseq;
};
splist ← splist.rest;
GOTO out;
};
-- not found, must be hidden import, will connect it up but not add it to model
LowLoader.CopyNStoLS[bcdFileName, bcdbase, fth.name];
CWF.FWF3[MDMain.DebugWP, "FillIn hidden imports of %s of %v by %s.\n"L, bcdFileName,
@fth.version, fi.bcdFileName];
[spappl] ← MDModel.LookForInstBcd[bcdFileName, fth.version,
symbolseq, spmodel, NIL];
-- if spappl is NIL then it wasn't defined in the model
impexpseq[imp] ← IF spappl = NIL THEN NIL ELSE spappl.interfaceseq;
IF spappl = NIL THEN
CWF.WF3["Error - cannot find a variable for %s to import %s of %v.\n"L,
fi.bcdFileName, bcdFileName, @fth.version];
EXITS
out => NULL;
};
-- impexpseq[imp] may be NIL
IF FALSE -- impexpseq[imp] = NIL -- THEN {
-- this message is uneccesary; it will be given when links cannot
-- be resolved
sym: STRING ← [100];
LowLoader.CopyNStoLS[sym, bcdbase, ith.name];
CWF.WF4["Warning - can't satisfy %s of %v (the %uth import) of %s.\n"L,
sym, @fth.version, @imp, fi.bcdFileName];
};
imp ← imp + 1;
};
ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL] = {
resolved, bound: BOOL;
clink: PrincOps.ControlLink;
stop ← FALSE;
resolved ← TRUE;
[] ← LowLoader.OpenLinkSpace[fi.loadInfoSeq[mod].frame, mth, bcdbase];
FOR i: CARDINAL IN [0 .. LowLoader.LinkSegmentLength[mth, bcdbase]) DO
clink ← LowLoader.ReadLink[i];
[clink, bound] ← NewLink[blink: LowLoader.IthLink[mth, i, bcdbase],
oldclink: clink, sploc: sploc];
IF bound THEN
LowLoader.WriteLink[offset: i, link: clink]
ELSE resolved ← FALSE;
ENDLOOP;
LowLoader.CloseLinkSpace[fi.loadInfoSeq[mod].frame];
IF NOT resolved THEN fi.loadInfoSeq.linksresolved ← FALSE;
mod ← mod + 1;
};
IF fi = NIL OR fi.loadInfoSeq = NIL THEN RETURN; -- must be defs file
bcdbase ← fi.loadInfoSeq.bcdbase;
namestring ← LOOPHOLE[bcdbase + bcdbase.ssOffset];
IF bcdbase.nImports = 0 THEN RETURN; -- no imports
dummymapseq ← fi.loadInfoSeq.dummymapseq;
impexpseq ← fi.loadInfoSeq.impexpseq;
-- the first part of dummymapseq, the map between config gfi's and real gfi's,
-- has already been computed
-- set up map between dummygfi's and the import table
-- IF dummymapseq.size > bcdbase.firstdummy THEN ERROR;
dummymapseq.size ← bcdbase.firstdummy; -- adjust for dummies to come
splist ← sploc.parmlist;
[] ← BcdOps.ProcessImports[bcdbase, ForEachImport];
impexpseq.size ← imp;
-- check to see that all parameters were consumed
WHILE splist ~= NIL AND splist.first.stype ~= typeAPPL DO
splist ← splist.rest;
ENDLOOP;
IF splist ~= NIL THEN
CWF.WF1["Error - more parameters to %s than I can handle.*n"L, fi.bcdFileName];
IF NOT fi.loadInfoSeq.linksresolved THEN {
fi.loadInfoSeq.linksresolved ← TRUE;
-- now run thru the frame links looking for imports to fill in
[] ← BcdOps.ProcessModules[bcdbase, ForEachModule];
};
};
NewLink: PROC[blink: BcdDefs.Link, oldclink: PrincOps.ControlLink,
sploc: MDModel.LOCSymbol] RETURNS[newclink: PrincOps.ControlLink,
resolved: BOOL] = {
loadinfoseq: LowLoader.LoadInfoSeq;
FindLink: PROC[blink: BcdDefs.Link]
RETURNS[PrincOps.ControlLink, BOOL] = {
IF blink.gfi < loadinfoseq.bcdbase.firstdummy THEN {
SELECT blink.vtag FROM
proc0, proc1 => {
rgfi: PrincOps.GFTIndex;
rgfi ← loadinfoseq.dummymapseq[blink.gfi].ind;
newclink ← LowLoader.ConvertLink[blink];
newclink.gfi ← rgfi +
loadinfoseq.dummymapseq[blink.gfi].whichone;
resolved ← rgfi ~= PrincOps.GFTNull;
};
var => {
newclink ← LowLoader.FindVariableLink[blink, loadinfoseq, NIL, NIL];
resolved ← newclink ~= PrincOps.NullLink;
};
ENDCASE => NULL;
}
ELSE {
trueep: CARDINAL;
intno: CARDINAL;
interfaceseq: LowLoader.InterfaceSeq;
intno ← loadinfoseq.dummymapseq[blink.gfi].ind;
interfaceseq ← loadinfoseq.impexpseq[intno];
trueep ← blink.ep + (loadinfoseq.dummymapseq[blink.gfi].whichone
* BcdDefs.EPLimit);
-- import not satisfied?
IF interfaceseq = NIL OR EmptyLink[interfaceseq[trueep].clink] THEN {
ith: BcdOps.IMPHandle;
fth: BcdOps.FTHandle;
sym: STRING ← [100];
ith ← GetImpHandle[loadinfoseq.bcdbase, intno];
fth ← @LOOPHOLE[loadinfoseq.bcdbase + loadinfoseq.bcdbase.ftOffset, BcdDefs.Base][ith.file];
LowLoader.CopyNStoLS[sym, loadinfoseq.bcdbase, ith.name];
CWF.WF3["Warning - Unable to resolve import of item #%u from interface %s\n\tof %v "L,
@trueep, sym, @fth.version];
CWF.WF2["(the %uth import of %s).\n"L,
@intno, sploc.fi.bcdFileName];
RETURN[oldclink, FALSE];
};
-- at this point module and variable links are
-- set to their absolute addresses
newclink ← interfaceseq[trueep].clink;
resolved ← TRUE;
};
RETURN[newclink, resolved];
};
loadinfoseq ← sploc.fi.loadInfoSeq;
newclink ← oldclink;
resolved ← FALSE;
SELECT blink.vtag FROM
proc0, proc1 => IF oldclink = PrincOps.UnboundLink THEN
[newclink, resolved] ← FindLink[blink];
var => IF oldclink = PrincOps.NullLink THEN
[newclink, resolved] ← FindLink[blink];
ENDCASE => newclink ← LOOPHOLE[blink.typeID];
};
-- intno starts at 0
GetImpHandle: PROC[bcdbase: BcdOps.BcdBase, intno: CARDINAL]
RETURNS[ith: BcdOps.IMPHandle] = {
RETURN[@LOOPHOLE[bcdbase + bcdbase.impOffset, BcdDefs.Base]
[LOOPHOLE[intno*SIZE[BcdDefs.IMPRecord], BcdDefs.IMPIndex]]];
};
-- call Paul Rovner's procedure to fixup the Cedar Atoms and Strings section
ProcessCedarBcds: PROC[spmodel: MDModel.MODELSymbol,
symbolseq: MDModel.SymbolSeq, replacement: BOOL] = {
ProcAnalyze: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
sploc: MDModel.LOCSymbol;
loadinfoseq: LowLoader.LoadInfoSeq;
bcdbase: BcdOps.BcdBase;
map: PilotLoadStateOps.Map;
IF sptop.stype ~= typeLOC THEN RETURN;
sploc ← MDModel.NarrowToLOC[sptop];
IF sploc.fi = NIL OR sploc.fi.loadInfoSeq = NIL THEN RETURN;
loadinfoseq ← sploc.fi.loadInfoSeq;
bcdbase ← loadinfoseq.bcdbase;
IF NOT bcdbase.extended THEN RETURN;
IF replacement AND NOT loadinfoseq.mustreplace THEN RETURN;
map ← DESCRIPTOR[Heap.MakeMDSNode[n: bcdbase.firstdummy *
SIZE[PrincOps.GFTIndex]], bcdbase.firstdummy];
-- the dummy bcd #'s start at 1
FOR i: CARDINAL IN [0 .. bcdbase.firstdummy) DO
map[i] ← loadinfoseq.dummymapseq[i].ind;
ENDLOOP;
RTLoader.AcquireTypesAndLiterals[bcd: bcdbase, map: map];
Heap.FreeMDSNode[p: BASE[map]];
};
MDModel.TraverseTree[spmodel, symbolseq, ProcAnalyze, TRUE];
};
}.