-- LoaderImpl.Mesa, last edit January 6, 1983 2:19 pm
-- Mesa 7.0/ Pilot 6.0
-- procedures to load and start modules in a Model

-- this modeller loader is separate from the modelloer
-- so that it can maintain its own load state tru successive modellers
-- interfaceseqs and loadinfoseqs and dummymapseqs are all allocated here

-- 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

DIRECTORY
  BcdDefs: TYPE USING [Base, CTIndex, CTNull, EVIndex, FTIndex, FTSelf,
   GFTIndex, Link, MTIndex, NameRecord, NullLink, SGIndex, SpaceID, SPIndex,
   SPRecord, UnboundLink, VarLimit, VersionID],
  BcdOps: TYPE USING [BcdBase, CTHandle, EXPHandle, FTHandle, MTHandle, NameString,
   ProcessConfigs, ProcessModules, ProcessSegs, SGHandle, SPHandle],
  CWF: TYPE USING [FWF2, FWF4],
  Directory: TYPE USING [UpdateDates],
  Environment: TYPE USING [PageCount, PageNumber, wordsPerPage],
  File: TYPE USING [Capability, LimitPermissions, PageCount, PageNumber, read, write],
  Frame: TYPE USING [GetReturnLink],
  Heap: TYPE USING [FreeMDSNode, MakeMDSNode, systemMDSZone],
  Inline: TYPE USING [BITAND],
  IO: TYPE USING[Handle, PutChar],
  LowLoader: TYPE USING [DummyMapSeq, DummyMapSeqRecord, ImpExpSeq, ImpExpSeqRecord,
   InterfaceSeq, InterfaceSeqRecord, LoadInfoSeq, LoadInfoSeqRecord, ReplaceResult],
  Mopcodes: TYPE USING [zALLOC],
  PrincOps: TYPE USING [ControlLink, ControlModule, Frame, GFTIndex,
   GlobalFrameHandle, NullControl, NullLink, StateVector, UnboundLink],
  PrincOpsRuntime: TYPE USING [GetFrame, GFT],
  RTOS: TYPE USING [CheckForModuleReplacement],
  Runtime: TYPE USING [IsBound, ValidateGlobalFrame],
  RuntimeInternal: TYPE USING [Codebase, EnterGlobalFrame, MakeFsi],
  SDDefs: TYPE USING [SD, sStart, sSwapTrap],
  Space: TYPE USING [Create, defaultBase, Delete, Error, GetHandle, GetWindow, Handle, 
  	LongPointer, MakeReadOnly, MakeWritable, Map, nullHandle, PageCount, 
	PageFromLongPointer, virtualMemory, WindowOrigin],
  SpecialSpace: TYPE USING [CreateForCode, MakeResident],
  Subr: TYPE USING [CopyString, FindMappedSpace, FreeString, 
  	LongZone],
  TimeStamp: TYPE USING [Stamp],
  Trap: TYPE USING [ReadOTP];

LoaderImpl: MONITOR 
IMPORTS BcdOps, CWF, Directory, File, Frame, Heap, 
	Inline, IO, PrincOpsRuntime, RTOS, Runtime, RuntimeInternal, Space, 
	SpecialSpace, Subr, Trap
