-- LoaderSupportImpl.mesa
-- last edit by Schmidt, January 6, 1983 1:59 pm
-- last edit by Satterthwaite, February 9, 1983 12:55 pm

DIRECTORY
  BcdDefs: TYPE USING [Base, EXPIndex, FTIndex, FTNull, FTSelf,
   GFTIndex, Link, MTIndex, NameRecord, NullVersion, NullLink],
  BcdOps: TYPE USING [BcdBase, EXPHandle, FTHandle, MTHandle, NameString,
    ProcessExports, ProcessModules],
  CompilerOps: TYPE USING [Start],
  CWF: TYPE USING [FWF0, FWF1, WF0, WF1, WF2, WF4],
  Directory: TYPE USING [Handle, Lookup],
  File: TYPE USING [Capability, PageCount],
  IO: TYPE USING[GetChar, Handle, PutChar, PutF, PutRope, Signal],
  LowLoader: TYPE USING [AllocateInterfaceSeq, ConvertLink, CopyNStoLS, EqualStringAndName,
  		FindVariableLink, FreeInterfaceSeq, InterfaceSeq],
  LongString: TYPE USING [EqualString, EquivalentString],
  PilotLoadStateFormat: TYPE USING [ConfigIndex],
  PilotLoadStateOps: TYPE USING [AcquireBcd, ConfigIndex, InputLoadState, MapConfigToReal, 
  	ReleaseLoadState],
  PrincOps: TYPE USING [ControlLink, GFTIndex, GFTNull,
   GlobalFrameHandle, NullLink, UnboundLink],
  PrincOpsRuntime: TYPE USING [GetFrame, GFT],
  Rope: TYPE USING[Lower, ROPE, Text],
  RopeInline: TYPE USING[InlineFlatten],
  Runtime: TYPE USING [IsBound, RunConfig],
  Subr: TYPE USING [AbortMyself, LongZone, MakeTTYProcs, TTYProcs, SubrStop],
  System: TYPE USING [GetClockPulses, PulsesToMicroseconds],
  TimeStamp: TYPE USING [Null, Stamp],
  UECP: TYPE USING[Argv, Parse],
  UserExec: TYPE USING[CommandProc, GetStreams, RegisterCommand, UserAbort];

LoaderSupportImpl: MONITOR 
IMPORTS BcdOps, CompilerOps, CWF, Directory, IO, LowLoader, LongString, PilotLoadStateOps, 
	PrincOpsRuntime, RopeInline, Runtime, Subr, System, UECP, UserExec
