-- SMLoadImpl.mesa
-- last edit by Schmidt, May 13, 1983 2:58 pm
-- last edit by Satterthwaite, August 15, 1983 11:44 am
-- Mesa 7.0/ Pilot 6.0
-- procedures to load and start modules in the new modeller

-- 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
  Atom: TYPE USING [MakeAtom],
  BcdDefs: TYPE USING [
    Base, FTIndex, FTSelf, GFTIndex, Link, MTIndex, NameRecord,
    UnboundLink, VersionID],
  BcdOps: TYPE USING [
    BcdBase, EXPHandle, FTHandle, MTHandle, NameString, ProcessModules],
  CedarLinkerOps: TYPE USING [FindVariableLink],
  Directory: TYPE USING [UpdateDates],
  Environment: TYPE USING [PageCount, PageNumber],
  File: TYPE USING [Capability, PageCount, PageNumber, read, write],
  Frame: TYPE USING [GetReturnLink],
  Inline: TYPE USING [BITAND],
  IO: TYPE USING [card, Handle, PutF, rope],
  LoaderPrivate: TYPE USING[
    AssignCodeToFrames, AssignControlModules, CreateGlobalFrames,
    FindMappedSpace, NextMultipleOfFour],
  PilotLoaderOps: TYPE USING [
    DestroyMap, InitializeMap, IthLink, LinkSegmentLength],
  PilotLoadStateOps: TYPE USING [ConfigIndex],
  PrincOps: TYPE USING [
    ControlLink, ControlModule, Frame, GFTIndex, GlobalFrameHandle,
    NullLink, StateVector, UnboundLink],
  PrincOpsRuntime: TYPE USING [GetFrame, GFT],
  Rope: TYPE USING [Flatten, FromProc, ROPE, Text],
  RTOS: TYPE USING [CheckForModuleReplacement],
  Runtime: TYPE USING [ValidateGlobalFrame],
  RuntimeInternal: TYPE USING [Codebase],
  SDDefs: TYPE USING [SD, sStart, sSwapTrap],
  SMLoad: TYPE USING [
    GfiMap, GfiMapSeq, InterfaceRecordRep, IR, IRSeq, IRSeqRecord,
    LoadInfo, LoadInfoRecord, ReplaceResult],
  Space: TYPE USING [
    Create, Delete, Error, GetHandle, GetWindow, Handle, LongPointer, MakeReadOnly,
    MakeWritable, Map, PageFromLongPointer, virtualMemory],
  TimeStamp: TYPE USING [Stamp],
  Trap: TYPE USING [ReadOTP];