EXPORTS LowLoader
SHARES File = {

RTCallable: BOOL = TRUE;

-- MDS Usage!

waitCodeTrapCV: CONDITION;
-- link space data
links: LONG POINTER TO ARRAY[0 .. 0) OF PrincOps.ControlLink _ NIL;
writeable: BOOL _ FALSE;
long: BOOL _ FALSE;
-- end of MDS usage



  SGItem: TYPE = RECORD [sgh: BcdOps.SGHandle, space: Space.Handle];

  SGList: TYPE = DESCRIPTOR FOR ARRAY CARDINAL [0..0) OF SGItem;


LoadBcdAndCount: PUBLIC PROC[cap: File.Capability, bcdsfn: LONG STRING,
		oldnwords: CARDINAL]
	RETURNS[loadinfoseq: LowLoader.LoadInfoSeq, newnwords, nbcdheaderpages, 
		ncodepages: CARDINAL] = {
bcdbase: BcdOps.BcdBase;

	ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	 	RETURNS[stop: BOOL] = {
	usecodelinks: BOOL _ mth.linkLoc = code;
	stop _ FALSE;
	IF usecodelinks THEN 
		ncodepages _ ncodepages + (LinkSegmentLength[mth, bcdbase]
			/Environment.wordsPerPage)+1
	ELSE 	-- use frame links
		newnwords _ newnwords + LinkSegmentLength[mth, bcdbase];
	newnwords _ NextMultipleOfFour[newnwords];
	newnwords _ newnwords + mth.framesize;
	};

	CountSegments: PROC[sgh: BcdOps.SGHandle, sgi: BcdDefs.SGIndex]
	 	RETURNS[stop: BOOL] = {
	stop _ FALSE;
	IF sgh.class ~= code THEN RETURN;
	ncodepages _ ncodepages + sgh.pages;
	};

ncodepages _ 0;
newnwords _ oldnwords;
[bcdbase, nbcdheaderpages] _ LoadUpBcd[cap, 1];
loadinfoseq _ AllocateLoadInfoSeq[bcdbase];
loadinfoseq.bcdbase _ bcdbase;
loadinfoseq.size _ 0;
[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
[] _ BcdOps.ProcessSegs[bcdbase, CountSegments];
};

LoadFrame: PUBLIC PROC[loadinfoseq: LowLoader.LoadInfoSeq, oldframeptr: POINTER,
	window: IO.Handle, cap: File.Capability,
	beginning, ending: LONG CARDINAL, oldConfigGfi: PrincOps.GFTIndex] 
	RETURNS[newframeptr: POINTER, newConfigGfi: PrincOps.GFTIndex] = {
mod: CARDINAL _ 0;
dummymapseq: LowLoader.DummyMapSeq;
bcdbase: BcdOps.BcdBase;
ncodepages: CARDINAL;

	WFPut: PROC[ch: CHAR] = {
	window.PutChar[ch];
	};

	ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	 	RETURNS[stop: BOOL] = {
	optr: POINTER;
	diff: CARDINAL;
	usecodelinks: BOOL _ mth.linkLoc = code;
	mname: STRING _ [100];
	frame: PrincOps.GlobalFrameHandle;
	gfi: CARDINAL;
	n: CARDINAL;
	stop _ FALSE;
	IF LOOPHOLE[LONG[newframeptr], LONG CARDINAL] < beginning THEN ERROR;
	optr _ newframeptr;
	IF NOT usecodelinks THEN
		newframeptr _ newframeptr + LinkSegmentLength[mth, bcdbase];
	newframeptr _ NextMultipleOfFour[newframeptr];
	frame _ newframeptr;
	newframeptr _ newframeptr + mth.framesize;
	IF LOOPHOLE[LONG[newframeptr], LONG CARDINAL] > ending THEN ERROR;
	-- frame is zeroed when space is created
	gfi _ RuntimeInternal.EnterGlobalFrame[frame, mth.ngfi];
	frame^ _ [gfi: gfi, copied: FALSE, alloced: FALSE, started: FALSE, 
		shared: FALSE, trapxfers: FALSE, codelinks: usecodelinks, global:, code:];
	loadinfoseq[mod] _ [frame, mth.framesize, mth.ngfi];
	newConfigGfi _ newConfigGfi + mth.ngfi;
	-- now store in cgfi to rgfi map
	FOR i: CARDINAL IN [0 .. mth.ngfi) DO
		dummymapseq[mth.gfi + i] _ [ind: gfi, whichone: i];
		ENDLOOP;
	dummymapseq.size _ dummymapseq.size + mth.ngfi;
	mod _ mod + 1;
	CopyNStoLS[mname, bcdbase, mth.name];
	n _ mth.framesize;
	CWF.FWF4[WFPut, "%s: gfi = %bB, gfh = %bB, framesize = %u, "L, 
		mname, @gfi, @frame, @n];
	n _ LinkSegmentLength[mth, bcdbase];
	CWF.FWF2[WFPut, "#%slinks = %u\n"L, 
		IF frame.codelinks THEN "code"L ELSE "frame"L, @n];
	diff _ newframeptr - optr;
	-- CWF.FWF3[WFPut, "Old = %bB, new = %bB, diff = %u.\n"L, @optr, @newframeptr, @diff];
	};

cap _ Directory.UpdateDates[cap, File.read];
newframeptr _ oldframeptr;
newConfigGfi _ oldConfigGfi;
loadinfoseq.configGfi _ newConfigGfi;
bcdbase _ loadinfoseq.bcdbase;
dummymapseq _ loadinfoseq.dummymapseq;
dummymapseq[0] _ [0, 0];
dummymapseq.size _ 1;	-- dummy module indices start at 1, not 0
[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
ncodepages _ FindAndMapInCode[bcdbase, 1, cap, loadinfoseq];
-- CWF.FWF1[WFPut, "%u code pages.\n"L, @ncodepages];
SetLinksToNull[bcdbase, loadinfoseq];
loadinfoseq.cm _ AssignControlModules[bcdbase, loadinfoseq];
loadinfoseq.size _ mod;
};

WaitForBroadcast: ENTRY PROC[frame: PrincOps.GlobalFrameHandle] = {
WHILE frame.code.out DO
	WAIT waitCodeTrapCV;
	ENDLOOP;
};

-- can only be called for modules (not configs)
LoadIncremental: PUBLIC ENTRY PROC[bcdcap: File.Capability, 
	loadinfoseq: LowLoader.LoadInfoSeq, window: IO.Handle] 
	RETURNS[replaceResult: LowLoader.ReplaceResult] = {
savemodellercode: PROC _ NIL;
codetrapframe: PrincOps.GlobalFrameHandle _ NIL;
{
ENABLE UNWIND => IF savemodellercode ~= NIL THEN
			SDDefs.SD[SDDefs.sSwapTrap] _ savemodellercode;
	
	WFPut: PROC[ch: CHAR] = {
	window.PutChar[ch];
	};

  ModellerCodeTrap: PROC = { 
    start: PROC[PrincOps.ControlModule];
    dest: PrincOps.ControlLink;
    state: PrincOps.StateVector;
    frame: PrincOps.GlobalFrameHandle;
    state _ STATE;
    dest _ Trap.ReadOTP[];
    state.dest _ Frame.GetReturnLink[];
    DO
      IF dest.proc THEN {
      	frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[dest.gfi]]; 
	EXIT}
      ELSE
        IF dest.indirect THEN dest _ dest.link^
        ELSE {frame _ dest.frame.accesslink; EXIT}; -- frame

      ENDLOOP;
    IF frame = codetrapframe THEN {
    	-- this halts outside process until my procedure is finished
	WaitForBroadcast[frame];
	RETURN;
    	};
    IF ~frame.started THEN {
    	start _ LOOPHOLE[SDDefs.SD[SDDefs.sStart]];
	start[[frame[frame]]];
    	};
    frame.code.out _ FALSE;
    RETURN WITH state
    };

n: CARDINAL;
mname: STRING _ [100];
gfi: CARDINAL;
bcdbase: BcdOps.BcdBase;
mth: BcdOps.MTHandle;
frame: PrincOps.GlobalFrameHandle _ loadinfoseq[0].frame;

replaceResult _ ok;
IF loadinfoseq.size ~= 1 THEN RETURN[configNotReplaceable];
[bcdbase] _ LoadUpBcd[bcdcap, 1];
loadinfoseq.bcdbase _ bcdbase;
loadinfoseq.cm _ LOOPHOLE[frame];
-- recompute these since bcdbase.firstdummy, bcdbase.nDummies, and bcdbase.nImports
-- may have changed
ReSizeMaps[loadinfoseq];
mth _ @LOOPHOLE[bcdbase + bcdbase.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
-- checking
IF LOOPHOLE[frame + mth.framesize, CARDINAL] > 
	LOOPHOLE[NextMultipleOfFour[frame + loadinfoseq[0].framesize], CARDINAL] THEN 
		RETURN[frameTooBig];
IF mth.ngfi > loadinfoseq[0].ngfi THEN RETURN[ngfiTooBig];

-- now think of monitor:
-- set lock by setting code trap, then call check procedure
-- then do replacement, then release lock
-- this is to avoid the case where some local frames
-- are created after the call on RTOS.CheckForModuleReplacemeent
-- but before I swap the code
codetrapframe _ frame;
savemodellercode _ SDDefs.SD[SDDefs.sSwapTrap];
SDDefs.SD[SDDefs.sSwapTrap] _ ModellerCodeTrap;
frame.code.out _ TRUE;	-- force code trap
IF RTCallable 
AND Runtime.IsBound[RTOS.CheckForModuleReplacement] 
AND NOT RTOS.CheckForModuleReplacement[frame] THEN {
	SDDefs.SD[SDDefs.sSwapTrap] _ savemodellercode;
	RETURN[checkForMRFailed];
	};
[] _ FindAndMapInCode[bcdbase, 1, bcdcap, loadinfoseq];
-- havinge set the code base, we can now release the lock
frame.code.out _ FALSE;	
BROADCAST waitCodeTrapCV;
SDDefs.SD[SDDefs.sSwapTrap] _ savemodellercode;
savemodellercode _ NIL;

SetLinksToNull[bcdbase, loadinfoseq];
CopyNStoLS[mname, bcdbase, mth.name];
n _ mth.framesize;
gfi _ frame.gfi;
CWF.FWF4[WFPut, "%s: gfi = %bB, gfh = %bB, framesize = %u, "L, 
	mname, @gfi, @frame, @n];
n _ LinkSegmentLength[mth, bcdbase];
CWF.FWF2[WFPut, "#%slinks = %u\n"L, 
	IF frame.codelinks THEN "code"L ELSE "frame"L, @n];
RETURN[ok];
}};

-- old contents are preserved
ReSizeMaps: PROC[loadinfoseq: LowLoader.LoadInfoSeq] =
	{
	longzone: UNCOUNTED ZONE _ Subr.LongZone[];
	olddummymapseq: LowLoader.DummyMapSeq _ loadinfoseq.dummymapseq;
	oldimpexpseq: LowLoader.ImpExpSeq _ loadinfoseq.impexpseq;
	minSize: CARDINAL;
	
	loadinfoseq.dummymapseq _ longzone.NEW[LowLoader.DummyMapSeqRecord[
					loadinfoseq.bcdbase.firstdummy +loadinfoseq.bcdbase.nDummies]];
	loadinfoseq.impexpseq _ longzone.NEW[
		LowLoader.ImpExpSeqRecord[loadinfoseq.bcdbase.nImports]];
	minSize _ MIN[olddummymapseq.size, loadinfoseq.dummymapseq.maxsize];
	FOR i: CARDINAL IN [0 .. minSize) DO
		loadinfoseq.dummymapseq[i] _ olddummymapseq[i];
		ENDLOOP;
	loadinfoseq.dummymapseq.size _ minSize;
	minSize _ MIN[oldimpexpseq.size, loadinfoseq.impexpseq.maxsize];
	FOR i: CARDINAL IN [0 .. minSize) DO
		loadinfoseq.impexpseq[i] _ oldimpexpseq[i];
		ENDLOOP;
	loadinfoseq.impexpseq.size _ minSize;
	longzone.FREE[@olddummymapseq];
	longzone.FREE[@oldimpexpseq];
	};

SetLinksToNull: PROC[bcdbase: BcdOps.BcdBase, loadinfoseq: LowLoader.LoadInfoSeq] = {

	ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	 	RETURNS[stop: BOOL] = {
	-- set all the links to null
	frame: PrincOps.GlobalFrameHandle;
	stop _ FALSE;
	frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[
		loadinfoseq.dummymapseq[mth.gfi].ind]];
	Runtime.ValidateGlobalFrame[frame];
	[] _ OpenLinkSpace[frame, mth, bcdbase];
	FOR i: CARDINAL IN [0..LinkSegmentLength[mth, bcdbase]) DO
		WriteLink[
	    		offset: i,
	    		link: SELECT IthLink[mth, i, bcdbase].vtag FROM
	      			var, type => PrincOps.NullLink, 
	      			ENDCASE => PrincOps.UnboundLink];
		ENDLOOP;
	CloseLinkSpace[frame];
	};
	
[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
loadinfoseq.linksresolved _ FALSE;
};

BuildInterface: PUBLIC PROC[loadinfoseq: LowLoader.LoadInfoSeq, 
	eth: BcdOps.EXPHandle] RETURNS[interfaceseq: LowLoader.InterfaceSeq] = {
clink: PrincOps.ControlLink;
cgfi: PrincOps.GFTIndex;	-- dummy
bcdbase: BcdOps.BcdBase;
intname: STRING _ [100];
fth: BcdOps.FTHandle;
IF eth.size = 0 THEN RETURN[NIL];
bcdbase _ loadinfoseq.bcdbase;
CopyNStoLS[intname, bcdbase, eth.name];
interfaceseq _ AllocateInterfaceSeq[intname, eth.size];
FOR i: CARDINAL IN [0 .. eth.size) DO
	IF eth.links[i].vtag = var THEN {
		[clink] _ FindVariableLink[eth.links[i], loadinfoseq,
			 NIL, NIL];
		interfaceseq[i] _ [clink: clink, blink: BcdDefs.NullLink]
		}
	ELSE
		{
		realgfi: PrincOps.GFTIndex;
		realgfi _ loadinfoseq.dummymapseq[eth.links[i].gfi].ind;
		[clink, cgfi] _ ConvertDummyLinkToControlLink[eth.links[i], 
			realgfi, bcdbase, loadinfoseq];
		interfaceseq[i] _ [clink: clink, 
			blink: [procedure[gfi: cgfi, ep: eth.links[i].ep, tag: eth.links[i].tag]]];
		};
	ENDLOOP;
interfaceseq.size _ eth.size;
fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][eth.file];
interfaceseq.versstamp _ fth.version;
};
	
-- can't be used for configs
BuildFramePtrInterface: PUBLIC PROC[bcdbase: BcdOps.BcdBase, 
	frame: PrincOps.GlobalFrameHandle] 
	RETURNS[interfaceseq: LowLoader.InterfaceSeq] = {
intname: STRING _ [100];
mth: BcdOps.MTHandle;
IF bcdbase.nModules ~= 1 THEN ERROR;
mth _ @LOOPHOLE[bcdbase + bcdbase.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
CopyNStoLS[intname, bcdbase, mth.name];
interfaceseq _ AllocateInterfaceSeq[intname, 1];
IF mth.file = BcdDefs.FTSelf THEN
	interfaceseq.versstamp _ bcdbase.version
ELSE {
	fth: BcdOps.FTHandle;
	fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][mth.file];
	interfaceseq.versstamp _ fth.version;
	};
interfaceseq[0] _ [clink: LOOPHOLE[frame], blink: BcdDefs.NullLink];
interfaceseq.size _ 1;
};
	
-- used by both BuildInterface and the loadstate
FindVariableLink: PUBLIC PROC[blink: BcdDefs.Link, loadinfoseq: LowLoader.LoadInfoSeq,
	frame: PrincOps.GlobalFrameHandle, bcdbase: BcdOps.BcdBase] 
	RETURNS[clink: PrincOps.ControlLink] = {
trueep: CARDINAL;
evi: BcdDefs.EVIndex;
evb: BcdDefs.Base;
mth: BcdOps.MTHandle;

	FindModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] 
		RETURNS [BOOL] =  BEGIN
	  mgfi: PrincOps.GFTIndex _ mth.gfi;
	  IF blink.vgfi IN [mth.gfi..mgfi + mth.ngfi) THEN
	    BEGIN trueep _ BcdDefs.VarLimit*(blink.vgfi - mgfi); RETURN[TRUE] END;
	  RETURN[FALSE]
	  END;

IF bcdbase = NIL THEN bcdbase _ loadinfoseq.bcdbase;
mth _ BcdOps.ProcessModules[bcdbase, FindModule].mth;
IF mth = NIL THEN RETURN[PrincOps.NullLink];
IF frame = NIL THEN
	frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[
		loadinfoseq.dummymapseq[blink.vgfi].ind]];
evb _ LOOPHOLE[bcdbase + bcdbase.evOffset];
trueep _ trueep + blink.var;
IF trueep = 0 THEN RETURN[LOOPHOLE[frame]];
evi _ mth.variables;
RETURN[LOOPHOLE[frame + evb[evi].offsets[trueep]]];
};