EXPORTS LowLoader
SHARES File = {

NEXPRECORDS: CARDINAL = 1500;	-- # of export records in load state
LoadStateSeqRecord:  TYPE = RECORD[
	nbcds: CARDINAL _ 0,	-- nBcds in loadstate when last examined
	size: CARDINAL _ 0,
	body: SEQUENCE maxsize: CARDINAL OF LowLoader.InterfaceSeq
	];

-- MDS Usage!
loadstateseq: LONG POINTER TO LoadStateSeqRecord _ NIL;
-- end of MDS usage
-- procedures having to do with the load state

-- must call IncorporateLoadStateChanges before calling this
GetIntFromLoadState: PUBLIC PROC[intname: LONG STRING, vers: TimeStamp.Stamp] 
	RETURNS[interfaceseq: LowLoader.InterfaceSeq] = {
IF loadstateseq = NIL THEN ERROR;
FOR i: CARDINAL DECREASING IN [0.. loadstateseq.size) DO
	interfaceseq _ loadstateseq[i];
	IF (vers = TimeStamp.Null OR interfaceseq.versstamp = vers) 
	AND LongString.EqualString[interfaceseq.intname, intname] THEN
		RETURN[interfaceseq];
	ENDLOOP;
RETURN[NIL];
};

AddToLoadState: PUBLIC PROC[interfaceseq: LowLoader.InterfaceSeq] = {
IF loadstateseq = NIL THEN ERROR;
IF loadstateseq.size >= loadstateseq.maxsize THEN ERROR;
loadstateseq[loadstateseq.size] _ interfaceseq;
loadstateseq.size _ loadstateseq.size + 1;
interfaceseq.isfromloadstate _ TRUE;
};

IncorporateLoadStateChanges: PUBLIC PROC[window: Subr.TTYProcs, askCompiler: BOOL] = {
ENABLE UNWIND => PilotLoadStateOps.ReleaseLoadState[];
nbcds: CARDINAL;
bcdbase: BcdOps.BcdBase;
namestring: BcdOps.NameString;
longzone: UNCOUNTED ZONE _ Subr.LongZone[];
config: CARDINAL;
p: LONG CARDINAL;

	ForEachExport: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex]
		RETURNS[stop: BOOL] = {
	fth: BcdOps.FTHandle;
	blink: BcdDefs.Link;
	rgfi: CARDINAL;
	newclink: PrincOps.ControlLink;
	interfaceseq: LowLoader.InterfaceSeq;
	stop _ FALSE;
	fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][eth.file];
	interfaceseq _ ProcessInterface[namestring, eth.name, fth.version,
		bcdbase, eth.size];
	IF eth.size > interfaceseq.maxsize THEN {
		PilotLoadStateOps.ReleaseLoadState[];
		ERROR;
		};
	-- now fill in the exports
	FOR i: CARDINAL IN [0 .. eth.size) DO
		blink _ eth.links[i];
		rgfi _ PilotLoadStateOps.MapConfigToReal[blink.gfi, config];
		IF rgfi = PrincOps.GFTNull THEN LOOP;
		SELECT blink.vtag FROM
		var => 	{
			frame: PrincOps.GlobalFrameHandle;
			frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]];
			IF frame = NIL THEN
				newclink _ PrincOps.UnboundLink	-- NIL due to Runtime.SelfDestruct[]
			ELSE
				newclink _ LowLoader.FindVariableLink[blink, NIL, frame, bcdbase];
			};
		proc0, proc1=> {
			newclink _ LowLoader.ConvertLink[blink];
			newclink.gfi _ rgfi;
			};
		type => newclink _ PrincOps.NullLink;	-- error
		ENDCASE => ERROR;
		interfaceseq[i] _ [clink: newclink, blink: BcdDefs.NullLink];
		ENDLOOP;
	interfaceseq.size _ eth.size;
	};
	
	-- this fills in the frame pointers
	ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
		RETURNS[stop: BOOL] = {
	fth: BcdOps.FTHandle;
	rgfi: CARDINAL;
	interfaceseq: LowLoader.InterfaceSeq;
	frame: PrincOps.GlobalFrameHandle;
	stop _ FALSE;
	IF mth.file = BcdDefs.FTSelf OR mth.file = BcdDefs.FTNull THEN RETURN;
	fth _ @LOOPHOLE[bcdbase + bcdbase.ftOffset, BcdDefs.Base][mth.file];
	interfaceseq _ ProcessInterface[namestring, mth.name, fth.version,
		bcdbase, 1];
	IF interfaceseq.maxsize = 0 THEN {
		PilotLoadStateOps.ReleaseLoadState[];
		ERROR;
		};
	-- now fill in module pointer
	rgfi _ PilotLoadStateOps.MapConfigToReal[mth.gfi, config];
	frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]];
	interfaceseq[0] _ [clink: LOOPHOLE[frame], blink: BcdDefs.NullLink];
	interfaceseq.size _ 1;
	};
	
	wp: PROC[ch: CHAR] = {
	window.out.PutChar[ch];
	};
	
{
oldNBcds: CARDINAL _ 0;
p _ System.PulsesToMicroseconds[System.GetClockPulses[]];
IF loadstateseq = NIL THEN
	loadstateseq _ longzone.NEW[LoadStateSeqRecord[NEXPRECORDS]]
ELSE oldNBcds _ loadstateseq.nbcds;
IF askCompiler AND NOT Runtime.IsBound[CompilerOps.Start] THEN {
	IF window.Confirm[
		window.in, window.out, window.data,
		"Do you want to have Compiler.bcd loaded right now ", 'y] = 'y
	    THEN {
		cap: File.Capability;
		CWF.FWF0[wp, "Yes.\nLoading ... "L];
		{
		ENABLE ANY => { CWF.FWF0[wp, "failed.\n"L]; GOTO out};
		cap _ Directory.Lookup["compiler.bcd"L];
		Runtime.RunConfig[file: cap, offset: 1, codeLinks: TRUE];
		CWF.FWF0[wp, "done.\n"L];
		EXITS
		out => NULL;
		}}
	ELSE CWF.FWF0[wp, "No.\n"L];
	};
nbcds _ PilotLoadStateOps.InputLoadState[];
IF oldNBcds = nbcds THEN {
	PilotLoadStateOps.ReleaseLoadState[];
	RETURN;	-- ok, no changes
	};
CWF.FWF0[wp, "Filling in from Pilot load state... "L];
FOR config IN [oldNBcds .. nbcds) DO
	bcdbase _ PilotLoadStateOps.AcquireBcd[config];
	-- this will be true only if this is a fake config
	-- that I generate
	IF bcdbase.version = BcdDefs.NullVersion THEN LOOP;
	namestring _ LOOPHOLE[bcdbase + bcdbase.ssOffset];
	[] _ BcdOps.ProcessExports[bcdbase, ForEachExport];
	[] _ BcdOps.ProcessModules[bcdbase, ForEachModule];
	ENDLOOP;
PilotLoadStateOps.ReleaseLoadState[];
p _ (System.PulsesToMicroseconds[System.GetClockPulses[]] - p)/1000;
loadstateseq.nbcds _ nbcds;
CWF.FWF1[wp, "done (%lu millisec).\n"L, @p];
}};

