-- LoaderCore.mesa  Edited by Sandman on October 3, 1980  10:24 AM 
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  BcdDefs USING [
    Base, CTIndex, CTNull, EPIndex, EPLimit, EVIndex, EVNull, EXPIndex, EXPNull,
    FTIndex, FTSelf, IMPIndex, Link, MTIndex, MTNull, PackedString, TMIndex,
    TMNull, TMRecord, UnboundLink, VarLimit, VersionStamp],
  BcdOps USING [
    BcdBase, CTHandle, EXPHandle, FTHandle, IMPHandle, MTHandle, ProcessConfigs,
    ProcessExports, ProcessImports, ProcessModules, TMHandle],
  ControlDefs USING [
    ControlLink, ControlModule, GFT, GFTIndex, GFTNull, GlobalFrameHandle,
    NullControl, NullGlobalFrame, NullLink, UnboundLink],
  FrameOps USING [Alloc, MakeFsi],
  InlineDefs USING [BITAND],
  LoaderOps USING [
    AllocateFrames, Binding, BindLink, CloseLinkSpace, DestroyMap, FindCode,
    FindFiles, FindFrameIndex, GetGfi, InitBinding, FinalizeUtilities,
    InitializeMap, InitializeUtilities, OpenLinkSpace, ReadLink, ReleaseBinding,
    ReleaseFrames, WriteLink],
  LoadStateFormat USING [ModuleInfo],
  LoadStateOps USING [
    AcquireBcd, BcdExports, BcdExportsTypes, BcdUnresolved, ConfigIndex,
    EnterModule, GetMap, GetModule, InputLoadState, Map, MapConfigToReal,
    ReleaseBcd, ReleaseLoadState, ReleaseMap, UpdateLoadState],
  StringDefs USING [
    AppendSubString, EqualSubStrings, SubStringDescriptor, SubString],
  Storage USING [Words, FreeWords];

