-- LoaderUtilities.mesa
-- Last Modified by Levin,  August 29, 1978  8:38 AM 

DIRECTORY
  AltoFileDefs: FROM "altofiledefs" USING [FP],
  BcdDefs: FROM "bcddefs" USING [
    CTHandle, CTIndex, CTNull, FTIndex, FTNull, FTSelf, MTHandle, MTIndex,
    MTNull, NameString, SGHandle, SGIndex],
  CodeDefs: FROM "codedefs" USING [CodeHandle],
  ControlDefs: FROM "controldefs" USING [
    Alloc, GFT, GFTIndex, GFTNull, GlobalFrameHandle, MaxAllocSlot,
    NullGlobalFrame],
  DirectoryDefs: FROM "directorydefs" USING [EnumerateDirectory],
  FrameDefs: FROM "framedefs" USING [FrameSize],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  LoaderBcdUtilDefs: FROM "loaderbcdutildefs" USING [
    EnumerateConfigTable, EnumerateModuleTable, EnumerateSegTable],
  LoaderDefs: FROM "loaderdefs",
  LoaderUtilityDefs: FROM "loaderutilitydefs" USING [
    BcdBase, Binding, FileHandle, FileSegmentHandle, FileTable,
    FileTableObject, GlobalFrameHandle, ImportBindingLink, Relocation],
  SegmentDefs: FROM "segmentdefs" USING [
    EnumerateFileSegments, FileHandle, FileSegmentHandle, InsertFile,
    NewFileSegment, Read, ReleaseFile, VMtoFileSegment],
  StringDefs: FROM "stringdefs" USING [
    AppendString, AppendSubString, EquivalentSubStrings, SubString,
    SubStringDescriptor],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode];

DEFINITIONS FROM BcdDefs, LoaderUtilityDefs;

LoaderUtilities: PROGRAM
  IMPORTS DirectoryDefs, FrameDefs, LoaderBcdUtilDefs,
    CodeDefs, SegmentDefs, StringDefs, SystemDefs
  EXPORTS LoaderUtilityDefs = PUBLIC

  BEGIN

  files: FileTable _ NIL;
  loadee: BcdBase;
  ssb: BcdDefs.NameString;
  ftb: CARDINAL;
  nfilestofind: CARDINAL _ 0;
  tableopen: BOOLEAN _ FALSE;

  SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor;

  AddFileName: PUBLIC PROCEDURE [file: BcdDefs.FTIndex] =
    BEGIN
    p: FileTable;
    i, offset, length: CARDINAL;
    FOR p _ files, p.link UNTIL p = NIL DO
      IF file = p.file THEN RETURN;
      ENDLOOP;
    p _ SystemDefs.AllocateHeapNode[SIZE[FileTableObject]];
    p^ _ [file: file, filehandle: NIL, ext: FALSE, link: files];
    files _ p;
    IF file = BcdDefs.FTSelf THEN
      BEGIN
      p.filehandle _ SegmentDefs.VMtoFileSegment[loadee].file;
      RETURN
      END;
    IF file = BcdDefs.FTNull THEN BEGIN  p.filehandle _ 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: PUBLIC PROCEDURE [name: StringDefs.SubString, ext: BOOLEAN]
   RETURNS [found: BOOLEAN, file: FileTable] =
    BEGIN OPEN StringDefs;
    filename: SubStringDescriptor _ [base: @ssb.string, offset:, length:];
    FOR file _ files, file.link UNTIL file = NIL DO
      filename.offset _ (ftb+file.file).name;
      filename.length _ ssb.size[(ftb+file.file).name];
      IF LastCharIsDot[@filename] THEN name.length _ name.length + 1;
      IF ext = file.ext AND EquivalentSubStrings[@filename, name] THEN
        RETURN[TRUE, file];
      ENDLOOP;
    RETURN[FALSE, NIL];
    END;

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

  FileNotFound: PUBLIC SIGNAL [name: STRING] RETURNS [file: FileHandle] = CODE;

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

  CheckOne: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, name: STRING]
   RETURNS [found: BOOLEAN] =
    BEGIN OPEN StringDefs;
    i: CARDINAL;
    dirName: SubStringDescriptor;
    bcd: SubStringDescriptor _ [base: "bcd"L, offset: 0, length: 3];
    file: LoaderUtilityDefs.FileTable;
    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 ~EquivalentSubStrings[@dirName, @bcd] THEN GOTO UseWholeName;
        dirName.offset _ 0;  dirName.length _ i;
        GOTO HasBCDExtension;
        END;
      REPEAT
        UseWholeName => NULL;
        HasBCDExtension =>
          BEGIN
          [found, file] _ FindFileName[@dirName, FALSE];
          IF found THEN RETURN [ThisIsTheOne[fp, file]];
          END;
      ENDLOOP;
    dirName _ [base: name, offset: 0, length: name.length-1]; -- ignore dot on end
    [found, file] _ FindFileName[@dirName, TRUE];
    RETURN [IF found THEN ThisIsTheOne[fp, file] ELSE FALSE];
    END;

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

  FileHandleFromTable: PUBLIC PROCEDURE [filename: BcdDefs.FTIndex]
   RETURNS [file: SegmentDefs.FileHandle] =
    BEGIN
    p: FileTable;
    FOR p _ files, p.link UNTIL p = NIL DO
      IF p.file = filename THEN
        RETURN[p.filehandle];
      ENDLOOP;
    RETURN[NIL];
    END;

  FinalizeUtilities: PUBLIC PROCEDURE =
    BEGIN
    p: FileTable;
    FOR files _ files, p UNTIL files = NIL DO
      p _ files.link;
      IF files.file # NIL AND files.filehandle.segcount = 0 THEN
        SegmentDefs.ReleaseFile[files.filehandle];
      SystemDefs.FreeHeapNode[files];
      ENDLOOP;
    tableopen _ FALSE;
    SystemDefs.FreeHeapNode[BASE[ModuleTable]];
    END;

  InitializeUtilities: PUBLIC PROCEDURE [bcd: BcdBase] =
    BEGIN OPEN SystemDefs;
    loadee _ bcd;
    ssb _ LOOPHOLE[loadee+loadee.ssOffset];
    ftb _ LOOPHOLE[loadee+loadee.ftOffset];
    IF tableopen THEN FinalizeUtilities[];
    tableopen _ TRUE;
    ModuleTable _ DESCRIPTOR[
      AllocateHeapNode[bcd.nModules*SIZE[ModuleInfo]], bcd.nModules];
    nModulesEntered _ 0;
    END;