ProcessInterface: PROC[namestring: BcdOps.NameString, name: BcdDefs.NameRecord,
	version: TimeStamp.Stamp, bcdbase: BcdOps.BcdBase, size: CARDINAL] 
	RETURNS[interfaceseq: LowLoader.InterfaceSeq] = {
oldinterfaceseq: LowLoader.InterfaceSeq;
interfaceseq _ NIL;
FOR i: CARDINAL IN [0 .. loadstateseq.size) DO
	oldinterfaceseq _ loadstateseq[i];
	IF LowLoader.EqualStringAndName[oldinterfaceseq.intname, namestring, name]
	AND oldinterfaceseq.versstamp = version THEN {
		interfaceseq _ oldinterfaceseq;
		EXIT;
		};
	ENDLOOP;
IF interfaceseq = NIL THEN {
	intname: STRING _ [100];
	LowLoader.CopyNStoLS[intname, bcdbase, name];
	interfaceseq _ LowLoader.AllocateInterfaceSeq[intname, size];
	interfaceseq.isfromloadstate _ TRUE;
	loadstateseq[loadstateseq.size] _ interfaceseq;
	loadstateseq.size _ loadstateseq.size + 1;
	IF loadstateseq.size >= loadstateseq.maxsize THEN {
		PilotLoadStateOps.ReleaseLoadState[];
		ERROR;
		};
	interfaceseq.versstamp _ version;
	};
};

PrintCLink: PROC[j: CARDINAL, link: PrincOps.ControlLink] = {
IF link = PrincOps.NullLink THEN 
	CWF.WF1["#%u: NullLink\n"L, @j]
ELSE IF link = PrincOps.UnboundLink THEN 
	CWF.WF1["#%u: UnboundLink\n"L, @j]
ELSE {
	gfi, ep: CARDINAL;
	gfi _ link.gfi;
	ep _ link.ep;
	CWF.WF4["#%u: gfi %bB ep %u, address %bB\n"L, @j, @gfi, @ep, @link];
	};
};

PrintInt: PROC[interfaceseq: LowLoader.InterfaceSeq] = {
j: CARDINAL;
CWF.WF2["%s of %lt:\n"L, interfaceseq.intname, 
	@interfaceseq.versstamp.time];
FOR j IN [0 .. interfaceseq.size) DO
	PrintCLink[j, interfaceseq[j].clink];
	ENDLOOP;
};

PrintInterfacesFromLoadState: UserExec.CommandProc = TRUSTED {
ENABLE Subr.AbortMyself => {
	CWF.WF0["LSPrint aborted.\n"L];
	GOTO out;
	};
argv: UECP.Argv _ UECP.Parse[event.commandLine];
ttyprocs: Subr.TTYProcs _ Subr.MakeTTYProcs[
	exec.GetStreams[].in, exec.GetStreams[].out, exec, MyConfirm];
IncorporateLoadStateChanges[ttyprocs, FALSE];
CWF.WF1["Pilot Loadstate, total %u interface records.\n"L, @loadstateseq.size];
FOR parm: CARDINAL IN [1 .. argv.argc) DO
 	flat: Rope.Text _ LOOPHOLE[RopeInline.InlineFlatten[argv[parm]]];
 	intname: LONG STRING _ LOOPHOLE[flat];
	IF LongString.EquivalentString[intname, "All"L] THEN {
		-- print them all out
		FOR i: CARDINAL IN [0 .. loadstateseq.size) DO
			IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself;
			PrintInt[loadstateseq[i]];
			ENDLOOP;
		}
	ELSE {
		FOR j: CARDINAL IN [0 .. loadstateseq.size) DO
			IF LongString.EquivalentString[intname, loadstateseq[j].intname] THEN {
				PrintInt[loadstateseq[j]];
				EXIT;
				};
			REPEAT
			FINISHED => 
				CWF.WF1["Interface %s not found in load state.\n"L, intname];
			ENDLOOP;
		};
	ENDLOOP;
EXITS
out => NULL;
};

MyConfirm: PROC[in, out: IO.Handle, data: REF ANY, msg: Rope.ROPE, dch: CHAR] RETURNS[CHAR] = {
	ch: CHAR;
	bs: IO.Handle;
	out.PutRope[msg];
	DO
		ENABLE IO.Signal => TRUSTED{IF ec = Rubout THEN LOOP};
		out.PutF["? "];
		bs _ IF in.backingStream = NIL THEN in ELSE in.backingStream;
		ch _ bs.GetChar[];
		IF ch = '\n THEN ch _ dch;
		ch _ Rope.Lower[ch];
		RETURN[ch];
		ENDLOOP;
	};
-- call only once
ShutDown: PUBLIC PROC = {
IF loadstateseq ~= NIL THEN 
	FOR i: CARDINAL IN [0 .. loadstateseq.size) DO
		LowLoader.FreeInterfaceSeq[loadstateseq[i]];
		ENDLOOP;
Subr.SubrStop[];
};


OnceInit: PROC = {
UserExec.RegisterCommand["XLSPrint.~", PrintInterfacesFromLoadState];
};		
	

OnceInit[];
}.