LoaderCore: PROGRAM
  IMPORTS
    BcdOps, FrameOps, InlineDefs, LoaderOps, LoadStateOps, StringDefs, Storage
  EXPORTS LoaderOps =
  BEGIN OPEN BcdDefs, BcdOps;

  Binding: TYPE = LoaderOps.Binding;
  ConfigIndex: TYPE = LoadStateOps.ConfigIndex;
  Map: TYPE = LoadStateOps.Map;
  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  ControlModule: TYPE = ControlDefs.ControlModule;
  SSD: TYPE = StringDefs.SubStringDescriptor;

  VersionMismatch: PUBLIC SIGNAL [name: STRING] = CODE;

  New: PUBLIC PROCEDURE [bcd: BcdBase, framelinks, alloc: BOOLEAN]
    RETURNS [cm: ControlDefs.ControlModule] =
    BEGIN OPEN LoadStateOps, LoaderOps;
    system: BcdBase ← NIL;
    map: Map ← DESCRIPTOR[NIL, 0];
    sMap: Map ← DESCRIPTOR[NIL, 0];
    binding: Binding ← DESCRIPTOR[NIL, 0];
    frames: POINTER ← NIL;
    nbcds, i: CARDINAL;
    resolved: BOOLEAN;

    CleanUpNew: PROCEDURE =
      BEGIN
      DestroyMap[map];
      [] ← ReleaseBinding[bcd, binding];
      LoaderOps.FinalizeUtilities[];
      ReleaseBcd[bcd];
      ReleaseLoadState[];
      RETURN
      END;

    SetupLoad: PROCEDURE [bcd: BcdBase] RETURNS [map: Map, nbcds: CARDINAL] =
      BEGIN OPEN LoaderOps;
      InitializeUtilities[bcd];
      FindFiles[bcd];
      resolved ← bcd.nImports = 0;
      map ← InitializeMap[bcd];
      nbcds ← InputLoadState[];
      RETURN
      END;

    BEGIN
    ENABLE UNWIND => BEGIN ReleaseFrames[bcd, frames, map]; CleanUpNew[]; END;
    [map: map, nbcds: nbcds] ← SetupLoad[bcd];
    frames ← AllocateFrames[bcd, alloc, framelinks];
    cm ← AssignFrameAddresses[frames, bcd, map, nbcds, alloc, framelinks];
    binding ← InitBinding[bcd];
    BindImports[bcd, bcd, binding];
    resolved ← ProcessLinks[bcd, bcd, map, binding, nbcds, TRUE];
    binding ← ReleaseBinding[bcd, binding];
    FOR i DECREASING IN [0..nbcds) DO
      IF ~resolved AND BcdExports[i] THEN
	BEGIN
	ENABLE UNWIND => ReleaseBcd[system];
	system ← AcquireBcd[i];
	binding ← InitBinding[bcd];
	BindImports[bcd, system, binding];
	resolved ← ProcessLinks[bcd, system, map, binding, i, FALSE];
	binding ← ReleaseBinding[bcd, binding];
	END;
      IF BcdUnresolved[i] AND bcd.nExports # 0 THEN
	BEGIN
	ENABLE UNWIND => BEGIN ReleaseBcd[system]; ReleaseMap[sMap]; END;
	IF system = NIL THEN system ← AcquireBcd[i];
	sMap ← GetMap[i];
	binding ← InitBinding[system];
	BindImports[system, bcd, binding];
	[] ← ProcessLinks[system, bcd, sMap, binding, nbcds, FALSE];
	ReleaseMap[sMap];
	sMap ← DESCRIPTOR[NIL, 0];
	binding ← ReleaseBinding[system, binding];
	END;
      IF bcd.typeExported AND BcdExportsTypes[i] THEN
	BEGIN
	ENABLE UNWIND => ReleaseBcd[system];
	IF system = NIL THEN system ← AcquireBcd[i];
	CheckTypes[bcd, system];
	END;
      IF system # NIL THEN ReleaseBcd[system];
      system ← NIL;
      ENDLOOP;
    UpdateLoadState[nbcds, bcd];
    IF bcd.nModules = 1 THEN cm ← LOOPHOLE[frames];
    CleanUpNew[];
    END;
    END;

  AssignFrameAddresses: PROCEDURE [
    p: POINTER, bcd: BcdBase, map: Map, config: ConfigIndex,
    alloc, allframelinks: BOOLEAN] RETURNS [ControlDefs.ControlModule] =
    BEGIN
    frame: GlobalFrameHandle ← p;
    single: BOOLEAN ← bcd.nModules = 1;

    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      gfi: ControlDefs.GFTIndex;
      i: CARDINAL;
      framelinks: BOOLEAN;
      framelinks ← allframelinks OR mth.links = frame OR ~mth.code.linkspace;
      IF ~single AND alloc THEN
	BEGIN
	p ← NextMultipleOfFour[p + 1];
	(p - 1)↑ ← LoaderOps.FindFrameIndex[mth, framelinks];
	END;
      IF ~single AND framelinks THEN p ← p + mth.frame.length;
      frame ← NextMultipleOfFour[p];
      p ← frame + mth.framesize;
      gfi ← LoaderOps.GetGfi[frame, mth.ngfi];
      FOR i IN [0..mth.ngfi) DO
	map[mth.gfi + i] ← gfi + i;
	LoadStateOps.EnterModule[
	  gfi + i,
	  [gfi: mth.gfi + i, config: config, resolved: mth.frame.length = 0]];
	ENDLOOP;
      frame↑ ←
	[gfi: gfi, unused: 0, alloced: alloc OR single, shared: FALSE,
	  copied: FALSE, started: FALSE, trapxfers: FALSE, codelinks: ~framelinks,
	  code:, global:];
      frame.global[0] ← ControlDefs.NullControl;
      RETURN[FALSE];
      END;

      [] ← BcdOps.ProcessModules[bcd, ModuleSearch];
    LoaderOps.FindCode[bcd, map];
    RETURN[AssignControlModules[bcd, map]];
    END;

  NextMultipleOfFour: PROCEDURE [n: POINTER] RETURNS [POINTER] =
    BEGIN RETURN[n + InlineDefs.BITAND[-LOOPHOLE[n, INTEGER], 3B]]; END;

  BindImports: PROCEDURE [bcd, system: BcdBase, binding: Binding] =
    BEGIN

    ForEachImport: PROCEDURE [ith: IMPHandle, iti: IMPIndex] RETURNS [BOOLEAN] =
      BEGIN
      i: CARDINAL;
      iname, sysname: SSD;
      issb, sysssb: POINTER TO BcdDefs.PackedString;
      module: MTIndex;
      export: EXPIndex;

      ExpMatch: PROCEDURE [eth: EXPHandle, eti: EXPIndex] RETURNS [BOOLEAN] =
	BEGIN OPEN StringDefs;
	sysname.offset ← eth.name;
	sysname.length ← sysssb.size[eth.name];
	RETURN[
	  eth.port = ith.port AND EqualSubStrings[@iname, @sysname] AND
	    EqualVersions[bcd, system, ith.file, eth.file, @iname]]
	END;

      ModuleMatch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
	BEGIN OPEN StringDefs;
	sysname.offset ← mth.name;
	sysname.length ← sysssb.size[mth.name];
	RETURN[
	  EqualSubStrings[@iname, @sysname] AND EqualVersions[
	    bcd, system, ith.file, mth.file, @iname]]
	END;

      issb ← LOOPHOLE[bcd + bcd.ssOffset];
      iname ← [base: @issb.string, offset: ith.name, length: issb.size[ith.name]];
      sysssb ← LOOPHOLE[system + system.ssOffset];
      sysname.base ← @sysssb.string;
      IF ith.port = interface THEN
	BEGIN
	export ← BcdOps.ProcessExports[system, ExpMatch].eti;
	FOR i IN [0..ith.ngfi) DO
	  IF export = EXPNull THEN
	    binding[ith.gfi + i] ← [whichgfi: i, body: notbound[]]
	  ELSE binding[ith.gfi + i] ← [whichgfi: i, body: interface[export]];
	  ENDLOOP
	END
      ELSE
	BEGIN
	module ← BcdOps.ProcessModules[system, ModuleMatch].mti;
	FOR i IN [0..ith.ngfi) DO
	  IF module = MTNull THEN
	    binding[ith.gfi + i] ← [whichgfi: i, body: notbound[]]
	  ELSE binding[ith.gfi + i] ← [whichgfi: i, body: module[module]];
	  ENDLOOP;
	END;
      RETURN[FALSE];
      END;

      [] ← BcdOps.ProcessImports[bcd, ForEachImport];
    END;

  EqualVersions: PROCEDURE [
    bcd1, bcd2: BcdBase, fti1, fti2: BcdDefs.FTIndex, name: StringDefs.SubString]
    RETURNS [BOOLEAN] =
    BEGIN
    v1, v2: POINTER TO BcdDefs.VersionStamp;
    f1: FTHandle ← @LOOPHOLE[bcd1 + bcd1.ftOffset, Base][fti1];
    f2: FTHandle ← @LOOPHOLE[bcd2 + bcd2.ftOffset, Base][fti2];
    v1 ← IF fti1 = FTSelf THEN @bcd1.version ELSE @f1.version;
    v2 ← IF fti2 = FTSelf THEN @bcd2.version ELSE @f2.version;
    IF v1↑ = v2↑ THEN RETURN[TRUE];
    BadVersion[name];
    RETURN[FALSE];
    END;

  BadVersion: PROCEDURE [name: StringDefs.SubString] =
    BEGIN
    filename: STRING ← [40];
    StringDefs.AppendSubString[filename, name];
    SIGNAL VersionMismatch[filename];
    END;

  ProcessLinks: PROCEDURE [
    bcd, system: BcdBase, map: Map, binding: Binding, config: ConfigIndex,
    initial: BOOLEAN] RETURNS [BOOLEAN] =
    BEGIN OPEN ControlDefs;
    smtb: Base = LOOPHOLE[system + system.mtOffset];
    setb: Base = LOOPHOLE[system + system.expOffset];
    unresolved: BOOLEAN ← FALSE;

    NewLink: PROCEDURE [old: ControlLink, link: Link]
      RETURNS [new: ControlLink, resolved: BOOLEAN] =
      BEGIN
      gfi: GFTIndex ← 0;

      FindLink: PROCEDURE [link: Link]
	RETURNS [new: ControlLink, resolved: BOOLEAN] =
	BEGIN
	ep: EPIndex;
	inside: BOOLEAN;
	rgfi: GFTIndex ← GFTNull;
	bindLink: LoaderOps.BindLink = binding[link.gfi];
	new ← ControlDefs.UnboundLink;
	IF (inside ← link.gfi < bcd.firstdummy) THEN
	  BEGIN new ← ConvertLink[link]; rgfi ← map[link.gfi] END
	ELSE
	  WITH b: bindLink SELECT FROM
	    interface =>
	      BEGIN
	      e: EXPHandle = @setb[b.eti];
	      SELECT e.port FROM
		interface =>
		  BEGIN
		  ep ← link.ep + (b.whichgfi*EPLimit);
		  link ← e.links[ep];
		  rgfi ← LoadStateOps.MapConfigToReal[link.gfi, config];
		  END;
		ENDCASE;
	      END;
	    module =>
	      BEGIN
	      m: MTHandle = @smtb[b.mti];
	      link ← [variable[vgfi: m.gfi, var: 0, vtag: var]];
	      rgfi ← LoadStateOps.MapConfigToReal[m.gfi, config];
	      END;
	    ENDCASE;
	SELECT link.vtag FROM
	  var => new ← FindVariableLink[inside, link, rgfi];
	  proc0, proc1 => BEGIN new ← ConvertLink[link]; new.gfi ← rgfi END;
	  ENDCASE;
	RETURN[new: new, resolved: rgfi # GFTNull]
	END;

      FindVariableLink: PROCEDURE [inside: BOOLEAN, el: Link, rgfi: GFTIndex]
	RETURNS [link: ControlLink] =
	BEGIN
	ep: CARDINAL;
	evi: EVIndex;
	evb: Base;
	gfi: GFTIndex ← el.vgfi;
	mth: MTHandle;
	frame: GlobalFrameHandle;

	FindModule: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
	  BEGIN
	  mgfi: GFTIndex ← mth.gfi;
	  IF gfi IN [mth.gfi..mgfi + mth.ngfi) THEN
	    BEGIN ep ← VarLimit*(gfi - mgfi); RETURN[TRUE] END;
	  RETURN[FALSE]
	  END;

	mth ← BcdOps.ProcessModules[
	  IF inside THEN bcd ELSE system, FindModule].mth;
	IF mth = NIL THEN RETURN[ControlDefs.NullLink];
	evb ←
	  IF ~inside THEN LOOPHOLE[system + system.evOffset, Base]
	  ELSE LOOPHOLE[bcd + bcd.evOffset, Base];
	frame ← ControlDefs.GFT[rgfi].frame;
	IF (ep ← ep + el.var) = 0 THEN RETURN[LOOPHOLE[frame]];
	IF (evi ← mth.variables) = EVNull THEN RETURN[ControlDefs.NullLink];
	RETURN[LOOPHOLE[frame + evb[evi].offsets[ep]]];
	END;

      new ← old;
      resolved ← TRUE;
      SELECT link.vtag FROM
	proc0, proc1 =>
	  IF old = ControlDefs.UnboundLink THEN
	    [new: new, resolved: resolved] ← FindLink[link];
	var =>
	  IF old = ControlDefs.NullLink THEN
	    [new: new, resolved: resolved] ← FindLink[link];
	ENDCASE => new ← LOOPHOLE[link.typeID];
      RETURN
      END;

    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs;
      i: CARDINAL;
      gfi: GFTIndex = map[mth.gfi];
      frame: GlobalFrameHandle ← GFT[gfi].frame;
      resolved, bound: BOOLEAN;
      old, new: ControlLink;
      info: LoadStateFormat.ModuleInfo ← LoadStateOps.GetModule[gfi];
      IF frame = ControlDefs.NullGlobalFrame OR info.resolved THEN RETURN[FALSE];
      LoaderOps.OpenLinkSpace[frame, mth];
      IF initial THEN
	FOR i IN [0..mth.frame.length) DO
	  LoaderOps.WriteLink[
	    offset: i,
	    link:
	    SELECT mth.frame.frag[i].vtag FROM
	      var, type => NullLink,
	      ENDCASE => UnboundLink];
	  ENDLOOP;
      resolved ← TRUE;
      FOR i IN [0..mth.frame.length) DO
	old ← LoaderOps.ReadLink[i];
	[new: new, resolved: bound] ← NewLink[link: mth.frame.frag[i], old: old];
	IF bound THEN LoaderOps.WriteLink[offset: i, link: new]
	ELSE resolved ← FALSE;
	ENDLOOP;
      FOR i IN [gfi..gfi + mth.ngfi) DO
	info ← LoadStateOps.GetModule[i];
	info.resolved ← resolved;
	LoadStateOps.EnterModule[i, info];
	ENDLOOP;
      LoaderOps.CloseLinkSpace[frame];
      RETURN[FALSE];
      END;

      [] ← BcdOps.ProcessModules[bcd, ModuleSearch];
    RETURN[unresolved];
    END;

  ConvertLink: PROCEDURE [bl: Link] RETURNS [cl: ControlDefs.ControlLink] =
    BEGIN
    IF bl = UnboundLink THEN RETURN[ControlDefs.UnboundLink];
    SELECT bl.vtag FROM
      var => cl ← [procedure[gfi: bl.vgfi, ep: bl.var, tag: frame]];
      proc0, proc1 => cl ← [procedure[gfi: bl.gfi, ep: bl.ep, tag: procedure]];
      type => cl ← LOOPHOLE[bl.typeID];
      ENDCASE;
    RETURN
    END;

  ProcessTypeMap: PROCEDURE [
    bcd: BcdBase, proc: PROC [TMHandle, TMIndex] RETURNS [BOOLEAN]]
    RETURNS [tmh: TMHandle, tmi: TMIndex] =
    BEGIN
    tmb: Base = LOOPHOLE[bcd + bcd.tmOffset];
    FOR tmi ← FIRST[TMIndex], tmi + SIZE[TMRecord] UNTIL tmi = bcd.tmLimit DO
      IF proc[tmh ← @tmb[tmi], tmi] THEN RETURN; ENDLOOP;
    RETURN[NIL, TMNull];
    END;

  CheckTypes: PROCEDURE [bcd1, bcd2: BcdBase] =
    BEGIN
    typeError: STRING = "Exported Type Clash"L;
    typb1: Base = LOOPHOLE[bcd1 + bcd1.typOffset];
    typb2: Base = LOOPHOLE[bcd2 + bcd2.typOffset];
    TypeMap1: PROCEDURE [tmh1: TMHandle, tmi1: TMIndex] RETURNS [BOOLEAN] =
      BEGIN
      TypeMap2: PROCEDURE [tmh2: TMHandle, tmi2: TMIndex] RETURNS [BOOLEAN] =
	BEGIN
	IF tmh2.offset = tmh1.offset AND tmh2.version = tmh1.version THEN
	  BEGIN
	  IF typb1[tmh1.map] # typb2[tmh2.map] THEN
	    ERROR VersionMismatch[typeError];
	  RETURN[TRUE];
	  END
	ELSE RETURN[FALSE];
	END;
	[] ← ProcessTypeMap[bcd2, TypeMap2];
      RETURN[FALSE];
      END;
      [] ← ProcessTypeMap[bcd1, TypeMap1];
    RETURN
    END;

  CMMapItem: TYPE = RECORD [cti: CTIndex, level: CARDINAL, cm: ControlDefs.ControlModule];

  AssignControlModules: PROCEDURE [bcd: BcdBase, map: Map]
    RETURNS [cm: ControlDefs.ControlModule] =
    BEGIN OPEN ControlDefs;
    ctb: Base ← LOOPHOLE[bcd + bcd.ctOffset];
    mtb: Base ← LOOPHOLE[bcd + bcd.mtOffset];
    cti: CTIndex;
    mapIndex, maxLevel: CARDINAL ← 0;
    i: CARDINAL;
    cmMap: POINTER TO ARRAY [0..0) OF CMMapItem;
    MapControls: PROCEDURE [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs;
      cm: ControlModule;
      level: CARDINAL ← 0;
      c: CTIndex;
      IF cth.nControls = 0 THEN cm ← NullControl
      ELSE {
	i: CARDINAL;
	cm.list ← FrameOps.Alloc[
	  FrameOps.MakeFsi[cth.nControls + SIZE[CARDINAL] + SIZE[ControlModule]]];
	cm.list.nModules ← cth.nControls + 1;
	FOR i IN [0..cth.nControls) DO
	  cm.list.frames[i+1] ← GFT[map[mtb[cth.controls[i]].gfi]].frame; ENDLOOP;
	cm.multiple ← TRUE};
      FOR c ← ctb[cti].config, ctb[c].config UNTIL c = 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: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs;
      frame: GlobalFrameHandle ← GFT[map[mth.gfi]].frame;
      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
      frame: GlobalFrameHandle ← GFT[map[1]].frame;
      frame.global[0] ← NullControl;
      RETURN[[frame[frame]]];
      END;
    cmMap ← Storage.Words[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) = NullControl THEN LOOP;
      list.multiple ← FALSE;
      IF (cti ← ctb[cmMap[index].cti].config) = CTNull THEN cm ← 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 = CTNull THEN {
	cm ← GetModule[cmMap[i].cm]; EXIT};
      ENDLOOP;
    Storage.FreeWords[cmMap];
    END;

  SetLink: PROCEDURE [
    cm: ControlModule, frame: GlobalFrameHandle] RETURNS [ControlModule] = {
    t: ControlModule = frame.global[0];
    frame.global[0] ← cm;
    RETURN[IF t = ControlDefs.NullControl THEN [frame[frame]] ELSE t]};

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

  END...