-- Utility Routines

  AssignControlModules: PUBLIC PROCEDURE [loadee: BcdBase, Reloc: Relocation] =
    BEGIN OPEN ControlDefs;
    ctb: CARDINAL _ LOOPHOLE[loadee+loadee.ctOffset];
    mtb: CARDINAL _ LOOPHOLE[loadee+loadee.mtOffset];
    ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs;
      frame: GlobalFrameHandle _ GFT[Reloc[mth.gfi]].frame;
      cti: CTIndex;
      gfi: GFTIndex;
      ControlGfi: PROCEDURE [cti: CTIndex] RETURNS [GFTIndex] =
        BEGIN
        RETURN[IF cti = CTNull OR (ctb+cti).control = MTNull THEN GFTNull
          ELSE (mtb+(ctb+cti).control).gfi];
        END;
      gfi _ ControlGfi[cti _ mth.config];
      WHILE gfi = mth.gfi DO gfi _ ControlGfi[cti _ (ctb+cti).config] ENDLOOP;
      frame.global[0] _
        (IF gfi = GFTNull THEN NullGlobalFrame ELSE GFT[Reloc[gfi]].frame);
      RETURN [FALSE];
      END;

    [] _ LoaderBcdUtilDefs.EnumerateModuleTable[loadee, ModuleSearch];
    END;

  EnterCodeFileNames: PUBLIC PROCEDURE [loadee: BcdBase] =
    BEGIN
    SegSearch: PROCEDURE [sgh: SGHandle, sgi: SGIndex] RETURNS [BOOLEAN] =
      BEGIN
      IF sgh.class = code THEN AddFileName[sgh.file];
      RETURN[FALSE];
      END;
    [] _ LoaderBcdUtilDefs.EnumerateSegTable[loadee, SegSearch];
    RETURN;
    END;

  AllocateSingleModule: PUBLIC PROCEDURE [
    loadee: BcdBase, framelinks: BOOLEAN] RETURNS [frame: POINTER] =
    BEGIN
    fsi: CARDINAL _ 0;
    i: CARDINAL;
    mth: MTHandle _ LOOPHOLE[loadee+loadee.mtOffset,CARDINAL]+FIRST[MTIndex];
    framelinks _ framelinks OR mth.links = frame OR ~mth.code.linkspace;
    IF framelinks THEN fsi _ mth.frame.length;
    fsi _ NextMultipleOfFour[fsi] + mth.framesize;
    FOR i IN [0..ControlDefs.MaxAllocSlot) DO
      IF FrameDefs.FrameSize[i] >= fsi THEN
        BEGIN fsi _ i; EXIT END;
      ENDLOOP;
    frame _ ControlDefs.Alloc[fsi];
    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: PUBLIC PROCEDURE [
    loadee: 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;
    [] _ LoaderBcdUtilDefs.EnumerateModuleTable[loadee, FrameSize];
    RETURN;
    END;

  ControlModuleFrame: PUBLIC PROCEDURE [loadee: BcdBase, Reloc: Relocation]
    RETURNS [ControlDefs.GlobalFrameHandle] =
    BEGIN OPEN ControlDefs;
    mtb: CARDINAL _ LOOPHOLE[loadee + loadee.mtOffset];
    control: MTIndex _ MTNull;
    ConfigSearch: PROCEDURE [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
      BEGIN
      IF cth.config = CTNull THEN
        BEGIN
        control _ cth.control;
        RETURN [TRUE];
        END;
      RETURN [FALSE];
      END;
    [] _ LoaderBcdUtilDefs.EnumerateConfigTable[loadee, ConfigSearch];
    RETURN[IF control = MTNull THEN ControlDefs.NullGlobalFrame
      ELSE GFT[Reloc[(mtb+control).gfi]].frame];
    END;

  InitImportBinding: PUBLIC PROCEDURE [size: CARDINAL]
    RETURNS [binding: Binding] =
    BEGIN OPEN SystemDefs;
    i: CARDINAL;
    binding _
      DESCRIPTOR[AllocateHeapNode[size*SIZE[ImportBindingLink]], size];
    FOR i IN [0..size) DO
      binding[i] _ [whichgfi: 0, body: notbound[]];
      ENDLOOP;
    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.MaxAllocSlot) DO
      IF space >= FrameDefs.FrameSize[fsi] THEN RETURN[fsi];
      ENDLOOP;
    RETURN[0]; -- see RequiredFrameSpace for alloced modules w/ framesize<7
    END;

  ModuleInfo: TYPE = RECORD [
    mth: MTHandle,
    frame: GlobalFrameHandle,
    bound: BOOLEAN,
    sgi: SGIndex];

  ModuleTable: DESCRIPTOR FOR ARRAY OF ModuleInfo;
  nModulesEntered: CARDINAL;

  FindCodeSegment: PUBLIC PROCEDURE [
    loadee: BcdBase, mth: MTHandle, frame: GlobalFrameHandle]
    RETURNS [seg: FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    sgh: SGHandle _ mth.code.sgi+LOOPHOLE[loadee+loadee.sgOffset, CARDINAL];
    file: FileHandle;
    i: CARDINAL;
    pages: CARDINAL;
    FindSegment: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      RETURN[s.file = file AND s.base = sgh.base AND s.pages = pages];
      END;
    FOR i IN [0..nModulesEntered) DO
      IF ModuleTable[i].mth.code.sgi = mth.code.sgi THEN
        RETURN[CodeDefs.CodeHandle[ModuleTable[i].frame]];
      ENDLOOP;
    file _ FileHandleFromTable[sgh.file];
    pages _ sgh.pages+sgh.extraPages;
    seg _ EnumerateFileSegments[FindSegment];
    IF seg = NIL THEN seg _ NewFileSegment[file, sgh.base, pages, Read];
    ModuleTable[nModulesEntered] _
      ModuleInfo[mth, frame, FALSE, mth.code.sgi];
    nModulesEntered _ nModulesEntered + 1;
    RETURN
    END;

  ModuleIsBound: PUBLIC PROCEDURE [mth: MTHandle] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..nModulesEntered) DO
      IF ModuleTable[i].mth = mth THEN ModuleTable[i].bound _ TRUE;
      ENDLOOP;
    RETURN
    END;

  IsModuleBound: PUBLIC PROCEDURE [mth: MTHandle] RETURNS [BOOLEAN] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..nModulesEntered) DO
      IF ModuleTable[i].mth = mth AND ModuleTable[i].bound THEN RETURN[TRUE];
      ENDLOOP;
    RETURN[FALSE];
    END;

  END....