-- only works for exported BcdDefs.Links in the export table
ConvertDummyLinkToControlLink: PROC[bl: BcdDefs.Link, realgfi: CARDINAL,
	bcdbase: BcdOps.BcdBase, loadinfoseq: LowLoader.LoadInfoSeq] 
	RETURNS[cl: PrincOps.ControlLink, newcgfi: PrincOps.GFTIndex] = {
cgfi: PrincOps.GFTIndex;

	ForEachModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] 
		RETURNS [BOOL] =  BEGIN
	  mgfi: PrincOps.GFTIndex _ mth.gfi;
	  IF cgfi IN [mth.gfi..mgfi + mth.ngfi) THEN  {
	    	newcgfi _ newcgfi + (cgfi - mgfi);
		realgfi _ realgfi + (cgfi - mgfi); 
		RETURN[TRUE];
		};
	  RETURN[FALSE]
	  END;

newcgfi _ loadinfoseq.configGfi;
IF bl = BcdDefs.UnboundLink THEN RETURN[PrincOps.UnboundLink, newcgfi];
SELECT bl.vtag FROM
var => {
	cgfi _ bl.vgfi;
	IF BcdOps.ProcessModules[bcdbase, ForEachModule].mth = NIL THEN
		RETURN[PrincOps.NullLink, newcgfi];
	cl _ [procedure[gfi: realgfi, ep: bl.var, tag: FALSE]];
	};