SMLoadImpl: MONITOR 
      IMPORTS
	Atom, BcdOps, CedarLinkerOps, Directory, Frame, Inline, IO, LoaderPrivate,
	PilotLoaderOps, PrincOpsRuntime, Rope, RTOS, Runtime, RuntimeInternal, Space, Trap
      EXPORTS SMLoad
      SHARES File ~ {

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

  LoadGlobalFrames: PUBLIC PROC[
	cap: File.Capability, config: PilotLoadStateOps.ConfigIndex,
	oldConfigGfi: PrincOps.GFTIndex, out: IO.Handle] 
      RETURNS[loadInfo: SMLoad.LoadInfo, newConfigGfi: PrincOps.GFTIndex] ~ {
    bcdBase: BcdOps.BcdBase;
    mod: NAT _ 0;
    gfiMap: SMLoad.GfiMap;
	
    ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	RETURNS[stop: BOOL_FALSE] ~ {
      gfi: NAT ~ loadInfo.map[mth.gfi];
      frame: PrincOps.GlobalFrameHandle ~ 
        PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[gfi]];
      loadInfo[mod] _ [frame~frame, frameSize~mth.framesize, nGfi~mth.ngfi];
      newConfigGfi _ newConfigGfi + mth.ngfi;
      -- now store in cgfi to rgfi map
      FOR i: NAT IN [0 .. mth.ngfi) DO
	gfiMap[mth.gfi+i] _ [index~gfi, whichOne~i];
	ENDLOOP;
      gfiMap.size _ gfiMap.size + mth.ngfi;
      mod _ mod + 1;
      out.PutF["Load %s .. gfi = %bB\n", IO.rope[NSToRope[bcdBase, mth.name]], IO.card[gfi]];
      };
			
    cap _ Directory.UpdateDates[cap, File.read];
    bcdBase _ LoadUpBcd[cap, 1].bcd;
    loadInfo _ AllocateLoadInfo[bcdBase];
    loadInfo.configGfi _ oldConfigGfi;
    newConfigGfi _ oldConfigGfi;
    gfiMap _ loadInfo.gfiMap;
    gfiMap[0] _ [0, 0];
    gfiMap.size _ 1;	-- dummy module indices start at 1, not 0
    loadInfo.map _ PilotLoaderOps.InitializeMap[bcdBase];
    -- map is filled in by CreateGlobalFrames
    loadInfo.frameList _ LoaderPrivate.CreateGlobalFrames[bcdBase, loadInfo.map, config, FALSE];
    [] _ BcdOps.ProcessModules[bcdBase, ForEachModule];
    LoaderPrivate.AssignCodeToFrames[bcdBase, cap, 1, loadInfo.map];
    SetLinksToNull[bcdBase, loadInfo];
    loadInfo.cm _ LoaderPrivate.AssignControlModules[bcdBase, loadInfo.map]};
	
  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, loadInfo: SMLoad.LoadInfo, out: IO.Handle] 
      RETURNS[SMLoad.ReplaceResult] ~ {
    saveModellerCode: PROC _ NIL;
    codeTrapFrame: PrincOps.GlobalFrameHandle _ NIL;
      {
      ENABLE
        UNWIND => {
          IF saveModellerCode ~= NIL THEN
            SDDefs.SD[SDDefs.sSwapTrap] _ saveModellerCode;
          };
	
      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: Rope.Text;
      gfi: CARDINAL;
      bcdBase: BcdOps.BcdBase;
      mth: BcdOps.MTHandle;
      frame: PrincOps.GlobalFrameHandle ~ loadInfo[0].frame;
      IF loadInfo.size ~= 1 THEN RETURN[$configNotReplaceable];
      bcdBase _ LoadUpBcd[bcdcap, 1].bcd;
      loadInfo.bcdBase _ bcdBase;
      loadInfo.cm _ LOOPHOLE[frame];
      -- recompute these since bcdBase.firstdummy, bcdBase.nDummies, and bcdBase.nImports
      -- may have changed
      ReSizeMaps[loadInfo];
      mth _ @LOOPHOLE[bcdBase+bcdBase.mtOffset, BcdDefs.Base][BcdDefs.MTIndex.FIRST];
      -- checking
      IF LOOPHOLE[frame+mth.framesize, CARDINAL] > 
       LOOPHOLE[LoaderPrivate.NextMultipleOfFour[frame+loadInfo[0].frameSize], CARDINAL] THEN 
	RETURN[$frameTooBig];
      IF mth.ngfi > loadInfo[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 ~RTOS.CheckForModuleReplacement[frame] THEN {
	SDDefs.SD[SDDefs.sSwapTrap] _ saveModellerCode;
	RETURN[$checkForMRFailed]};
      PilotLoaderOps.DestroyMap[loadInfo.map];		-- old map
      loadInfo.map _ PilotLoaderOps.InitializeMap[bcdBase];
      -- the dummy bcd #'s start at 1
      FOR i: CARDINAL IN [0 .. bcdBase.firstdummy) DO
	loadInfo.map[i] _ loadInfo.gfiMap[i].index;
	ENDLOOP;
      LoaderPrivate.AssignCodeToFrames[bcdBase, bcdcap, 1, loadInfo.map];
      -- 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, loadInfo];
      mname _ NSToRope[bcdBase, mth.name];
      n _ mth.framesize;
      gfi _ frame.gfi;
      out.PutF["Load %s .. gfi = %bB\n", IO.rope[mname], IO.card[gfi]];
      loadInfo.rtStarted _ FALSE;	-- force AcquireTypesAndLiterals to be called
      RETURN[$ok]};
    };

