-- MakeImageUtilities.Mesa  Edited by Sandman on July 1, 1980  8:14 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageNumber, PageSize],
  AltoFileDefs USING [CFA, DirFP, eofDA, FA, FP, NullFP, vDA],
  BcdDefs USING [Base, FTSelf, MTIndex],
  BcdMergeOps USING [Finalize, Initialize, MergeBcd, MergeModule, Size, Write],
  BcdOps USING [BcdBase, MTHandle, ProcessModules],
  ControlDefs USING [GFT, GFTIndex, GFTItem, GlobalFrameHandle, NullGlobalFrame],
  DirectoryDefs USING [EnumerateDirectory],
  FrameDefs USING [
    EnumerateGlobalFrames, MakeCodeResident, SwapInCode, SwapOutCode],
  FrameOps USING [CodeHandle],
  ImageDefs USING [FileRequest],
  ImageFormat USING [ImageHeader, MapItem],
  InlineDefs USING [COPY],
  LoadStateFormat USING [
    AltoVersionID, ConfigIndex, LoadState, ModuleTable, NullConfig, NullModule],
  LoadStateOps USING [
    AcquireBcd, EnumerateBcds, GetBcdInfo, GetMap, InputLoadState, Map,
    MapRealToConfig, ReleaseBcd, ReleaseMap],
  MakeImageOps USING [],
  MiscDefs USING [SetBlock, Zero],
  SDDefs USING [SD, sGFTLength],
  SegmentDefs USING [
    AddressFromPage, Append, DataSegmentAddress, DataSegmentHandle, DefaultBase,
    DefaultVersion, DeleteDataSegment, DeleteFileSegment, EnumerateFileSegments,
    FileHandle, FileHint, FileSegmentAddress, FileSegmentHandle, InsertFile,
    JumpToPage, LockFile, NewDataSegment, NewFile, NewFileSegment, Read, SwapIn,
    SwapOut, SwapUp, Unlock, VMtoFileSegment, Write],
  StreamDefs USING [
    DiskHandle, GetIndex, NewWordStream, SetIndex, StreamIndex, WriteBlock],
  StringDefs USING [EquivalentString],
  Storage USING [Pages, FreePages];