proc0, proc1 => {
	cgfi _ bl.gfi;
	IF BcdOps.ProcessModules[bcdbase, ForEachModule].mth = NIL THEN
		RETURN[PrincOps.UnboundLink, newcgfi];
	cl _ [procedure[gfi: realgfi, ep: bl.ep, tag: TRUE]];
	};
type => cl _ LOOPHOLE[bl.typeID];
ENDCASE;
};

EqualStringAndName: PUBLIC PROC[sym: LONG STRING, namestring: BcdOps.NameString,
	name: BcdDefs.NameRecord] RETURNS[equal: BOOL] = {
IF sym.length ~= namestring.size[name] THEN RETURN[FALSE];
FOR i: CARDINAL IN [0 .. sym.length) DO
	IF sym[i] ~= namestring.string.text[name + i] THEN RETURN[FALSE];
	ENDLOOP;
RETURN[TRUE];
};

CopyNStoLS: PUBLIC PROC[resultstr: LONG STRING, bcdbase: BcdOps.BcdBase, 
	name: BcdDefs.NameRecord] = {
namestring: BcdOps.NameString;
namestring _ LOOPHOLE[bcdbase + bcdbase.ssOffset];
IF namestring.size[name] > resultstr.maxlength THEN ERROR;
FOR i: CARDINAL IN [0 .. namestring.size[name]) DO
	resultstr[i] _ namestring.string.text[name + i];
	ENDLOOP;
resultstr.length _ namestring.size[name];
};

