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