MakeImageUtilities: PROGRAM
  IMPORTS
    BcdMergeOps, BcdOps, DirectoryDefs, FrameDefs, FrameOps, InlineDefs,
    LoadStateOps, MiscDefs, SegmentDefs, StreamDefs, StringDefs, Storage
  EXPORTS MakeImageOps
  SHARES SegmentDefs, ControlDefs =PUBLIC

  BEGIN OPEN SegmentDefs, ImageFormat;

  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  PageNumber: TYPE = AltoDefs.PageNumber;

  -- file requests

  RequestHead: POINTER TO ImageDefs.FileRequest;

  InitFileRequest: PROCEDURE = BEGIN RequestHead _ NIL; END;

  AddFileRequest: PROCEDURE [r: POINTER TO ImageDefs.FileRequest] =
    BEGIN r.link _ RequestHead; RequestHead _ r; END;

  DropFileRequest: PROCEDURE [f: FileHandle] =
    BEGIN
    r, prev: POINTER TO ImageDefs.FileRequest;
    prev _ NIL;
    FOR r _ RequestHead, r.link UNTIL r = NIL DO
      IF r.file = f THEN
	IF prev = NIL THEN RequestHead _ r.link ELSE prev.link _ r.link
      ELSE prev _ r;
      ENDLOOP;
    END;

  ProcessFileRequests: PROCEDURE =
    BEGIN OPEN AltoFileDefs;

    checkone: PROCEDURE [fp: POINTER TO FP, dname: STRING] RETURNS [BOOLEAN] =
      BEGIN
      r: POINTER TO ImageDefs.FileRequest;
      prev: POINTER TO ImageDefs.FileRequest _ NIL;
      FOR r _ RequestHead, r.link UNTIL r = NIL DO
	IF StringDefs.EquivalentString[dname, r.name] THEN
	  BEGIN OPEN SegmentDefs;
	  IF r.file = NIL THEN LockFile[r.file _ InsertFile[fp, r.access]]
	  ELSE r.file.fp _ fp^;
	  IF prev = NIL THEN RequestHead _ r.link ELSE prev.link _ r.link;
	  END
	ELSE prev _ r;
	ENDLOOP;
      RETURN[RequestHead = NIL]
      END;

    DirectoryDefs.EnumerateDirectory[checkone];
    END;

  -- space allocation

  SpaceHeader: TYPE = RECORD [
    link: POINTER TO SpaceHeader, segment: SegmentDefs.DataSegmentHandle];

  SpaceList: POINTER TO SpaceHeader _ NIL;
  SpacePointer: POINTER TO SpaceHeader;
  SpaceLeft: CARDINAL;

  InitSpace: PROCEDURE = BEGIN SpaceLeft _ 0; END;

  GetSpace: PROCEDURE [n: CARDINAL] RETURNS [p: POINTER] =
    BEGIN
    newseg: DataSegmentHandle;
    IF n > SpaceLeft THEN
      BEGIN
      newseg _ SegmentDefs.NewDataSegment[SegmentDefs.DefaultBase, 1];
      SpacePointer _ SegmentDefs.DataSegmentAddress[newseg];
      SpacePointer.link _ SpaceList;
      SpacePointer.segment _ newseg;
      SpaceList _ SpacePointer;
      SpacePointer _ SpacePointer + SIZE[SpaceHeader];
      SpaceLeft _ AltoDefs.PageSize - SIZE[SpaceHeader];
      END;
    p _ SpacePointer;
    SpacePointer _ SpacePointer + n;
    SpaceLeft _ SpaceLeft - n;
    END;

  GetString: PROCEDURE [oldstring: STRING] RETURNS [newstring: STRING] =
    BEGIN
    i, length: CARDINAL;
    string: TYPE = POINTER TO MACHINE DEPENDENT RECORD [
      length, maxlength: CARDINAL];
    length _ oldstring.length;
    newstring _ GetSpace[(length + 5)/2];
    newstring.length _ length;
    LOOPHOLE[newstring, string].maxlength _ length;
    FOR i IN [0..length) DO newstring[i] _ oldstring[i]; ENDLOOP;
    RETURN;
    END;

  FreeAllSpace: PROCEDURE =
    BEGIN
    next: POINTER TO SpaceHeader;
    UNTIL SpaceList = NIL DO
      next _ SpaceList.link;
      SegmentDefs.DeleteDataSegment[SpaceList.segment];
      SpaceList _ next;
      ENDLOOP;
    END;

  -- image file management


  LockCodeSegment: PROCEDURE [frame: ControlDefs.GlobalFrameHandle] =
    BEGIN OPEN FrameDefs;
    MakeCodeResident[frame];
    SwapInCode[frame];
    SegmentDefs.Unlock[FrameOps.CodeHandle[frame]];
    END;

  UnlockCodeSegment: PROCEDURE [frame: ControlDefs.GlobalFrameHandle] =
    BEGIN SegmentDefs.Unlock[FrameOps.CodeHandle[frame]]; END;

  KDSegment: PROCEDURE RETURNS [FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    DiskKDFile: FileHandle = NewFile["DiskDescriptor"L, Read, DefaultVersion];

    FindKD: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN RETURN[s.file = DiskKDFile]; END;

    RETURN[SegmentDefs.EnumerateFileSegments[FindKD]];
    END;

  DAofPage: PROCEDURE [file: FileHandle, page: AltoDefs.PageNumber]
    RETURNS [next: AltoFileDefs.vDA] =
    BEGIN
    cfa: AltoFileDefs.CFA;
    buf: POINTER = Storage.Pages[1];
    cfa.fp _ file.fp;
    cfa.fa _ AltoFileDefs.FA[file.fp.leaderDA, 0, 0];
    next _ SegmentDefs.JumpToPage[@cfa, page - 1, buf].next;
    Storage.FreePages[buf];
    RETURN
    END;

  FillInCAs: PROCEDURE [
    Image: POINTER TO ImageHeader, mapindex: CARDINAL, ca: POINTER] =
    BEGIN
    i: CARDINAL;
    map: POINTER TO ARRAY [0..0) OF normal MapItem = LOOPHOLE[@Image.map];
    addr: POINTER;
    FOR i IN [0..mapindex) DO
      addr _ SegmentDefs.AddressFromPage[map[i].page];
      THROUGH [0..map[i].count) DO
	ca^ _ addr; ca _ ca + 1; addr _ addr + AltoDefs.PageSize; ENDLOOP;
      ENDLOOP;
    END;

  SwapOutUnlockedCode: PROCEDURE [f: ControlDefs.GlobalFrameHandle]
    RETURNS [BOOLEAN] =
    BEGIN
    cseg: FileSegmentHandle _ FrameOps.CodeHandle[f];
    IF cseg.swappedin AND cseg.lock = 0 THEN FrameDefs.SwapOutCode[f];
    RETURN[FALSE]
    END;

  SwapOutUnlocked: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN IF s.lock = 0 THEN SegmentDefs.SwapOut[s]; RETURN[FALSE]; END;

  BashHint: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    WITH s SELECT FROM
      disk => hint _ SegmentDefs.FileHint[da: AltoFileDefs.eofDA, page: 0];
      ENDCASE;
    RETURN[FALSE];
    END;

  BashFile: PROCEDURE [f: FileHandle] RETURNS [BOOLEAN] =
    BEGIN OPEN AltoFileDefs;
    f.open _ f.lengthvalid _ FALSE;
    IF f.fp.serial # DirFP.serial THEN f.fp _ NullFP;
    RETURN[FALSE];
    END;

  PatchUpGFT: PROCEDURE =
    BEGIN OPEN ControlDefs;
    i: GFTIndex;
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    FOR i IN [1..SDDefs.SD[SDDefs.sGFTLength]) DO
      IF gft[i] = [frame: NullGlobalFrame, epbase: 177777B] THEN
	gft[i] _ [frame: NullGlobalFrame, epbase: 0];
      ENDLOOP;
    RETURN
    END;

  ModuleTable: TYPE = LoadStateFormat.ModuleTable;
  BcdBase: TYPE = BcdOps.BcdBase;
  ConfigIndex: TYPE = LoadStateFormat.ConfigIndex;
  ConfigNull: ConfigIndex = LoadStateFormat.NullConfig;

  InitModuleTable: PROCEDURE [
    mt: ModuleTable, merge: BOOLEAN, nbcds: ConfigIndex] =
    BEGIN OPEN ControlDefs;
    rgfi, cgfi: GFTIndex _ 0;
    i: ConfigIndex;
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    gftLength: CARDINAL = SDDefs.SD[SDDefs.sGFTLength];
    MiscDefs.SetBlock[p: BASE[mt], v: LoadStateFormat.NullModule, l: gftLength];
    IF merge THEN
      FOR rgfi IN [1..gftLength) DO
	IF gft[rgfi].frame # NullGlobalFrame THEN
	  mt[rgfi] _ [resolved: TRUE, config: 0, gfi: (cgfi _ cgfi + 1)];
	ENDLOOP
    ELSE
      FOR i IN [0..nbcds) DO
	cgfi _ 0;
	FOR rgfi IN [1..gftLength) DO
	  IF gft[rgfi].frame # NullGlobalFrame AND LoadStateOps.MapRealToConfig[
	    rgfi].config = i THEN
	    mt[rgfi] _ [resolved: TRUE, config: i, gfi: (cgfi _ cgfi + 1)];
	  ENDLOOP;
	ENDLOOP;
    END;

  NumberGFIInConfig: PROCEDURE [mt: ModuleTable, con: ConfigIndex]
    RETURNS [ngfi: ControlDefs.GFTIndex] =
    BEGIN
    i: ControlDefs.GFTIndex;
    ngfi _ 0;
    FOR i IN [0..LENGTH[mt]) DO
      IF mt[i].config = con THEN ngfi _ ngfi + 1; ENDLOOP;
    RETURN
    END;

  -- Bcd Merging Management

  Strings: TYPE = DESCRIPTOR FOR ARRAY OF STRING;

  TableSize: CARDINAL = 15*AltoDefs.PageSize;

  MergeAllBcds: PROCEDURE [mt: ModuleTable, names: Strings] =
    BEGIN OPEN LoadStateOps;

    MergeLoadedBcds: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
      BEGIN
      map: Map _ GetMap[config];
      bcd: BcdBase _ AcquireBcd[config];
      BcdMergeOps.MergeBcd[bcd, map, 0, mt, names[config]];
      ReleaseBcd[bcd];
      ReleaseMap[map];
      RETURN[FALSE];
      END;

    MergeCopiedFrames: PROCEDURE [frame: GlobalFrameHandle] RETURNS [BOOLEAN] =
      BEGIN
      copied: GlobalFrameHandle;
      config: ConfigIndex;

      ModuleCopiedFrom: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
	BEGIN
	RETURN[
	  f # frame AND f.code.handle = frame.code.handle AND
	    (config _ MapRealToConfig[f.gfi].config) # ConfigNull];
	END;

	IF MapRealToConfig[frame.gfi].config # ConfigNull THEN RETURN[FALSE];
      IF (copied _ FrameDefs.EnumerateGlobalFrames[ModuleCopiedFrom]) #
	ControlDefs.NullGlobalFrame THEN
	BEGIN BcdMergeOps.MergeModule[frame, copied, mt]; RETURN[FALSE]; END;
      RETURN[FALSE];
      END;

    BcdMergeOps.Initialize[TableSize, NumberGFIInConfig[mt, 0]];
    [] _ EnumerateBcds[recentlast, MergeLoadedBcds];
    [] _ FrameDefs.EnumerateGlobalFrames[MergeCopiedFrames];
    [] _ BcdMergeOps.Size[];
    BcdMergeOps.Write[MoveWords];
    BcdMergeOps.Finalize[];
    END;

  MergeABcd: PROCEDURE [config: ConfigIndex, mt: ModuleTable, names: Strings] =
    BEGIN OPEN LoadStateOps;
    map: Map _ GetMap[config];
    bcd: BcdBase _ AcquireBcd[config];
    BcdMergeOps.Initialize[TableSize, NumberGFIInConfig[mt, config]];
    BcdMergeOps.MergeBcd[bcd, map, config, mt, names[config]];
    ReleaseBcd[bcd];
    ReleaseMap[map];
    [] _ BcdMergeOps.Size[];
    BcdMergeOps.Write[MoveWords];
    BcdMergeOps.Finalize[];
    END;

  StreamSegment: PROCEDURE [stream: StreamDefs.DiskHandle, page: PageNumber]
    RETURNS [newpage: PageNumber, seg: FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    index: StreamDefs.StreamIndex;
    index _ StreamDefs.GetIndex[stream];
    IF index.byte # 0 THEN
      BEGIN
      index.byte _ 0;
      index.page _ index.page + 1;
      StreamDefs.SetIndex[stream, index];
      END;
    seg _ NewFileSegment[stream.file, page + 1, index.page - page, Read + Write];
    newpage _ index.page;
    RETURN
    END;

  Data: TYPE = RECORD [
    mt: ModuleTable,
    bcdsegs: DESCRIPTOR FOR ARRAY OF FileSegmentHandle,
    strings: Strings,
    initLS: LoadStateFormat.LoadState,
    initlsseg: FileSegmentHandle,
    bcdstream: StreamDefs.DiskHandle];

  data: POINTER TO Data;

  SaveBcd: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
    BEGIN
    data.bcdsegs[config] _ SegmentDefs.VMtoFileSegment[
      LoadStateOps.AcquireBcd[config]];
    RETURN[FALSE];
    END;

  ProcessBcds: PROCEDURE [initstateseg: FileSegmentHandle, merge: BOOLEAN]
    RETURNS [maxbcdsize: CARDINAL] =
    BEGIN OPEN SegmentDefs;
    nbcds, page, con: CARDINAL;
    data _ GetSpace[SIZE[Data]];
    SwapIn[initstateseg];
    data.initLS _ FileSegmentAddress[initstateseg];
    data.initlsseg _ initstateseg;
    MiscDefs.Zero[data.initLS, initstateseg.pages*AltoDefs.PageSize];
    data.mt _ DESCRIPTOR[@data.initLS.gft, SDDefs.SD[SDDefs.sGFTLength]];
    data.bcdstream _ StreamDefs.NewWordStream[
      "makeimage.scratch$"L, Read + Write + Append];
    nbcds _ LoadStateOps.InputLoadState[];
    data.strings _ GetBcdFileNames[nbcds];
    nbcds _ IF merge THEN 1 ELSE nbcds;
    data.initLS.nBcds _ nbcds;
    data.bcdsegs _ DESCRIPTOR[GetSpace[nbcds], nbcds];
    page _ 0;
    InitModuleTable[data.mt, merge, nbcds];
    IF merge THEN
      BEGIN
      MergeAllBcds[data.mt, data.strings];
      [page, data.bcdsegs[0]] _ StreamSegment[data.bcdstream, page];
      maxbcdsize _ data.bcdsegs[0].pages;
      END
    ELSE
      BEGIN
      [] _ LoadStateOps.EnumerateBcds[recentlast, SaveBcd];
      maxbcdsize _ 0;
      FOR con IN [0..nbcds) DO
	MergeABcd[con, data.mt, data.strings];
	[page, data.bcdsegs[con]] _ StreamSegment[data.bcdstream, page];
	maxbcdsize _ MAX[maxbcdsize, data.bcdsegs[con].pages];
	ENDLOOP;
      END;
    data.bcdstream.destroy[data.bcdstream];
    IF merge THEN PatchUpGFT[];
    RETURN
    END;

  -- bcd file names


  GetBcdFileNames: PROCEDURE [nbcds: ConfigIndex] RETURNS [names: Strings] =
    BEGIN
    nfound: ConfigIndex _ 0;

    GetNames: PROCEDURE [fp: POINTER TO AltoFileDefs.FP, s: STRING]
      RETURNS [BOOLEAN] =
      BEGIN

      FindBcd: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
	BEGIN
	IF fp^ = LoadStateOps.GetBcdInfo[config].fp^ THEN
	  BEGIN
	  names[config] _ GetString[s];
	  nfound _ nfound + 1;
	  RETURN[TRUE];
	  END;
	RETURN[FALSE];
	END;

	[] _ LoadStateOps.EnumerateBcds[recentfirst, FindBcd];
      RETURN[nfound = nbcds];
      END;

    names _ DESCRIPTOR[GetSpace[nbcds], nbcds];
    MiscDefs.SetBlock[BASE[names], GetString["(anon)"L], nbcds];
    DirectoryDefs.EnumerateDirectory[GetNames];
    RETURN[names];
    END;

  MoveWords: PUBLIC PROCEDURE [source: POINTER, nwords: CARDINAL] =
    BEGIN
    IF nwords # StreamDefs.WriteBlock[
      stream: data.bcdstream, address: source, words: nwords] THEN ERROR;
    END;

  MapSegmentsInBcd: PROCEDURE [
    mt: ModuleTable, config: ConfigIndex, bcdseg: FileSegmentHandle]
    RETURNS [links, types: BOOLEAN] =
    BEGIN OPEN BcdOps, LoadStateFormat;
    bcd: BcdBase;
    sgb: BcdDefs.Base;

    MapSegments: PROCEDURE [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
      RETURNS [BOOLEAN] =
      BEGIN OPEN s: sgb[mth.code.sgi];
      gftLength: CARDINAL = SDDefs.SD[SDDefs.sGFTLength];
      frame: GlobalFrameHandle;
      rgfi: CARDINAL _ 1;
      WHILE rgfi < gftLength DO
	IF mt[rgfi].config = config AND mt[rgfi].gfi = mth.gfi THEN EXIT;
	rgfi _ rgfi + 1;
	ENDLOOP;
      IF s.file = BcdDefs.FTSelf AND s.class = code THEN
	BEGIN
	frame _ ControlDefs.GFT[rgfi].frame;
	s.base _ FrameOps.CodeHandle[frame].base;
	END;
      RETURN[FALSE];
      END;

    SegmentDefs.SwapIn[bcdseg];
    bcd _ SegmentDefs.FileSegmentAddress[bcdseg];
    sgb _ LOOPHOLE[bcd + bcd.sgOffset];
    [] _ BcdOps.ProcessModules[bcd, MapSegments];
    links _ bcd.nExports # 0;
    types _ bcd.typeExported;
    SegmentDefs.Unlock[bcdseg];
    END;

  InitLoadStates: PROCEDURE [lsseg: FileSegmentHandle] =
    BEGIN OPEN AltoFileDefs;
    i: CARDINAL;
    exports, typeExported: BOOLEAN;
    seg: FileSegmentHandle;
    FOR i IN [0..data.initLS.nBcds) DO
      seg _ data.bcdsegs[i];
      [links: exports, types: typeExported] _ MapSegmentsInBcd[data.mt, i, seg];
      data.initLS.bcds[i] _
	[exports: exports, typeExported: typeExported, pages: seg.pages,
	  body: alto[fp: NullFP, da: eofDA, base: seg.base]];
      SegmentDefs.DeleteFileSegment[seg];
      ENDLOOP;
    data.initLS.versionident _ LoadStateFormat.AltoVersionID;
    InlineDefs.COPY[
      from: data.initLS, to: SegmentDefs.FileSegmentAddress[lsseg],
      nwords: AltoDefs.PageSize*lsseg.pages];
    lsseg.write _ TRUE;
    SegmentDefs.SwapUp[lsseg];
    lsseg.write _ FALSE;
    data.initlsseg.write _ TRUE;
    SegmentDefs.SwapUp[data.initlsseg];
    data.initlsseg.write _ FALSE;
    RETURN
    END;


  END..