FindAndMapInCode: PROC[bcdbase: BcdOps.BcdBase, bcdSpaceBase: File.PageNumber,
	bcdCap: File.Capability, loadinfoseq: LowLoader.LoadInfoSeq] 
	RETURNS[ncodepages: CARDINAL] = {
sgList: SGList;

	GetCode: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] 
		RETURNS [stop: BOOL] =  {
	frame: PrincOps.GlobalFrameHandle;
	stop _ FALSE;
	frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[
		loadinfoseq.dummymapseq[mth.gfi].ind]];
	IF frame = NIL THEN ERROR;
	Runtime.ValidateGlobalFrame[frame];
	IF NOT bcdbase.tableCompiled AND mth.altoCode THEN 
		InvalidModule[bcdbase, mth];
	frame.code.longbase _ SgiToLP[bcdbase, mth.code.sgi, sgList] + mth.code.offset;
	IF frame.code.longbase = NIL THEN ERROR;
	frame.code.out _ TRUE;
	};
	

sgList _ FindSegments[bcdbase];
ncodepages _ AllocateCodeSpaces[bcdbase, sgList, bcdSpaceBase, bcdCap];
[] _ BcdOps.ProcessModules[bcdbase, GetCode
	! UNWIND => ReleaseCode[sgList]];
Heap.FreeMDSNode[z: Heap.systemMDSZone, p: BASE[sgList]];
};

Zero: PUBLIC PROC[lp: LONG POINTER, nwords: CARDINAL] = {
FOR i: CARDINAL IN [0 .. nwords) DO
	(lp + i)^ _ 0;
	ENDLOOP;
};

AllocateLoadInfoSeq: PUBLIC PROC[bcdbase: BcdOps.BcdBase] 
	RETURNS[loadinfoseq: LowLoader.LoadInfoSeq] = {
longzone: UNCOUNTED ZONE _ Subr.LongZone[];
loadinfoseq _ longzone.NEW[LowLoader.LoadInfoSeqRecord[bcdbase.nModules]];
loadinfoseq.dummymapseq _ longzone.NEW[
	LowLoader.DummyMapSeqRecord[bcdbase.firstdummy +bcdbase.nDummies]];
loadinfoseq.impexpseq _ longzone.NEW[
	LowLoader.ImpExpSeqRecord[bcdbase.nImports]];
};

FreeLoadInfoSeq: PUBLIC PROC[loadinfoseq: LowLoader.LoadInfoSeq] = {
longzone: UNCOUNTED ZONE;
IF loadinfoseq = NIL THEN RETURN;
longzone _ Subr.LongZone[];
IF loadinfoseq.bcdbase ~= NIL THEN
	Space.Delete[Space.GetHandle[Space.PageFromLongPointer[loadinfoseq.bcdbase]]
		! Space.Error => CONTINUE];
longzone.FREE[@loadinfoseq.impexpseq];
longzone.FREE[@loadinfoseq.dummymapseq];
longzone.FREE[@loadinfoseq];
};

AllocateInterfaceSeq: PUBLIC PROC[intname: LONG STRING, size: CARDINAL] 
	RETURNS[interfaceseq: LowLoader.InterfaceSeq] = {
longzone: UNCOUNTED ZONE _ Subr.LongZone[];
interfaceseq _ longzone.NEW[LowLoader.InterfaceSeqRecord[size]];
interfaceseq.intname _ Subr.CopyString[intname];
};

FreeInterfaceSeq: PUBLIC PROC[interfaceseq: LowLoader.InterfaceSeq] = {
longzone: UNCOUNTED ZONE;
IF interfaceseq = NIL OR interfaceseq.isfromloadstate THEN RETURN;
longzone _ Subr.LongZone[];
Subr.FreeString[interfaceseq.intname];
longzone.FREE[@interfaceseq];
};

