-- AltoLoader.mesa Modified by Sandman,  August 1, 1980  10:21 AM 
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoFileDefs USING [FP],
  BcdDefs USING [FTIndex, FTNull, FTSelf, MTIndex, SGIndex, VersionID],
  BcdOps USING [
    BcdBase, MTHandle, NameString, ProcessModules, ProcessSegs, SGHandle],
  ControlDefs USING [
    ControlModule, ControlLink, FrameCodeBase, GFT, GFTIndex, GFTItem,
    GlobalFrameHandle, LastAVSlot, MaxNGfi, NullControl, NullGlobalFrame],
  DirectoryDefs USING [EnumerateDirectory],
  FrameDefs USING [EnterGlobalFrame, EnumerateGlobalFrames],
  FrameOps USING [Alloc, CodeHandle, FrameSize, Free, Start],
  InlineDefs USING [BITAND],
  LoaderOps USING [Binding, BindLink, Load, New],
  LoadStateOps USING [Map],
  Mopcodes USING [zRBL, zWBL],
  SegmentDefs USING [
    DataSegmentAddress, DataSegmentHandle, DefaultMDSBase, DeleteFileSegment,
    EnumerateFileSegments, FileHandle, FileSegmentAddress, FileSegmentHandle,
    FrameDS, HardDown, InsertFile, MakeDataSegment, MoveFileSegment, NewFile,
    NewFileSegment, OldFileOnly, OpenFile, Read, ReleaseFile, SwapIn, SwapUp,
    Unlock, VMtoFileSegment],
  StringDefs USING [
    AppendString, AppendSubString, EquivalentSubStrings, SubString,
    SubStringDescriptor],
  Storage USING [Node, Free, FreePages, PagesForWords],
  Table USING [Base];