-- old contents are preserved
  ReSizeMaps: PROC[loadInfo: SMLoad.LoadInfo] ~ {
    newNGfi: NAT ~ loadInfo.bcdBase.firstdummy+loadInfo.bcdBase.nDummies;
    IF newNGfi ~= loadInfo.gfiMap.maxsize THEN {
      oldGfiMap: SMLoad.GfiMap _ loadInfo.gfiMap;
      minSize: NAT ~ MIN[oldGfiMap.size, newNGfi];
      loadInfo.gfiMap _ NEW[SMLoad.GfiMapSeq[newNGfi]];
      FOR i: NAT IN [0 .. minSize) DO loadInfo.gfiMap[i] _ oldGfiMap[i] ENDLOOP;
      loadInfo.gfiMap.size _ minSize;
      FREE[@oldGfiMap]};
    IF loadInfo.bcdBase.nImports ~= loadInfo.imports.size THEN {
      oldImports: SMLoad.IRSeq _ loadInfo.imports;
      minSize: NAT ~ MIN[oldImports.size, loadInfo.bcdBase.nImports];
      loadInfo.imports _ NEW[SMLoad.IRSeqRecord[loadInfo.bcdBase.nImports]];
      FOR i: NAT IN [0 .. minSize) DO loadInfo.imports[i] _ oldImports[i] ENDLOOP;
      FREE[@oldImports]};
    };

  SetLinksToNull: PROC[bcdBase: BcdOps.BcdBase, loadInfo: SMLoad.LoadInfo] ~ {

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

  BuildInterface: PUBLIC PROC[loadInfo: SMLoad.LoadInfo, eth: BcdOps.EXPHandle]
      RETURNS[ir: SMLoad.IR] ~ {
    bcdBase: BcdOps.BcdBase ~ loadInfo.bcdBase;
    name: ATOM ~ Atom.MakeAtom[NSToRope[bcdBase, eth.name]];
    fth: BcdOps.FTHandle ~ @LOOPHOLE[bcdBase + bcdBase.ftOffset, BcdDefs.Base][eth.file];
    IF eth.size = 0 THEN RETURN[NIL];
    ir _ AllocateIR[name, eth.size];
    ir.stamp _ fth.version;
    ir.resolved _ TRUE;
    FOR i: CARDINAL IN [0 .. eth.size) DO
      clink: PrincOps.ControlLink;
      cgfi: PrincOps.GFTIndex;	-- dummy
      SELECT eth.links[i].vtag FROM
	$var => {
	  [link~clink] _ CedarLinkerOps.FindVariableLink[
			bcd~loadInfo.bcdBase, 
			mthLink~eth.links[i],
			rgfi~loadInfo.gfiMap[eth.links[i].vgfi].index];
	  ir[i] _ [link~clink]};
	$proc0, $proc1 => {
	  realgfi: PrincOps.GFTIndex ~ loadInfo.gfiMap[eth.links[i].gfi].index;
	  [clink, cgfi] _ ConvertDummyLinkToControlLink[
			eth.links[i], realgfi, bcdBase, loadInfo];
	  ir[i] _ [link~clink]};
	$type => 	-- means no checking for exported type mismatches!!!
	  ir[i] _ [link~PrincOps.NullLink];
	ENDCASE => ERROR;
      IF EmptyLink[ir[i].link] THEN ir.resolved _ FALSE;
      ENDLOOP;
    };
	
  EmptyLink: PROC[link: PrincOps.ControlLink] RETURNS[BOOL] ~ {
    RETURN[link = PrincOps.UnboundLink OR link = PrincOps.NullLink]};
		
 -- can't be used for configs
  BuildFramePtrInterface: PUBLIC PROC[
	bcdBase: BcdOps.BcdBase, frame: PrincOps.GlobalFrameHandle] 
      RETURNS[ir: SMLoad.IR] ~ {
    name: ATOM;
    mth: BcdOps.MTHandle;
    IF bcdBase.nModules ~= 1 THEN ERROR;
    mth _ @LOOPHOLE[bcdBase+bcdBase.mtOffset, BcdDefs.Base][BcdDefs.MTIndex.FIRST];
    name _ Atom.MakeAtom[NSToRope[bcdBase, mth.name]];
    ir _ AllocateIR[name, 1];
    IF mth.file = BcdDefs.FTSelf THEN
      ir.stamp _ bcdBase.version
    ELSE {
      fth: BcdOps.FTHandle ~ @LOOPHOLE[bcdBase+bcdBase.ftOffset, BcdDefs.Base][mth.file];
      ir.stamp _ fth.version};
    ir[0] _ [link~LOOPHOLE[frame]]};
	
 -- only works for exported BcdDefs.Links in the export table
  ConvertDummyLinkToControlLink: PROC[
	bl: BcdDefs.Link, realgfi: CARDINAL,
	bcdBase: BcdOps.BcdBase, loadInfo: SMLoad.LoadInfo] 
      RETURNS[cl: PrincOps.ControlLink, newcgfi: PrincOps.GFTIndex] ~ {
    cgfi: PrincOps.GFTIndex;

    ForEachModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] 
	RETURNS [BOOL] ~ {
      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]};

    newcgfi _ loadInfo.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;
    };

  NSToRope: PUBLIC PROC[bcdBase: BcdOps.BcdBase, name: BcdDefs.NameRecord] 
      RETURNS[Rope.Text] ~ {
    namestring: BcdOps.NameString ~ LOOPHOLE[bcdBase+bcdBase.ssOffset];
    i: CARDINAL _ 0;
    
    EachChar: SAFE PROC RETURNS[c: CHAR] ~ TRUSTED {
      c _ namestring.string.text[name+i]; i _ i+1; RETURN};
      
    RETURN[Rope.FromProc[namestring.size[name], EachChar].Flatten[]]};

  AllocateLoadInfo: PUBLIC PROC[bcdBase: BcdOps.BcdBase] 
      RETURNS[loadInfo: SMLoad.LoadInfo] ~ {
    loadInfo _ NEW[SMLoad.LoadInfoRecord[bcdBase.nModules]];
    loadInfo.bcdBase _ bcdBase;
    loadInfo.gfiMap _ NEW[SMLoad.GfiMapSeq[bcdBase.firstdummy +bcdBase.nDummies]];
    loadInfo.imports _ NEW[SMLoad.IRSeqRecord[bcdBase.nImports]]};

  FreeLoadInfo: PUBLIC PROC[loadInfo: SMLoad.LoadInfo] RETURNS[SMLoad.LoadInfo] ~ {
    IF loadInfo = NIL THEN RETURN[NIL];
    IF loadInfo.bcdBase ~= NIL THEN
	Space.Delete[Space.GetHandle[Space.PageFromLongPointer[loadInfo.bcdBase]]
	  ! Space.Error => {CONTINUE}];
    loadInfo.imports _ NIL;
    loadInfo.gfiMap _ NIL;
    RETURN[NIL]};

  AllocateIR: PUBLIC PROC[name: ATOM, size: NAT] RETURNS[ir: SMLoad.IR] ~ {
    ir _ NEW[SMLoad.InterfaceRecordRep[size] _ [name~name, body~]];
    FOR i: NAT IN [0 .. size) DO ir[i] _ [PrincOps.NullLink] ENDLOOP};

  FreeIR: PUBLIC PROC[ir: SMLoad.IR] RETURNS[SMLoad.IR] ~ {
    IF ir # NIL THEN {ir.name _ NIL; FREE[@ir]};
    RETURN[NIL]};


  InvalidFile: PUBLIC ERROR [File.Capability] ~ CODE;

  LoadUpBcd: PROC [file: File.Capability, offset: File.PageCount] 
      RETURNS [bcd: BcdOps.BcdBase, pages: CARDINAL] ~ {
    bcdSpaceBase: File.PageNumber ~ offset;
    bcdSpace: Space.Handle _ Space.Create[size~1, parent~Space.virtualMemory];
    bcdSpace.Map[window~[file~file, base~bcdSpaceBase]];
    bcd _ bcdSpace.LongPointer;  pages _ bcd.nPages;
    IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions 
     OR (~bcd.tableCompiled AND ~bcd.spare1) THEN
      ERROR InvalidFile[file ! UNWIND => {Space.Delete[bcdSpace]}];
    IF pages > 1 THEN {
      Space.Delete[bcdSpace];
      bcdSpace _ Space.Create[size~pages, parent~Space.virtualMemory];
      bcdSpace.Map[window~[file~file, base~bcdSpaceBase]];
      bcd _ bcdSpace.LongPointer};
    bcdSpace.MakeReadOnly;	-- make bcd header spaces ReadOnly, as the code is already
    RETURN};
  
-- link space operations

  OpenLinkSpace: PUBLIC PROC [
	frame: PrincOps.GlobalFrameHandle, mth: BcdOps.MTHandle, bcd: BcdOps.BcdBase_NIL] 
      RETURNS[LONG POINTER] ~ {
    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 - PilotLoaderOps.LinkSegmentLength[mth, bcd];
    writeable _ FALSE;
    RETURN[links]};

  ReadLink: PUBLIC PROC [offset: CARDINAL] RETURNS [link: PrincOps.ControlLink] ~ {
    RETURN[links[offset]]};

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

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



  ConvertLink: PUBLIC PROC [bl: BcdDefs.Link] RETURNS [PrincOps.ControlLink] ~ {
    RETURN [IF bl = BcdDefs.UnboundLink
      THEN PrincOps.UnboundLink
      ELSE SELECT bl.vtag FROM
	$var => [procedure[gfi~bl.vgfi, ep~bl.var, tag~FALSE]],
	$proc0, $proc1 => [procedure[gfi~bl.gfi, ep~bl.ep, tag~TRUE]],
	$type => LOOPHOLE[bl.typeID],
	ENDCASE => ERROR]
    };

  }.