-- from [Ivy]<CedarLang>LowLoader>PilotLoaderSupport.Mesa

  ReleaseCode: PROC [sgList: SGList] =
    BEGIN
    i: CARDINAL;
    space1, space2: Space.Handle;
    space1 _ Subr.FindMappedSpace[sgList[i _ 0].space];
    i _ 1;
    DO
      DO
	IF i = LENGTH[sgList] THEN EXIT;
	IF (space2 _ Subr.FindMappedSpace[sgList[i].space]) # space1 THEN EXIT;
	i _ i + 1;
	ENDLOOP;
      Space.Delete[space1];
      IF i = LENGTH[sgList] THEN EXIT;
      space1 _ space2;
      i _ i + 1;
      ENDLOOP;
    RETURN;
    END;

  FindSegments: PROC [bcd: BcdOps.BcdBase] RETURNS [sgList: SGList] =
    BEGIN
    n: CARDINAL;
    sgItem: SGItem;
    CountSegs: PROC [sgh: BcdOps.SGHandle, sgi: BcdDefs.SGIndex] RETURNS [BOOL] = {
      IF sgh.class # code THEN RETURN[FALSE];
      IF sgh.file # BcdDefs.FTSelf THEN BadFile[bcd, sgh.file];
      n _ n + 1;
      RETURN[FALSE]};
    AddSeg: PROC [sgh: BcdOps.SGHandle, sgi: BcdDefs.SGIndex] RETURNS [BOOL] = {
      IF sgh.class # code THEN RETURN[FALSE];
      sgList[n] _ [sgh: sgh, space: Space.nullHandle];
      n _ n + 1;
      RETURN[FALSE]};
    SiftUp: PROC [low, high: CARDINAL] = {
      k, son: CARDINAL;
      sgItem: SGItem;
      k _ low;
      DO
	IF k*2 > high THEN EXIT;
	IF k*2 + 1 > high OR sgList[k*2 + 1 - 1].sgh.base < sgList[
	  k*2 - 1].sgh.base THEN son _ k*2
	ELSE son _ k*2 + 1;
	IF sgList[son - 1].sgh.base < sgList[k - 1].sgh.base THEN EXIT;
	sgItem _ sgList[son - 1];
	sgList[son - 1] _ sgList[k - 1];
	sgList[k - 1] _ sgItem;
	k _ son;
	ENDLOOP;
      RETURN};
    n _ 0;
    [] _ BcdOps.ProcessSegs[bcd, CountSegs];
    sgList _ DESCRIPTOR[
    	Heap.MakeMDSNode[z: Heap.systemMDSZone, n: n*SIZE[SGItem]], n];
    n _ 0;
    [] _ BcdOps.ProcessSegs[bcd, AddSeg];
    FOR n DECREASING IN [1..LENGTH[sgList]/2] DO
      SiftUp[n, LENGTH[sgList]] ENDLOOP;
    FOR n DECREASING IN [1..LENGTH[sgList]) DO
      sgItem _ sgList[1 - 1];
      sgList[1 - 1] _ sgList[n + 1 - 1];
      sgList[n + 1 - 1] _ sgItem;
      SiftUp[1, n];
      ENDLOOP;
    END;

  AllocateCodeSpaces: PROC [bcd: BcdOps.BcdBase, sgList: SGList,
  	bcdSpaceBase: File.PageNumber, bcdCap: File.Capability] 
	RETURNS[ncodepages: CARDINAL] =
    BEGIN
    start, end, startBase, pages, offset: CARDINAL;
    space, subSpace: Space.Handle;
    ncodepages _ 0;
    IF bcd.nModules = 1 THEN {
    	-- this is a bcd produced by the compiler
	biaspages: CARDINAL;
	mth: BcdOps.MTHandle;
	IF LENGTH[sgList] ~= 1 THEN ERROR;
	mth _ @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
	-- non-0 if code links
	biaspages _ IF mth.linkLoc = code THEN (LinkSegmentLength[mth, bcd]/ Environment.wordsPerPage) + 1 ELSE 0;
	pages _ sgList[0].sgh.pages;
	ncodepages _ pages + biaspages;
	space _ SpecialSpace.CreateForCode[
		size: pages + biaspages, parent: Space.virtualMemory, 
		base: Space.defaultBase];
	-- if the bcd is being loaded with code links,
	-- the cedar compiler will have left room for them
	Space.Map[space: space,
		window: Space.WindowOrigin[
			file: File.LimitPermissions[bcdCap, File.read],
			base: bcdSpaceBase + sgList[0].sgh.base - 1]];
	sgList[0].space _ space;
	RETURN;
	};
    start _ end _ 0;
    DO
      startBase _ sgList[start].sgh.base;
      pages _ sgList[start].sgh.pages;
      DO
	end _ end + 1;
	IF end = LENGTH[sgList] OR pages + sgList[end].sgh.pages > 255 THEN
	  EXIT;
	pages _ pages + sgList[end].sgh.pages;
	ENDLOOP;
      space _ SpecialSpace.CreateForCode[
	size: pages, parent: Space.virtualMemory, base: Space.defaultBase];
      ncodepages _ ncodepages + pages;
      Space.Map[
	space: space,
	window: Space.WindowOrigin[
	file: File.LimitPermissions[bcdCap, File.read],
	base: bcdSpaceBase + sgList[start].sgh.base - 1]];
      offset _ 0;
      FOR index: CARDINAL IN [start..end) DO
	sgh: BcdOps.SGHandle _ sgList[index].sgh;
	sph: BcdOps.SPHandle _ FindSPHandle[bcd, sgh];
	IF sph = NIL THEN
	  subSpace _ Space.Create[size: sgh.pages, parent: space, base: offset]
	ELSE {
	  FOR sp: CARDINAL DECREASING IN [0..sph.length) DO
	    subSpace _ Space.Create[
	      size: sph.spaces[sp].pages, parent: space,
	      base: offset + sph.spaces[sp].offset];
	    IF sph.spaces[sp].resident THEN SpecialSpace.MakeResident[subSpace];
	    ENDLOOP};
	sgList[index].space _ subSpace;
	offset _ offset + sgh.pages;
	ENDLOOP;
      IF end = LENGTH[sgList] THEN EXIT ELSE start _ end;
      ENDLOOP;
    RETURN;
    END;

  FindSPHandle: PROC [bcd: BcdOps.BcdBase, sgh: BcdOps.SGHandle]
    RETURNS [sph: BcdOps.SPHandle] =
    BEGIN
    sgb: BcdDefs.Base = LOOPHOLE[bcd + bcd.sgOffset];
    spb: BcdDefs.Base = LOOPHOLE[bcd + bcd.spOffset];
    spi: BcdDefs.SPIndex;
    FOR spi _ FIRST[BcdDefs.SPIndex], 
      spi + SIZE[BcdDefs.SPRecord] + sph.length*SIZE[BcdDefs.SpaceID]
      UNTIL spi = bcd.spLimit DO
      sph _ @spb[spi]; IF @sgb[sph.seg] = sgh THEN RETURN[sph]; ENDLOOP;
    RETURN[NIL]
    END;

  SgiToLP: PROC [bcd: BcdOps.BcdBase, sgi: BcdDefs.SGIndex, sgList: SGList]
    RETURNS [LONG POINTER] =
    BEGIN
    sgb: BcdDefs.Base = LOOPHOLE[bcd + bcd.sgOffset];
    i: CARDINAL;
    FOR i IN [0..LENGTH[sgList]) DO
      IF @sgb[sgi] = sgList[i].sgh THEN
	RETURN[Space.LongPointer[sgList[i].space]];
      ENDLOOP;
    RETURN[NIL]
    END;

  BadCode: SIGNAL [name: STRING] = CODE;
  MissingCode: SIGNAL [name: STRING] = CODE;

  AppendName: PROC [s: STRING, ssb: BcdOps.NameString, name: BcdDefs.NameRecord] =
    BEGIN
    i: CARDINAL;
    FOR i IN [s.length..MIN[s.maxlength, ssb.size[name] + s.length]) DO
      s[i] _ ssb.string.text[name + i]; s.length _ s.length + 1; ENDLOOP;
    END;

 InvalidModule: PROC [bcd: BcdOps.BcdBase, mth: BcdOps.MTHandle] =
    BEGIN
    name: STRING _ [40];
    dummy: BOOL _ TRUE;
    AppendName[s: name, ssb: LOOPHOLE[bcd + bcd.ssOffset], name: mth.name];
    IF dummy THEN ERROR BadCode[name];
    END;

  BadFile: PROC [bcd: BcdOps.BcdBase, fti: BcdDefs.FTIndex] =
    BEGIN
    name: STRING _ [40];
    fth: BcdOps.FTHandle = @LOOPHOLE[bcd + bcd.ftOffset, BcdDefs.Base][fti];
    dummy: BOOL _ TRUE;
    AppendName[s: name, ssb: LOOPHOLE[bcd + bcd.ssOffset], name: fth.name];
    IF dummy THEN ERROR MissingCode[name];
    END;


  Alloc: PROC [CARDINAL] RETURNS [POINTER] = MACHINE CODE
    BEGIN Mopcodes.zALLOC END;

  InvalidFile: SIGNAL [File.Capability] = CODE;

  LoadUpBcd: PROC [file: File.Capability, offset: File.PageCount] 
  	RETURNS [bcd: BcdOps.BcdBase, pages: CARDINAL] =
    BEGIN
    bcdSpaceBase: File.PageNumber;
    bcdSpace: Space.Handle;
    bcdSpaceBase _ offset;
    bcdSpace _ Space.Create[size: 1, parent: Space.virtualMemory];
    Space.Map[space: bcdSpace, window: [file: file, base: bcdSpaceBase]];
    bcd _ Space.LongPointer[bcdSpace];
    pages _ bcd.nPages;
    IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions 
    OR (NOT bcd.tableCompiled AND ~bcd.spare1) THEN
      ERROR InvalidFile[file ! UNWIND => Space.Delete[bcdSpace]];
    IF pages > 1 THEN
      BEGIN
      Space.Delete[bcdSpace];
      bcdSpace _ Space.Create[size: pages, parent: Space.virtualMemory];
      Space.Map[space: bcdSpace, window: [file: file, base: bcdSpaceBase]];
      bcd _ Space.LongPointer[bcdSpace];
      END;
    Space.MakeReadOnly[bcdSpace];	-- make bcd header spaces ReadOnly, as the code is already
    RETURN
    END;
  
  LinkSegmentLength: PUBLIC PROC[mth: BcdOps.MTHandle, bcd: BcdOps.BcdBase] 
  RETURNS[CARDINAL] =
    BEGIN
    WITH mth: mth SELECT FROM
      direct   =>  RETURN[mth.length];
      indirect =>  RETURN[LOOPHOLE[bcd + bcd.lfOffset, BcdDefs.Base][mth.links].length];
      multiple =>  RETURN[LOOPHOLE[bcd + bcd.lfOffset, BcdDefs.Base][mth.links].length];
     ENDCASE => ERROR;
    END;

  IthLink: PUBLIC PROC[mth: BcdOps.MTHandle, i: CARDINAL, bcd: BcdOps.BcdBase] 
  	RETURNS[BcdDefs.Link] =
    BEGIN
    WITH mth: mth SELECT FROM
      direct   =>  RETURN[mth.frag[i]];
      indirect =>  RETURN[LOOPHOLE[bcd + bcd.lfOffset, BcdDefs.Base][mth.links].frag[i]];
      multiple =>  RETURN[LOOPHOLE[bcd + bcd.lfOffset, BcdDefs.Base][mth.links].frag[i]];
     ENDCASE => ERROR;
    END;