AltoLoader: PROGRAM
  IMPORTS
    DirectoryDefs, FrameDefs, FrameOps, BcdOps, InlineDefs, LoaderOps,
    SegmentDefs, StringDefs, Storage
  EXPORTS LoaderOps, FrameDefs =PUBLIC

  BEGIN OPEN BcdOps, BcdDefs, ControlDefs;

  Binding: PRIVATE TYPE = LoaderOps.Binding;
  Map: PRIVATE TYPE = LoadStateOps.Map;
  SubStringDescriptor: PRIVATE TYPE = StringDefs.SubStringDescriptor;
  SubString: PRIVATE TYPE = StringDefs.SubString;

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

  Load: PUBLIC PROCEDURE [name: STRING] RETURNS [bcd: BcdBase] =
    BEGIN OPEN SegmentDefs;
    file: FileHandle _ NewFile[name, Read, OldFileOnly];
    pages: CARDINAL;
    bcdseg: FileSegmentHandle _ NewFileSegment[file, 1, 1, Read];
    SwapIn[bcdseg];
    bcd _ FileSegmentAddress[bcdseg];
    pages _ bcd.nPages;
    IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions THEN
      ERROR InvalidFile[
	name ! UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END];
    IF pages > 1 THEN
      BEGIN
      Unlock[bcdseg];
      MoveFileSegment[bcdseg, 1, pages];
      SwapIn[bcdseg];
      bcd _ FileSegmentAddress[bcdseg];
      END;
    RETURN
    END;

  LoadConfig: PUBLIC PROCEDURE [name: STRING] RETURNS [PROGRAM] =
    BEGIN
    cm: ControlModule _ LoaderOps.New[LoaderOps.Load[name], TRUE, FALSE];
    RETURN[LOOPHOLE[cm]]
    END;

  NewConfig: PUBLIC PROCEDURE [name: STRING] =
    BEGIN [] _ LoaderOps.New[LoaderOps.Load[name], TRUE, FALSE]; RETURN END;

  RunConfig: PUBLIC PROCEDURE [name: STRING] =
    BEGIN
    cm: ControlDefs.ControlModule _ LoaderOps.New[
      LoaderOps.Load[name], TRUE, FALSE];
    IF cm # NullControl THEN FrameOps.Start[cm];
    RETURN
    END;

  FileItem: TYPE = POINTER TO FileObject;

  FileObject: TYPE = RECORD [
    fti: FTIndex, ext: BOOLEAN, handle: SegmentDefs.FileHandle, link: FileItem];

  files: FileItem _ NIL;
  loadee: BcdBase;
  ssb: NameString;
  ftb: Table.Base;
  nfilestofind: CARDINAL _ 0;
  tableopen: BOOLEAN _ FALSE;

  FindFiles: PUBLIC PROCEDURE [bcd: BcdBase] =
    BEGIN EnterCodeFileNames[loadee]; LookupFileTable[]; END;

  EnterCodeFileNames: PROCEDURE [bcd: BcdBase] =
    BEGIN

    SegSearch: PROCEDURE [sgh: SGHandle, sgi: SGIndex] RETURNS [BOOLEAN] =
      BEGIN IF sgh.class = code THEN AddFileName[sgh.file]; RETURN[FALSE]; END;

      [] _ BcdOps.ProcessSegs[bcd, SegSearch];
    RETURN;
    END;

  AddFileName: PROCEDURE [file: FTIndex] =
    BEGIN
    p: FileItem;
    i, offset, length: CARDINAL;
    FOR p _ files, p.link UNTIL p = NIL DO IF file = p.fti THEN RETURN; ENDLOOP;
    p _ Storage.Node[SIZE[FileObject]];
    p^ _ [fti: file, handle: NIL, ext: FALSE, link: files];
    files _ p;
    IF file = FTSelf THEN
      BEGIN p.handle _ SegmentDefs.VMtoFileSegment[loadee].file; RETURN END;
    IF file = FTNull THEN BEGIN p.handle _ NIL; RETURN END;
    offset _ ftb[file].name;
    length _ ssb.size[ftb[file].name];
    FOR i IN [offset..offset + length) DO
      IF ssb.string.text[i] = '. THEN BEGIN p.ext _ TRUE; EXIT END; ENDLOOP;
    nfilestofind _ nfilestofind + 1;
    RETURN;
    END;

  FindFileName: PROCEDURE [name: SubString, ext: BOOLEAN]
    RETURNS [found: BOOLEAN, item: FileItem] =
    BEGIN
    file: SubStringDescriptor _ [base: @ssb.string, offset:, length:];
    FOR item _ files, item.link UNTIL item = NIL DO
      file.offset _ ftb[item.fti].name;
      file.length _ ssb.size[ftb[item.fti].name];
      IF LastCharIsDot[@file] THEN name.length _ name.length + 1;
      IF ext = item.ext AND StringDefs.EquivalentSubStrings[@file, name] THEN
	RETURN[TRUE, item];
      ENDLOOP;
    RETURN[FALSE, NIL];
    END;

  LastCharIsDot: PROCEDURE [name: SubString] RETURNS [BOOLEAN] =
    BEGIN RETURN[name.base[name.offset + name.length - 1] = '.]; END;

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

  LookupFileTable: PROCEDURE =
    BEGIN
    p: FileItem;
    ssd: StringDefs.SubStringDescriptor;
    name: STRING _ [40];
    IF nfilestofind # 0 THEN DirectoryDefs.EnumerateDirectory[CheckOne];
    FOR p _ files, p.link UNTIL p = NIL DO
      IF p.handle = NIL AND p.fti # FTNull THEN
	BEGIN
	ssd _
	  [base: @ssb.string, offset: ftb[p.fti].name,
	    length: ssb.size[ftb[p.fti].name]];
	name.length _ 0;
	StringDefs.AppendSubString[name, @ssd];
	IF p.ext THEN StringDefs.AppendString[name, ".bcd"L];
	SIGNAL FileNotFound[name];
	END;
      ENDLOOP;
    END;

  CheckOne: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, name: STRING]
    RETURNS [found: BOOLEAN] =
    BEGIN
    i: CARDINAL;
    dirName: SubStringDescriptor;
    bcd: SubStringDescriptor _ [base: "bcd"L, offset: 0, length: 3];
    item: FileItem;
    FOR i IN [0..name.length) DO
      IF name[i] = '. THEN
	BEGIN
	IF name.length - i # 5 THEN GOTO UseWholeName;
	dirName _ [base: name, offset: i + 1, length: 3];
	IF ~StringDefs.EquivalentSubStrings[@dirName, @bcd] THEN
	  GOTO UseWholeName;
	dirName.offset _ 0;
	dirName.length _ i;
	GOTO HasBCDExtension;
	END;
      REPEAT
	UseWholeName => NULL;
	HasBCDExtension =>
	  BEGIN
	  [found, item] _ FindFileName[@dirName, FALSE];
	  IF found THEN RETURN[ThisIsTheOne[fp, item]];
	  END;
      ENDLOOP;
    dirName _ [base: name, offset: 0, length: name.length - 1];
    -- ignore dot on end
    [found, item] _ FindFileName[@dirName, TRUE];
    RETURN[IF found THEN ThisIsTheOne[fp, item] ELSE FALSE];
    END;

  ThisIsTheOne: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, item: FileItem]
    RETURNS [BOOLEAN] =
    BEGIN
    item.handle _ SegmentDefs.InsertFile[fp, SegmentDefs.Read];
    nfilestofind _ nfilestofind - 1;
    RETURN[nfilestofind = 0];
    END;

  FileHandleFromTable: PROCEDURE [fti: FTIndex]
    RETURNS [file: SegmentDefs.FileHandle] =
    BEGIN
    p: FileItem;
    FOR p _ files, p.link UNTIL p = NIL DO
      IF p.fti = fti THEN RETURN[p.handle]; ENDLOOP;
    RETURN[NIL];
    END;

  -- Frame allocation/deallocation


  AllocateFrames: PUBLIC PROCEDURE [bcd: BcdBase, alloc, framelinks: BOOLEAN]
    RETURNS [POINTER] =
    BEGIN OPEN SegmentDefs;
    seg: DataSegmentHandle;
    IF bcd.nModules = 1 THEN RETURN[AllocateSingleModule[bcd, framelinks]];
    seg _ MakeDataSegment[
      base: DefaultMDSBase, pages: RequiredFrameSpace[bcd, alloc, framelinks],
      info: HardDown];
    seg.type _ FrameDS;
    RETURN[DataSegmentAddress[seg]];
    END;

  AllocateSingleModule: PROCEDURE [bcd: BcdBase, framelinks: BOOLEAN]
    RETURNS [frame: POINTER] =
    BEGIN
    size: CARDINAL _ 0;
    i: CARDINAL;
    mth: MTHandle _ @LOOPHOLE[loadee + loadee.mtOffset, Table.Base][
      FIRST[MTIndex]];
    framelinks _ framelinks OR mth.links = frame OR ~mth.code.linkspace;
    IF framelinks THEN size _ mth.frame.length;
    size _ NextMultipleOfFour[size] + mth.framesize;
    FOR i IN [0..ControlDefs.LastAVSlot] DO
      IF FrameOps.FrameSize[i] >= size THEN BEGIN size _ i; EXIT END; ENDLOOP;
    frame _ FrameOps.Alloc[size];
    IF framelinks THEN frame _ NextMultipleOfFour[frame + mth.frame.length];
    RETURN[frame];
    END;

  NextMultipleOfFour: PROCEDURE [x: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    BEGIN RETURN[x + InlineDefs.BITAND[-x, 3B]]; END;

  RequiredFrameSpace: PROCEDURE [bcd: BcdBase, alloc, framelinks: BOOLEAN]
    RETURNS [space: CARDINAL] =
    BEGIN

    FrameSize: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      IF alloc THEN space _ NextMultipleOfFour[space + 1];
      IF framelinks OR mth.links = frame OR ~mth.code.linkspace THEN
	space _ space + mth.frame.length;
      space _ NextMultipleOfFour[space] + mth.framesize;
      IF alloc AND ~framelinks AND mth.links = code AND mth.code.linkspace AND
	mth.framesize <= 4 THEN space _ space + 3; -- this tries
      -- to catch the case where a frame is alloced and framesize <= 4 so
      -- it makes it so that enough space is counted so that a small frame
      -- will fit.
      RETURN[FALSE];
      END;

    space _ 0;
    [] _ BcdOps.ProcessModules[bcd, FrameSize];
    RETURN[Storage.PagesForWords[space]];
    END;

  FindFrameIndex: PUBLIC PROCEDURE [mth: MTHandle, framelinks: BOOLEAN]
    RETURNS [fsi: CARDINAL] =
    BEGIN
    space: CARDINAL _ 0;
    IF framelinks THEN space _ mth.frame.length;
    space _ NextMultipleOfFour[space] + mth.framesize;
    FOR fsi DECREASING IN [0..ControlDefs.LastAVSlot] DO
      IF space >= FrameOps.FrameSize[fsi] THEN RETURN[fsi]; ENDLOOP;
    RETURN[0]; -- see RequiredFrameSpace for alloced modules w/ framesize<7

    END;

  GetGfi: PUBLIC PROCEDURE [frame: GlobalFrameHandle, ngfi: [1..MaxNGfi]]
    RETURNS [gfi: GFTIndex] =
    BEGIN RETURN[FrameDefs.EnterGlobalFrame[frame, ngfi]]; END;

  ReleaseFrames: PUBLIC PROCEDURE [
    bcd: BcdBase, frames: POINTER, map: LoadStateOps.Map] =
    BEGIN
    i: CARDINAL;
    mtb: Table.Base = LOOPHOLE[bcd + bcd.mtOffset];
    IF frames = NIL THEN RETURN;
    IF bcd.nModules = 1 THEN
      BEGIN

      Align: PROCEDURE [POINTER, WORD] RETURNS [POINTER] =
	LOOPHOLE[InlineDefs.BITAND];
      FrameOps.Free[Align[frames - mtb[FIRST[MTIndex]].frame.length, 177774B]]
      END
    ELSE Storage.FreePages[frames];
    FOR i IN [0..LENGTH[map]) DO
      OPEN ControlDefs;
      GFT[map[i]] _ GFTItem[frame: NullGlobalFrame, epbase: 0];
      ENDLOOP;
    END;

  -- Code management


  FindCode: PUBLIC PROCEDURE [bcd: BcdBase, map: Map] =
    BEGIN

    GetCode: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN

      FindShared: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
	BEGIN
	IF f # frame AND f.code.handle = frame.code.handle THEN
	  f.shared _ frame.shared _ TRUE;
	RETURN[FALSE];
	END;

      frame: GlobalFrameHandle = ControlDefs.GFT[map[mth.gfi]].frame;
      IF ~mth.altoCode THEN InvalidModule[bcd, mth];
      frame.code.handle _ FindCodeSegment[bcd, mth, frame];
      frame.code.offset _ mth.code.offset;
      frame.code.out _ TRUE;
      [] _ FrameDefs.EnumerateGlobalFrames[FindShared];
      RETURN[FALSE];
      END;

      [] _ BcdOps.ProcessModules[bcd, GetCode];
    RETURN
    END;

  FindCodeSegment: PUBLIC PROCEDURE [
    bcd: BcdBase, mth: MTHandle, frame: GlobalFrameHandle]
    RETURNS [seg: SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    sgh: SGHandle _ @LOOPHOLE[bcd + bcd.sgOffset, Table.Base][mth.code.sgi];
    file: FileHandle;
    pages: CARDINAL;

    FindSegment: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN RETURN[s.file = file AND s.base = sgh.base AND s.pages = pages]; END;

    file _ FileHandleFromTable[sgh.file];
    OpenFile[file];
    pages _ sgh.pages + sgh.extraPages;
    seg _ EnumerateFileSegments[FindSegment];
    IF seg = NIL THEN seg _ NewFileSegment[file, sgh.base, pages, Read];
    seg.class _ code;
    RETURN
    END;

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

  InvalidModule: PROCEDURE [bcd: BcdBase, mth: MTHandle] =
    BEGIN OPEN SegmentDefs;
    name: STRING _ [40];
    ssd: StringDefs.SubStringDescriptor _
      [base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]];
    StringDefs.AppendSubString[name, @ssd];
    SIGNAL BadCode[name];
    END;

  -- Binding and Map management


  InitBinding: PUBLIC PROCEDURE [bcd: BcdBase] RETURNS [binding: Binding] =
    BEGIN
    i: CARDINAL;
    p: POINTER _ Storage.Node[bcd.nDummies*SIZE[LoaderOps.BindLink]];
    binding _ DESCRIPTOR[
      p - CARDINAL[bcd.firstdummy*SIZE[LoaderOps.BindLink]], bcd.nDummies];
    FOR i IN [bcd.firstdummy..bcd.firstdummy + bcd.nDummies) DO
      binding[i] _ [whichgfi: 0, body: notbound[]]; ENDLOOP;
    END;

  ReleaseBinding: PUBLIC PROCEDURE [bcd: BcdBase, binding: Binding]
    RETURNS [Binding] =
    BEGIN
    IF BASE[binding] # NIL THEN
      Storage.Free[BASE[binding] + bcd.firstdummy*SIZE[LoaderOps.BindLink]];
    RETURN[DESCRIPTOR[NIL, 0]];
    END;

  InitializeMap: PUBLIC PROCEDURE [bcd: BcdBase] RETURNS [map: LoadStateOps.Map] =
    BEGIN
    i: CARDINAL;
    map _ DESCRIPTOR[Storage.Node[bcd.firstdummy], bcd.firstdummy];
    FOR i IN [0..bcd.firstdummy) DO map[i] _ 0; ENDLOOP;
    END;

  DestroyMap: PUBLIC PROCEDURE [map: LoadStateOps.Map] =
    BEGIN IF BASE[map] # NIL THEN Storage.Free[BASE[map]]; END;

  -- Link management

  ls: POINTER TO ControlDefs.ControlLink;
  lls: LONG POINTER TO ControlDefs.ControlLink;
  dirty, long: BOOLEAN;

  OpenLinkSpace: PROCEDURE [frame: GlobalFrameHandle, mth: MTHandle] =
    BEGIN OPEN SegmentDefs;
    IF frame.codelinks THEN
      BEGIN
      fcb: ControlDefs.FrameCodeBase _ frame.code;
      seg: FileSegmentHandle _ FrameOps.CodeHandle[frame];
      fcb.out _ FALSE;
      IF seg # NIL THEN SwapIn[seg];
      IF (long _ frame.code.highByte = 0) THEN lls _ fcb.longbase
      ELSE ls _ FileSegmentAddress[frame.code.handle] + mth.code.offset;
      END
    ELSE BEGIN long _ FALSE; ls _ LOOPHOLE[frame] END;
    IF long THEN lls _ lls - mth.frame.length ELSE ls _ ls - mth.frame.length;
    dirty _ FALSE;
    END;

  WriteLink: PROCEDURE [offset: CARDINAL, link: ControlDefs.ControlLink] =
    BEGIN
    dirty _ TRUE;
    IF long THEN WriteLongControlLink[link, lls + offset]
    ELSE (ls + offset)^ _ link;
    END;

  WriteLongControlLink: PROCEDURE [ControlLink, LONG POINTER] = MACHINE CODE
    BEGIN Mopcodes.zWBL, 0 END;

  ReadLongControlLink: PROCEDURE [LONG POINTER] RETURNS [ControlLink] = MACHINE
    CODE BEGIN Mopcodes.zRBL, 0 END;

  ReadLink: PROCEDURE [offset: CARDINAL] RETURNS [link: ControlDefs.ControlLink] =
    BEGIN
    RETURN[IF long THEN ReadLongControlLink[lls + offset] ELSE (ls + offset)^];
    END;

  CloseLinkSpace: PROCEDURE [frame: GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs;
    seg: FileSegmentHandle _ FrameOps.CodeHandle[frame];
    IF frame.codelinks AND seg # NIL THEN
      BEGIN
      Unlock[seg];
      IF dirty THEN BEGIN seg.write _ TRUE; SwapUp[seg]; seg.write _ FALSE; END;
      END;
    END;

  FinalizeUtilities: PUBLIC PROCEDURE =
    BEGIN
    f: FileItem;
    FOR f _ files, files UNTIL f = NIL DO
      files _ f.link;
      IF f.handle.segcount = 0 THEN SegmentDefs.ReleaseFile[f.handle];
      Storage.Free[f];
      ENDLOOP;
    tableopen _ FALSE;
    END;

  InitializeUtilities: PUBLIC PROCEDURE [bcd: BcdBase] =
    BEGIN
    loadee _ bcd;
    ssb _ LOOPHOLE[loadee + loadee.ssOffset];
    ftb _ LOOPHOLE[loadee + loadee.ftOffset];
    IF tableopen THEN FinalizeUtilities[];
    tableopen _ TRUE;
    END;


  END....