-- BootLoader.mesa
-- Last Modified by Sandman,  October 7, 1980  9:04 AM    
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageCount, PageSize],
  BcdDefs USING [
    Base, BCD, CTIndex, CTNull, EPIndex, EVNull, Link, MTIndex, UnboundLink,
    VarLimit, VersionID],
  BcdOps USING [CTHandle, MTHandle, NameString, ProcessConfigs, ProcessModules],
  BootmesaOps,
  CacheOps USING [CopyWrite, READ, WRITE],
  ControlDefs USING [
    AV, ControlModule, EPRange, GFTIndex, GFTItem, GlobalFrame, GlobalFrameHandle,
    NullControl, NullGlobalFrame, ControlLink, NullLink, UnboundLink],
  FrameOps USING [MakeFsi],
  IODefs USING [
    CR, NumberFormat, SP, WriteChar, WriteNumber, WriteOctal, WriteString],
  LoaderOps USING [
    CloseLinkSpace, DestroyMap, FindCode, FindFiles, FileNotFound,
    FinalizeUtilities, InitializeMap, InitializeUtilities, OpenLinkSpace,
    WriteLink],
  LoadStateFormat USING [
    AltoVersionID, LoadState, LoadStateObject, ModuleInfo, NullModule],
  LoadStateOps USING [EnterModule, GetModule, Map],
  MiscDefs USING [Zero],
  SegmentDefs USING [
    Append, DefaultVersion, DeleteFileSegment, FileHandle, FileSegmentAddress,
    FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment, OldFileOnly,
    Read, SwapIn, SwapOut, Unlock, Write],
  SegOps USING [DefaultBase, NewSeg, Seg, CodeClass],
  StreamDefs USING [
    DisplayHandle, GetDefaultDisplayStream, NewByteStream, StreamHandle],
  String USING [AppendString],
  Storage USING [Words, FreeWords, PagesForWords];