-- link space operations

  OpenLinkSpace: PUBLIC PROC [frame: PrincOps.GlobalFrameHandle, 
  	mth: BcdOps.MTHandle, bcd: BcdOps.BcdBase _ NIL] 
	RETURNS[LONG POINTER] =
    BEGIN
    IF frame.codelinks THEN {
      long _ TRUE; 
      links _ RuntimeInternal.Codebase[LOOPHOLE[frame]];
      IF links = NIL THEN ERROR;
      }
    ELSE {
      long _ FALSE; 
      links _ LOOPHOLE[LONG[frame]]
      };
    links _ links - LinkSegmentLength[mth, bcd];
    writeable _ FALSE;
    RETURN[links];
    END;

  ReadLink: PUBLIC PROC [offset: CARDINAL] 
  RETURNS [link: PrincOps.ControlLink] =
    BEGIN RETURN[links[offset]]; END;

 WriteLink: PUBLIC PROC [offset: CARDINAL, link: PrincOps.ControlLink] = {
    IF long AND NOT writeable THEN {
      space: Space.Handle;
      cap: File.Capability;
      writeable _ TRUE;
      space _ Subr.FindMappedSpace[Space.GetHandle[
      		Space.PageFromLongPointer[links]]];
      cap _ Space.GetWindow[space].file;
      -- questionable????
      -- IF Inline.BITAND[cap.permissions, File.write] = 0 THEN    
      cap.permissions _ cap.permissions + File.write;
      Space.MakeWritable[space, cap]
      };
    links[offset] _ link};

  CloseLinkSpace: PUBLIC PROC [frame: PrincOps.GlobalFrameHandle] = {
    IF long AND writeable THEN
      Space.MakeReadOnly[Subr.FindMappedSpace[Space.GetHandle[
      		Space.PageFromLongPointer[links]]]]
  };



-- from CedarLoaderCore.Mesa

  NextMultipleOfFour: PROC [n: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    BEGIN RETURN[n + Inline.BITAND[-LOOPHOLE[n, INTEGER], 3B]]; END;
    
  CMMapItem: TYPE = RECORD [cti: BcdDefs.CTIndex, cm: PrincOps.ControlModule, level: CARDINAL];

  AssignControlModules: PROC [bcd: BcdOps.BcdBase, loadinfoseq: LowLoader.LoadInfoSeq]
    RETURNS [cm: PrincOps.ControlModule] =
    BEGIN OPEN PrincOps;
    ctb: BcdDefs.Base _ LOOPHOLE[bcd + bcd.ctOffset];
    mtb: BcdDefs.Base _ LOOPHOLE[bcd + bcd.mtOffset];
    cti: BcdDefs.CTIndex;
    mapIndex, maxLevel: CARDINAL _ 0;
    i: CARDINAL;
    cmMap: POINTER TO ARRAY [0..0) OF CMMapItem;
    MapControls: PROC [cth: BcdOps.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] =
      BEGIN OPEN PrincOps, PrincOpsRuntime;
      cm: ControlModule;
      c: BcdDefs.CTIndex;
      level: CARDINAL _ 0;
      IF cth.nControls = 0 THEN cm _ NullControl
      ELSE {
	mti: BcdDefs.MTIndex;
	i: CARDINAL;
	cm.list _ Alloc[
	  RuntimeInternal.MakeFsi[cth.nControls + SIZE[CARDINAL] + SIZE[ControlModule]]];
	cm.list.nModules _ cth.nControls + 1;
	FOR i IN [0..cth.nControls) DO
	  WITH v: cth.controls[i] SELECT FROM	-- new bcddefs
	  module =>  mti _ v.mti;
	  ENDCASE => ERROR;
	  -- mti _ cth.controls[i];		old bcddefs
	  cm.list.frames[i+1] _ 
	  	GetFrame[GFT[loadinfoseq.dummymapseq[mtb[mti].gfi].ind]];  
	  ENDLOOP;
	cm.multiple _ TRUE};
      FOR c _ ctb[cti].config, ctb[c].config UNTIL c = BcdDefs.CTNull DO
	level _ level + 1; ENDLOOP;
      cmMap[mapIndex] _ [cti: cti, cm: cm, level: level];
      mapIndex _ mapIndex + 1;
      maxLevel _ MAX[maxLevel, level];
      RETURN[FALSE];
      END;
    GetControl: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS [BOOL] =
      BEGIN OPEN PrincOps, PrincOpsRuntime;
      frame: GlobalFrameHandle _ GetFrame[GFT[loadinfoseq.dummymapseq[mth.gfi].ind]];
      IF mth.config # cti THEN RETURN[FALSE];
      IF frame.global[0] = NullControl THEN frame.global[0] _ GetModule[cm];
      RETURN[FALSE];
      END;
    IF bcd.nModules = 1 THEN
      BEGIN OPEN PrincOpsRuntime;
      frame: GlobalFrameHandle _ GetFrame[GFT[loadinfoseq.dummymapseq[1].ind]];
      frame.global[0] _ NullControl;
      RETURN[[frame[frame]]];
      END;
    cmMap _ Heap.MakeMDSNode[z: Heap.systemMDSZone, n: bcd.nConfigs*SIZE[CMMapItem]];
    [] _ BcdOps.ProcessConfigs[bcd, MapControls];
    FOR level: CARDINAL DECREASING IN [0..maxLevel] DO
      FOR index: CARDINAL IN [0..mapIndex) DO
	list: ControlModule;
	IF cmMap[index].level # level OR (cm _ cmMap[index].cm) = NullControl THEN LOOP;
	list _ cm;
	list.multiple _ FALSE;
	list.list.frames[1] _ SetLink[cm, list.list.frames[1]].frame;
	FOR i: CARDINAL IN [2..list.list.nModules) DO
	  list.list.frames[i] _
	    SetLink[GetModule[[frame[list.list.frames[1]]]], list.list.frames[i]].frame;
	  ENDLOOP;
	cti _ cmMap[index].cti;
	[] _ BcdOps.ProcessModules[bcd, GetControl];
	ENDLOOP;
      ENDLOOP;
    FOR index: CARDINAL IN [0..mapIndex) DO
      parent: CARDINAL;
      list: ControlModule;
      IF (list _ cmMap[index].cm) = PrincOps.NullControl THEN LOOP;
      list.multiple _ FALSE;
      IF (cti _ ctb[cmMap[index].cti].config) = BcdDefs.CTNull THEN cm _ PrincOps.NullControl
      ELSE {
        FOR parent IN [0..mapIndex) DO IF cmMap[parent].cti = cti THEN EXIT; ENDLOOP;
        cm _ GetModule[cmMap[parent].cm]};
      list.list.frames[0] _ cm.frame;
      ENDLOOP;
    FOR i IN [0..mapIndex) DO
      IF ctb[cmMap[i].cti].config = BcdDefs.CTNull THEN {
	cm _ GetModule[cmMap[i].cm]; EXIT};
      ENDLOOP;
    Heap.FreeMDSNode[z: Heap.systemMDSZone, p: cmMap];
    END;

  SetLink: PROC [
    cm: PrincOps.ControlModule, frame: PrincOps.GlobalFrameHandle] 
    RETURNS [PrincOps.ControlModule] = {
    t: PrincOps.ControlModule = frame.global[0];
    frame.global[0] _ cm;
    RETURN[IF t = PrincOps.NullControl THEN [frame[frame]] ELSE t]};

  GetModule: PROC [cm: PrincOps.ControlModule] RETURNS [PrincOps.ControlModule] = {
    list: PrincOps.ControlModule;
    DO
      IF ~cm.multiple THEN RETURN[cm];
      list _ cm;
      list.multiple _ FALSE;
      cm.frame _ list.list.frames[1];
      ENDLOOP
    };

  ConvertLink: PUBLIC PROC [bl: BcdDefs.Link] RETURNS [cl: PrincOps.ControlLink] =
    BEGIN
    IF bl = BcdDefs.UnboundLink THEN RETURN[PrincOps.UnboundLink];
    SELECT bl.vtag FROM
      var => cl _ [procedure[gfi: bl.vgfi, ep: bl.var, tag: FALSE]];
      proc0, proc1 => cl _ [procedure[gfi: bl.gfi, ep: bl.ep, tag: TRUE]];
      type => cl _ LOOPHOLE[bl.typeID];
      ENDCASE;
    RETURN
    END;


}.