BootLoader: PROGRAM
  IMPORTS
    CacheOps, BootmesaOps, FrameOps, SegOps, IODefs, BcdOps, MiscDefs, LoaderOps,
    LoadStateOps, SegmentDefs, StreamDefs, String, Storage
  EXPORTS BootmesaOps, LoadStateOps =
  PUBLIC
  
  BEGIN OPEN ControlDefs, SegOps, SegmentDefs, BcdDefs;
  
  data: POINTER TO BootmesaOps.BootData _ @BootmesaOps.dataObject;
  
  BcdBase: TYPE = POINTER TO BcdDefs.BCD;
  MTHandle: TYPE = BcdOps.MTHandle;
  Seg: TYPE = SegOps.Seg;
  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  ControlModule: TYPE = ControlDefs.ControlModule;
  GFTIndex: TYPE = ControlDefs.GFTIndex;
  
  loadee: BcdBase;
  lsseg, initlsseg, fakebcdseg: PUBLIC Seg;
  
  InitializeLoading: PUBLIC PROCEDURE [name: STRING] =
    BEGIN OPEN data, ControlDefs, SegmentDefs, SegOps;
    bcdseg: FileSegmentHandle _ LoadBcd[
      NewFile[name, Read, OldFileOnly] !
      InvalidBcd =>
	BEGIN OPEN IODefs;
	WriteString["Invalid file "L];
	WriteString[name];
	SIGNAL BootmesaOps.BootAbort;
	END];
    fakebcdseg _ NewSeg[bcdseg.file, bcdseg.base, bcdseg.pages];
    fakebcdseg.link2 _ bcdseg;
    fakebcdseg.resident _ FALSE;
    fakebcdseg.data _ FALSE;
    InitLoadStates[];
    loadee _ data.bcd _ FileSegmentAddress[bcdseg];
    LoaderOps.InitializeUtilities[data.bcd];
    SetupModuleTable[];
    LoaderOps.FindFiles[
      data.bcd !
      LoaderOps.FileNotFound =>
	BEGIN OPEN IODefs;
	WriteString["Cant find a code file "L];
	WriteString[name];
	SIGNAL BootmesaOps.BootAbort;
	END];
    RETURN
    END;
    
  InvalidBcd: SIGNAL [file: FileHandle] = CODE;
  
  LoadBcd: PROCEDURE [bcdfile: FileHandle] RETURNS [bcdseg: FileSegmentHandle] =
    BEGIN OPEN data, SegmentDefs;
    pages: AltoDefs.PageCount;
    bcd: BcdBase;
    bcdseg _ NewFileSegment[bcdfile, 1, 1, Read];
    BootmesaOps.MakeResident[bcdseg];
    bcd _ FileSegmentAddress[bcdseg];
    IF (pages _ bcd.nPages) # 1 THEN
      BEGIN
      Unlock[bcdseg];
      MoveFileSegment[bcdseg, 1, pages];
      BootmesaOps.MakeResident[bcdseg];
      bcd _ FileSegmentAddress[bcdseg];
      END;
    IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions THEN
      ERROR InvalidBcd[
	bcdfile ! UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg]; END];
    END;
    
  FinishLoading: PUBLIC PROCEDURE =
    BEGIN
    map: LoadStateOps.Map;
    map _ LoaderOps.InitializeMap[data.bcd];
    LoaderOps.FindCode[data.bcd, map];
    BootmesaOps.LookUpModules[];
    ClassifyCodeSegments[];
    AssignControlModules[];
    RelocateOnly[data.bcd, map];
    LoaderOps.FinalizeUtilities[];
    LoaderOps.DestroyMap[map];
    SegmentDefs.Unlock[lsseg.link2];
    SegmentDefs.SwapOut[lsseg.link2];
    END;
    
  RelocateOnly: PROCEDURE [bcd: BcdBase, map: LoadStateOps.Map] =
    BEGIN
    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN data, ControlDefs;
      i: CARDINAL;
      gfi: GFTIndex = mth.gfi;
      frame: GlobalFrameHandle _ moduleTable[gfi].frame;
      resolved: BOOLEAN _ TRUE;
      link: Link;
      info: LoadStateFormat.ModuleInfo;
      GetVariableLink: PROCEDURE [link: Link] RETURNS [ControlLink] =
	BEGIN
	ep: EPIndex;
	evb: Base _ LOOPHOLE[bcd + bcd.evOffset];
	gfi: GFTIndex _ link.vgfi;
	FindModule: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
	  BEGIN
	  IF gfi IN [mth.gfi..mth.gfi + mth.ngfi) THEN
	    BEGIN ep _ VarLimit*(gfi - mth.gfi); RETURN[TRUE] END;
	  RETURN[FALSE]
	  END;
	mth: MTHandle _ BcdOps.ProcessModules[bcd, FindModule].mth;
	f: GlobalFrameHandle _ moduleTable[gfi].frame;
	IF mth = NIL THEN RETURN[ControlDefs.NullLink];
	IF (ep _ ep + link.var) = 0 THEN RETURN[LOOPHOLE[f]];
	IF mth.variables = EVNull THEN RETURN[ControlDefs.NullLink];
	RETURN[LOOPHOLE[f + evb[mth.variables].offsets[ep]]];
	END;
      IF mth.frame.length # 0 THEN
	BEGIN
	LoaderOps.OpenLinkSpace[frame, mth];
	FOR i IN [0..mth.frame.length) DO
	  link _ mth.frame.frag[i];
	  SELECT link.vtag FROM
	    proc0, proc1 =>
	      IF link.gfi >= bcd.firstdummy THEN
		BEGIN
		resolved _ FALSE;
		LoaderOps.WriteLink[offset: i, link: ControlDefs.UnboundLink]
		END
	      ELSE LoaderOps.WriteLink[offset: i, link: ConvertLink[link]];
	    var =>
	      IF link.gfi >= bcd.firstdummy THEN
		BEGIN
		resolved _ FALSE;
		LoaderOps.WriteLink[offset: i, link: ControlDefs.NullLink]
		END
	      ELSE LoaderOps.WriteLink[offset: i, link: GetVariableLink[link]];
	    type => LoaderOps.WriteLink[offset: i, link: ConvertLink[link]]
	    ENDCASE;
	  ENDLOOP;
	LoaderOps.CloseLinkSpace[frame];
	END;
      FOR i IN [gfi..gfi + mth.ngfi) DO
	info _ LoadStateOps.GetModule[i];
	info.resolved _ resolved;
	LoadStateOps.EnterModule[i, info];
	ENDLOOP;
      RETURN[FALSE];
      END;
    [] _ BcdOps.ProcessModules[bcd, ModuleSearch];
    RETURN
    END;
    
  ConvertLink: PROCEDURE [bl: Link] RETURNS [cl: ControlLink] =
    BEGIN
    IF bl = BcdDefs.UnboundLink THEN RETURN[ControlDefs.UnboundLink];
    SELECT bl.vtag FROM
      proc0, proc1 => cl _ [procedure[gfi: bl.gfi, ep: bl.ep, tag: procedure]];
      var => cl _ [procedure[gfi: bl.vgfi, ep: bl.var, tag: frame]];
      type => cl _ LOOPHOLE[bl.typeID]
      ENDCASE;
    RETURN
    END;
    
  LoadModules: PUBLIC PROCEDURE [which: BootmesaOps.LoadClass] =
    BEGIN
    ssb: BcdOps.NameString _ LOOPHOLE[loadee + loadee.ssOffset];
    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN data, SegmentDefs;
      i: CARDINAL;
      frame: GlobalFrameHandle;
      framelinks: BOOLEAN;
      gf: GlobalFrame;
      IF moduleTable[mth.gfi].whenLoaded # which THEN RETURN[FALSE];
      framelinks _ mth.links = frame OR ~mth.code.linkspace;
      frame _ BootmesaOps.AllocGlobalFrame[
	mth.framesize, mth.frame.length, framelinks];
      SetGFTEntry[frame, mth.gfi, mth.ngfi];
      gf _
	[gfi: mth.gfi, unused: 0, copied: FALSE, alloced: FALSE, shared: FALSE,
	  started: FALSE, trapxfers: FALSE, codelinks: ~framelinks, global:,
	  code: [offset[offset: mth.code.offset, highHalf: NIL]]];
      gf.code.out _ TRUE;
      CacheOps.CopyWrite[from: @gf, to: frame, size: SIZE[GlobalFrame]];
      CacheOps.WRITE[@frame.global[0], ControlDefs.NullControl];
      FOR i IN [mth.gfi..mth.gfi + mth.ngfi) DO
	moduleTable[i].frame _ frame; ENDLOOP;
      IF Loadmap # NIL THEN
	BEGIN OPEN IODefs;
	WriteString["New: g = "L];
	WriteNumber[frame, NumberFormat[8, FALSE, TRUE, 6]];
	WriteChar[SP];
	FOR i IN [mth.name..mth.name + ssb.size[mth.name]) DO
	  WriteChar[ssb.string.text[i]]; ENDLOOP;
	WriteChar[SP];
	WriteChar['[];
	WriteOctal[ControlLink[procedure[gfi: mth.gfi, ep: 0, tag: frame]]];
	WriteChar[']];
	WriteChar[CR];
	END;
      RETURN[FALSE];
      END;
    [] _ BcdOps.ProcessModules[loadee, ModuleSearch];
    END;
    
  ClassifyCodeSegments: PUBLIC PROCEDURE =
    BEGIN
    class: SegOps.CodeClass;
    MungeFrame: PROCEDURE [gfi: GFTIndex] RETURNS [BOOLEAN] =
      BEGIN
      i: CARDINAL;
      segState: SegOps.CodeClass;
      FOR i IN [gfi..gfi + data.moduleTable[gfi].mth.ngfi) DO
	IF (segState _ data.moduleTable[i].code.class) < class THEN
	  data.moduleTable[i].class _ segState
	ELSE data.moduleTable[i].class _ data.moduleTable[i].code.class _ class;
	ENDLOOP;
      RETURN[FALSE];
      END;
    class _ resident;
    [] _ BootmesaOps.EnumerateResidentModules[MungeFrame];
    class _ in;
    [] _ BootmesaOps.EnumerateSwappedInModules[MungeFrame];
    RETURN
    END;
    
  SetupModuleTable: PROCEDURE =
    BEGIN
    mt: DESCRIPTOR FOR ARRAY OF BootmesaOps.ModuleInfo;
    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      i: CARDINAL;
      FOR i IN [mth.gfi..mth.gfi + mth.ngfi) DO
	mt[i] _ [mth, NIL, NIL, other, FALSE, resident]; ENDLOOP;
      RETURN[FALSE];
      END;
    mt _ data.moduleTable _ DESCRIPTOR[
      Storage.Words[loadee.firstdummy*SIZE[BootmesaOps.ModuleInfo]],
	loadee.firstdummy];
    mt[0] _ [NIL, NIL, NIL, other, FALSE, notLoaded];
    [] _ BcdOps.ProcessModules[loadee, ModuleSearch];
    RETURN
    END;
    
  CMMapItem: TYPE = RECORD [cti: CTIndex, cm: ControlModule, level: CARDINAL];

  AssignControlModules: PROCEDURE =
    BEGIN OPEN BcdOps, data, ControlDefs;
    ctb: Base _ LOOPHOLE[loadee+loadee.ctOffset];
    mtb: Base _ LOOPHOLE[loadee+loadee.mtOffset];
    mt: DESCRIPTOR FOR ARRAY OF BootmesaOps.ModuleInfo = moduleTable;
    mapIndex, maxLevel: CARDINAL _ 0;
    cti: CTIndex;
    i: CARDINAL;
    cmMap: POINTER TO ARRAY [0..0) OF CMMapItem;
    cm: ControlModule;
    MapControls: PROCEDURE [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs;
      cm: ControlModule;
      c: CTIndex;
      level: CARDINAL _ 0;
      IF cth.nControls = 0 THEN cm _ NullControl
      ELSE {
	cm.list _ Alloc[FrameOps.MakeFsi[cth.nControls + 1 + 1]];
	CacheOps.WRITE[@cm.list.nModules, cth.nControls + 1];
	FOR i: CARDINAL IN [0..cth.nControls) DO
	  CacheOps.WRITE[
	    @cm.list.frames[i+1], mt[mtb[cth.controls[i]].gfi].frame];
	  ENDLOOP;
	FOR c _ ctb[cti].config, ctb[c].config UNTIL c = CTNull DO
	  level _ level + 1; ENDLOOP;
	cm.multiple _ TRUE};
      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 _ mt[mth.gfi].frame;
      IF mth.config # cti THEN RETURN[FALSE];
      IF CacheOps.READ[@frame.global[0]] = NullControl THEN
	CacheOps.WRITE[@frame.global[0], GetLink[cm]];
      RETURN [FALSE];
      END;
    IF bcd.nModules = 1 THEN
      BEGIN
      frame: GlobalFrameHandle _ mt[1].frame;
      CacheOps.WRITE[@frame.global[0], NullControl];
      RETURN
      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, listHead: ControlModule;
	IF cmMap[index].level # level OR (cm _ cmMap[index].cm) = NullControl THEN LOOP;
	list _ cm;
	list.multiple _ FALSE;
	cti _ cmMap[index].cti;
	listHead _ SetLink[cm, CacheOps.READ[@list.list.frames[1]]];
	CacheOps.WRITE[@list.list.frames[1], listHead];
	FOR i: CARDINAL IN [2..ctb[cti].nControls+1) DO
	  CacheOps.WRITE[
	    @list.list.frames[i],
	    SetLink[GetLink[listHead], CacheOps.READ[@list.list.frames[i]]]];
	  ENDLOOP;
        [] _ 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 _ GetLink[cmMap[parent].cm]};
      CacheOps.WRITE[@list.list.frames[0], cm];
      ENDLOOP;
    FOR i IN [0..mapIndex) DO
      IF ctb[cmMap[i].cti].config = CTNull THEN {
	cm _ GetLink[cmMap[i].cm]; EXIT};
      ENDLOOP;
    Storage.FreeWords[cmMap];
    END;

  Alloc: PROCEDURE [index: CARDINAL] RETURNS [p: POINTER] =
    BEGIN
    DO
      p _  CacheOps.READ[ControlDefs.AV+index];
      IF LOOPHOLE[p, CARDINAL] MOD 4 = 0 THEN EXIT;
      index _ LOOPHOLE[p, CARDINAL]/4;
      ENDLOOP;
    CacheOps.WRITE[ControlDefs.AV+index, CacheOps.READ[p]];
    RETURN
    END;

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

  GetLink: PROCEDURE [cm: ControlModule] RETURNS [ControlModule] = {
    list: ControlModule;
    DO
      IF ~cm.multiple THEN RETURN[cm];
      list _ cm;
      list.multiple _ FALSE;
      cm _ CacheOps.READ[@list.list.frames[1]];
      ENDLOOP};

  loadstate: LoadStateFormat.LoadState;
  
  InitLoadStates: PROCEDURE =
    BEGIN OPEN data, SegmentDefs, SegOps, LoadStateFormat;
    seg: FileSegmentHandle;
    pages, i: CARDINAL;
    swatee: FileHandle;
    pages _ Storage.PagesForWords[
      SIZE[LoadStateObject] + LENGTH[gft]*SIZE[ModuleInfo]];
    swatee _ SegmentDefs.NewFile["swatee", Read + Write + Append, DefaultVersion];
    lsseg _ NewSeg[swatee, DefaultBase, pages, TRUE];
    initlsseg _ NewSeg[swatee, lsseg.base + pages, pages, TRUE];
    lsseg.data _ initlsseg.data _ FALSE;
    seg _ lsseg.link2 _ NewFileSegment[swatee, DefaultBase, pages, Read + Write];
    SwapIn[seg];
    loadstate _ FileSegmentAddress[seg];
    MiscDefs.Zero[loadstate, pages*AltoDefs.PageSize];
    loadstate.versionident _ AltoVersionID;
    loadstate.nBcds _ 1;
    FOR i IN [0..LENGTH[gft]) DO loadstate.gft[i] _ NullModule; ENDLOOP;
    RETURN
    END;
    
  EnterModule: PROCEDURE [rgfi: GFTIndex, module: LoadStateFormat.ModuleInfo] =
    BEGIN loadstate.gft[rgfi] _ module; RETURN END;
    
  GetModule: PROCEDURE [rgfi: GFTIndex]
    RETURNS [module: LoadStateFormat.ModuleInfo] =
    BEGIN RETURN[loadstate.gft[rgfi]]; END;
    
  -- global frame table management
  
  gft: PRIVATE DESCRIPTOR FOR ARRAY OF GFTItem;
  
  InitializeGFT: PROCEDURE [p: POINTER, l: CARDINAL] =
    BEGIN gft _ DESCRIPTOR[p, l]; RETURN END;
    
  EnumerateGlobalFrames: PROCEDURE [
    proc: PROCEDURE [GlobalFrameHandle] RETURNS [BOOLEAN]]
    RETURNS [GlobalFrameHandle] =
    BEGIN
    i: GFTIndex;
    frame: GlobalFrameHandle;
    FOR i IN [1..LENGTH[gft]) DO
      frame _ CacheOps.READ[@gft[i].frame];
      IF frame # NullGlobalFrame AND CacheOps.READ[@gft[i].epbase] = 0 AND proc[
	frame] THEN RETURN[frame];
      ENDLOOP;
    RETURN[NullGlobalFrame]
    END;
    
  gftrover: PRIVATE CARDINAL _ 0;
  
  SetGFTEntry: PROCEDURE [
    frame: GlobalFrameHandle, gfi: GFTIndex, ngfi: CARDINAL] =
    BEGIN
    i, epoffset: CARDINAL;
    IF gfi + ngfi >= LENGTH[gft] THEN BootmesaOps.BootmesaError["GFT Full"L];
    epoffset _ 0;
    FOR i IN [gfi..gfi + ngfi) DO
      LoadStateOps.EnterModule[
	rgfi: i, module: [resolved: FALSE, config: 0, gfi: i]];
      CacheOps.WRITE[@gft[i].frame, frame];
      CacheOps.WRITE[@gft[i].epbase, epoffset];
      epoffset _ epoffset + EPRange;
      ENDLOOP;
    RETURN
    END;
    
  -- loadmap management
  
  Loadmap: PRIVATE StreamDefs.StreamHandle _ NIL;
  
  DisplayChar: PRIVATE PROCEDURE [StreamDefs.StreamHandle, CHARACTER];
  
  OpenLoadmap: PROCEDURE [root: STRING] =
    BEGIN OPEN String;
    default: StreamDefs.DisplayHandle _ StreamDefs.GetDefaultDisplayStream[];
    name: STRING _ [40];
    AppendString[name, root];
    AppendString[name, ".Loadmap"L];
    Loadmap _ StreamDefs.NewByteStream[name, Write + Append];
    DisplayChar _ default.put;
    default.put _ LMput;
    RETURN
    END;
    
  CloseLoadmap: PROCEDURE =
    BEGIN
    default: StreamDefs.DisplayHandle _ StreamDefs.GetDefaultDisplayStream[];
    IF default.put # LMput THEN ERROR;
    default.put _ DisplayChar;
    Loadmap.destroy[Loadmap];
    RETURN
    END;
    
  LMput: PRIVATE PROCEDURE [s: StreamDefs.StreamHandle, c: CHARACTER] =
    BEGIN DisplayChar[s, c]; Loadmap.put[Loadmap, c]; RETURN END;
    
  
  END....