-- MakeImage.Mesa
-- Edited by:
--		Levin on October 18, 1978  11:12 AM

DIRECTORY
  AllocDefs: FROM "allocdefs" USING [
    AddSwapStrategy, RemoveSwapStrategy, SwappingProcedure, SwapStrategy],
  AltoDefs: FROM "altodefs" USING [
    BytesPerPage, PageCount, PageNumber, PageSize],
  AltoFileDefs: FROM "altofiledefs" USING [
    CFA, CFP, eofDA, fillinDA, FP, TIME, vDA],
  BcdDefs: FROM "bcddefs" USING [FTSelf, MTHandle, MTIndex, VersionStamp],
  BcdMergeDefs: FROM "bcdmergedefs" USING [MergeBcd],
  BcdTabDefs: FROM "bcdtabdefs" USING [FindString],
  BFSDefs: FROM "bfsdefs" USING [ActOnPages, GetNextDA],
  BootDefs: FROM "bootdefs" USING [EnumerateObjects, PositionSeg],
  CodeDefs: FROM "codedefs" USING [CodeHandle],
  ControlDefs: FROM "controldefs" USING [
    Alloc, AllocationVector, AllocationVectorSize, ATPreg, AV, ControlLink,
    EntryVectorItem, FrameHandle, FrameVec, Free, GetReturnLink, GFT,
    GFTIndex, GlobalFrameHandle, Greg, Lreg, MaxAllocSlot, OTPreg, ProcDesc,
    SD, StateVector, SVPointer, WDCreg, XTSreg],
  CoreSwapDefs: FROM "coreswapdefs" USING [SetLevel],
  DirectoryDefs: FROM "directorydefs" USING [EnumerateDirectory],
  DiskDefs: FROM "diskdefs" USING [
    DA, DiskPageDesc, DiskRequest, ResetDisk, SwapPages, VirtualDA],
  DiskKDDefs: FROM "diskkddefs" USING [CloseDiskKD, InitializeDiskKD],
  FrameDefs: FROM "framedefs" USING [GlobalFrame, SwapOutCode],
  ImageDefs: FROM "imagedefs" USING [
    FileRequest, FirstImageDataPage, HeaderPages, ImageHeader, ImageVersion,
    MapItem, MapSpace, PuntMesa, StopMesa, UserCleanupProc, VersionID],
  InlineDefs: FROM "inlinedefs" USING [BITAND, COPY],
  LoaderBcdUtilDefs: FROM "loaderbcdutildefs" USING [
    BcdBase, EnumerateModuleTable],
  LoadStateDefs: FROM "loadstatedefs" USING [
    BcdAddress, BcdSegFromLoadState, ConfigIndex, EnumerateLoadStateBcds,
    GetInitialLoadState, GetLoadState, GFTIndex, InputLoadState, LoadState,
    LoadStateGFT, ReleaseLoadState, UpdateLoadState],
  MiscDefs: FROM "miscdefs" USING [DAYTIME, GetNetworkNumber, SetBlock, Zero],
  MIUtilityDefs: FROM "miutilitydefs" USING [
    AddFileRequest, BashFile, BashHint, DAofPage, DropFileRequest, FillInCAs,
    FreeAllSpace, GetBcdFileNames, GetSpace, InitFileRequest,
    InitLoadStateGFT, InitSpace, KDSegment, LockCodeSegment, MergeABcd,
    MergeAllBcds, NewBcdSegmentFromStream, PatchUpGFT, ProcessFileRequests,
    UnlockCodeSegment],
  OsStaticDefs: FROM "osstaticdefs" USING [OsStatics],
  ProcessDefs: FROM "processdefs" USING [
    ActiveWord, CurrentPSB, CurrentState, CV, DisableInterrupts, DIW,
    EnableInterrupts, ProcessHandle, Queue, ReadyList, SDC, WakeupsWaiting],
  SDDefs: FROM "sddefs" USING [
    sAddFileRequest, sAllocTrap, sGFTLength, sGoingAway, sSwapTrap,
    sXferTrap],
  SegmentDefs: FROM "segmentdefs" USING [
    AddressFromPage, Append, CloseFile, DataSegmentAddress, DataSegmentHandle,
    DefaultBase, DefaultVersion, DeleteDataSegment, DeleteFileSegment,
    EnumerateDataSegments, EnumerateFiles, EnumerateFileSegments, FileError,
    FileHandle, FileHint, FileSegmentAddress, FileSegmentHandle,
    MapFileSegment, NewDataSegment, NewFile, ObjectHandle, PageFromAddress, Read,
    ReleaseFile, SetEndOfFile, SwapIn, SwapOut, SwapUp, Unlock, Write],
  StreamDefs: FROM "streamdefs" USING [
    CreateWordStream, DiskHandle, NewWordStream, ReadBlock, StreamHandle,
    WriteBlock],
  StringDefs: FROM "stringdefs" USING [EquivalentString],
  SystemDefs: FROM "systemdefs" USING [PruneHeap],
  TableDefs: FROM "tabledefs" USING [Allocate],
  TimeDefs: FROM "timedefs" USING [PackedTime],
  XMESA: FROM "xmesaprivatedefs" USING [BankMasks, DisableBank, EnableBank, InitMemoryConfig,
    MoveLockedCode, SwapOutFileSegment, XMremote, XObject],
  XMesaDefs: FROM "xmesadefs" USING [BankIndex, GetMemoryConfig, ImmovableSegmentInHighBank,
    MemoryConfig];

DEFINITIONS FROM
  LoadStateDefs, DiskDefs, ImageDefs, ControlDefs, SegmentDefs, MIUtilityDefs;

MakeImage: PROGRAM
  IMPORTS AllocDefs, BcdMergeDefs, BcdTabDefs, TableDefs, BFSDefs, BootDefs, CodeDefs, CoreSwapDefs,
    DirectoryDefs, DiskDefs, DiskKDDefs, FrameDefs, ImageDefs, LoaderBcdUtilDefs,
    LoadStateDefs, MiscDefs, SegmentDefs, StreamDefs, StringDefs, SystemDefs,
    XMESA, XMesaDefs, MIUtilityDefs									--XM
  EXPORTS ImageDefs, MIUtilityDefs
  SHARES XMESA, ProcessDefs, DiskDefs, SegmentDefs, ControlDefs, ImageDefs =			--XM
  BEGIN

  CFA: TYPE = AltoFileDefs.CFA;
  DataSegmentHandle: TYPE = SegmentDefs.DataSegmentHandle;
  FP: TYPE = AltoFileDefs.FP;
  FileHandle: TYPE = SegmentDefs.FileHandle;
  FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;
  PageCount: TYPE = AltoDefs.PageCount;
  PageNumber: TYPE = AltoDefs.PageNumber;
  shortFileRequest: TYPE = short ImageDefs.FileRequest;
  vDA: TYPE = AltoFileDefs.vDA;
  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  LoadStateGFT: TYPE = LoadStateDefs.LoadStateGFT;
  ConfigIndex: TYPE = LoadStateDefs.ConfigIndex;
  StreamHandle: TYPE = StreamDefs.StreamHandle;
  ProcDesc: TYPE = ControlDefs.ProcDesc;

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

MapSegmentsInBcd: PROCEDURE [
initialGFT: LoadStateGFT, config: ConfigIndex, bcdseg: FileSegmentHandle]
  RETURNS [unresolved, exports: BOOLEAN] =
  BEGIN OPEN LoaderBcdUtilDefs, LoadStateDefs;
  bcd: BcdBase;
  sgb: CARDINAL;
  MapSegments: PROCEDURE [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
    RETURNS [BOOLEAN] =
    BEGIN OPEN s: sgb+mth.code.sgi;
    gftLength: CARDINAL = SD[SDDefs.sGFTLength];
    frame: GlobalFrameHandle;
    rgfi: GFTIndex _ 1;
    WHILE rgfi < gftLength DO
      IF initialGFT[rgfi] = [config: config, gfi: mth.gfi] THEN EXIT;
      rgfi _ rgfi + 1;
    ENDLOOP;
    IF s.file = BcdDefs.FTSelf AND s.class = code THEN
      BEGIN
      frame _ GFT[rgfi].frame;
      s.base _ CodeDefs.CodeHandle[frame].base;
      END;
    RETURN[FALSE];
    END;
  SegmentDefs.SwapIn[bcdseg];
  bcd _ SegmentDefs.FileSegmentAddress[bcdseg];
  sgb _ LOOPHOLE[bcd+bcd.sgOffset];
  [] _ EnumerateModuleTable[bcd, MapSegments];
  unresolved _ bcd.nImports # 0;
  exports _ bcd.nExports # 0;
  SegmentDefs.Unlock[bcdseg];
  SegmentDefs.SwapOut[bcdseg];
  END;

bcdstream: StreamDefs.DiskHandle;

DisplayHeader: POINTER TO WORD = LOOPHOLE[420B];

SwapTrapDuringMakeImage: PUBLIC SIGNAL = CODE;
SwapErrorDuringMakeImage: PUBLIC SIGNAL = CODE;
SwapOutDuringMakeImage: PUBLIC SIGNAL = CODE;
NoRoomInImageMap: PUBLIC SIGNAL = CODE;

SwapTrapError: PROCEDURE =
  BEGIN
  dest: ControlDefs.ControlLink;
  s: ControlDefs.StateVector;
  ProcessDefs.DisableInterrupts[];
  s _ STATE;
  dest _ LOOPHOLE[REGISTER[ControlDefs.OTPreg]];
  ProcessDefs.DisableInterrupts[];
  SIGNAL SwapTrapDuringMakeImage;
  RETURN WITH s;
  END;

SwapOutError: AllocDefs.SwappingProcedure =
  BEGIN
  SIGNAL SwapOutDuringMakeImage;
  RETURN[TRUE];
  END;

-- File Segment Transfer Routines

bufferseg: DataSegmentHandle;
buffer: POINTER;
BufferPages: PageCount;

SwapDR: TYPE = POINTER TO swap DiskRequest;

TransferPages: PROCEDURE [
da: vDA, base: PageNumber, pages: PageCount, fp: POINTER TO FP, sdr: SwapDR]
  RETURNS [next: vDA] =
  BEGIN OPEN DiskDefs;
  sdr.da _ @da;
  sdr.firstPage _ base;
  sdr.lastPage _ base+pages-1;
  sdr.fp _ fp;
  IF SwapPages[sdr].page # base+pages-1 THEN SIGNAL SwapErrorDuringMakeImage;
  next _ sdr.desc.next;
  RETURN[next];
  END;

TransferFileSegment: PROCEDURE [
buffer: POINTER, seg: FileSegmentHandle, file: FileHandle, base: PageNumber, fileda: vDA] 
  RETURNS [vDA] =
  BEGIN
  dpd: DiskPageDesc;
  sdr: swap DiskRequest;
  old: FileHandle _ seg.file;
  segbase: PageNumber _ seg.base;
  pages: PageCount _ seg.pages;
  segda: vDA;
  WITH s: seg SELECT FROM
    disk => segda _ s.hint.da;
    ENDCASE => ERROR SwapErrorDuringMakeImage;
  seg.base _ base;
  sdr _ [ca: buffer, da:, firstPage:, lastPage:, fp:, fixedCA: FALSE, action:,
    lastAction:, signalCheckError: FALSE, option: swap[desc: @dpd]];
  IF seg.swappedin THEN
    BEGIN
    sdr.ca _ SegmentDefs.AddressFromPage[seg.VMpage];
    sdr.action _ sdr.lastAction _ WriteD;
    fileda _ TransferPages[fileda, base, pages, @file.fp, @sdr];
    old.swapcount _ old.swapcount - 1;
    file.swapcount _ file.swapcount + 1;
    END
  ELSE
    BEGIN
    WHILE BufferPages < pages DO
      pages _ pages - BufferPages;
      sdr.action _ sdr.lastAction _ ReadD;
      segda _ TransferPages[segda, segbase, BufferPages, @old.fp, @sdr];
      sdr.action _ sdr.lastAction _ WriteD;
      fileda _ TransferPages[fileda, base, BufferPages, @file.fp, @sdr];
      segbase _ segbase + BufferPages;
      base _ base + BufferPages;
      ENDLOOP;
    sdr.action _ sdr.lastAction _ ReadD;
    segda _ TransferPages[segda, segbase, pages, @old.fp, @sdr];
    sdr.action _ sdr.lastAction _ WriteD;
    fileda _ TransferPages[fileda, base, pages, @file.fp, @sdr];
    END;
  old.segcount _ old.segcount - 1;
  seg.file _ file;
  WITH s: seg SELECT FROM
    disk => s.hint _ FileHint[AltoFileDefs.eofDA, 0];
    ENDCASE;
  file.segcount _ file.segcount + 1;
  IF old.segcount = 0 THEN ReleaseFile[old];
  RETURN [fileda];
  END;

EnumerateNeededModules: PROCEDURE [proc: PROCEDURE [ProcDesc]] =
  BEGIN
  proc[LOOPHOLE[EnumerateNeededModules]];
  proc[LOOPHOLE[MIUtilityDefs.AddFileRequest]];
  proc[LOOPHOLE[BFSDefs.ActOnPages]];
  proc[LOOPHOLE[SegmentDefs.MapFileSegment]];
  proc[LOOPHOLE[SegmentDefs.CloseFile]];
  proc[LOOPHOLE[DiskKDDefs.CloseDiskKD]];
  proc[LOOPHOLE[ImageDefs.UserCleanupProc]];
  proc[LOOPHOLE[DirectoryDefs.EnumerateDirectory]];
  proc[LOOPHOLE[StreamDefs.ReadBlock]];
  proc[LOOPHOLE[StreamDefs.CreateWordStream]];
  proc[LOOPHOLE[StringDefs.EquivalentString]];
  proc[LOOPHOLE[LoadStateDefs.InputLoadState]];
  proc[LOOPHOLE[FrameDefs.GlobalFrame]];
  proc[LOOPHOLE[LoaderBcdUtilDefs.EnumerateModuleTable]];
  proc[LOOPHOLE[SystemDefs.PruneHeap]];
  END;

SwapOutMakeImageCode: PROCEDURE =
  BEGIN OPEN FrameDefs;
  SwapOutCode[GlobalFrame[MIUtilityDefs.AddFileRequest]];
  SwapOutCode[GlobalFrame[TableDefs.Allocate]];
  SwapOutCode[GlobalFrame[BcdTabDefs.FindString]];
  SwapOutCode[GlobalFrame[LoaderBcdUtilDefs.EnumerateModuleTable]];
  SwapOutCode[GlobalFrame[LoadStateDefs.InputLoadState]];
  SwapOutCode[GlobalFrame[BcdMergeDefs.MergeBcd]];
  END;

InvalidImageName: PUBLIC SIGNAL = CODE;

ResidentGFI: CARDINAL = 1;

GetImageFile: PROCEDURE [name: STRING] RETURNS [file: FileHandle] =
  BEGIN OPEN SegmentDefs;
  file _ NewFile[name, Read+Write+Append, DefaultVersion];
  IF file = CodeDefs.CodeHandle[GFT[ResidentGFI].frame].file THEN
    SIGNAL InvalidImageName;
  RETURN
  END;

InstallImage: PROCEDURE [name: STRING, merge, code: BOOLEAN] =
  BEGIN OPEN DiskDefs, AltoFileDefs;
  wdc: CARDINAL;
  diskrequest: DiskRequest;
  lpn: PageNumber; numChars: CARDINAL;
  savealloctrap, saveswaptrap: ControlLink;
  auxtrapFrame: FrameHandle;
  saveAllocationVector: AllocationVector;
  saveXferTrap, saveXferTrapStatus: UNSPECIFIED;
  nextpage: PageNumber;
  swappedinfilepages, swappedoutfilepages, datapages: PageCount _ 0;
  SwapOutErrorStrategy: AllocDefs.SwapStrategy _
    AllocDefs.SwapStrategy[link:,proc:SwapOutError];
  mapindex: CARDINAL _ 0;
  maxFileSegPages: CARDINAL _ 0;
  endofdatamapindex: CARDINAL;
  ptSeg: DataSegmentHandle;
  HeaderSeg: DataSegmentHandle;
  Image: POINTER TO ImageHeader;
  imageDA, HeaderDA: vDA;
  ImageFile: FileHandle;
  diskKD: FileSegmentHandle;
  saveDIW: WORD;
  savePV: ARRAY [0..15] OF UNSPECIFIED;
  saveSDC: WORD;
  saveReadyList: ProcessDefs.Queue;
  saveCurrentPSB: ProcessDefs.ProcessHandle;
  saveCurrentState: ControlDefs.SVPointer;
  page: PageNumber;
  maxbcdsize: CARDINAL _ 0;
  bcdnames: DESCRIPTOR FOR ARRAY OF STRING;
  bcds: DESCRIPTOR FOR ARRAY OF FileSegmentHandle;
  unresolved, exports: BOOLEAN;
  con, nbcds: ConfigIndex;
  time: AltoFileDefs.TIME;
  initgft: LoadStateGFT;
  initstateseg: FileSegmentHandle _ LoadStateDefs.GetInitialLoadState[];
  stateseg: FileSegmentHandle _ LoadStateDefs.GetLoadState[];
  initloadstate: LoadStateDefs.LoadState;
  net: CARDINAL _ MiscDefs.GetNetworkNumber[];
  NullFP: AltoFileDefs.FP = [[1,0,1,17777B,177777B], AltoFileDefs.eofDA];

  SaveProcesses: PROCEDURE =
    BEGIN OPEN ProcessDefs;
    saveDIW _ DIW^;
    savePV _ CV^;
    DIW^ _ 2;
    WakeupsWaiting^ _ 0;
    saveSDC _ SDC^;
    saveReadyList _ ReadyList^;
    saveCurrentPSB _ CurrentPSB^;
    saveCurrentState _ CurrentState^;
    END;
  RestoreProcesses: PROCEDURE =
    BEGIN OPEN ProcessDefs;
    ActiveWord^ _ 77777B;
    DIW^ _ saveDIW;
    CV^ _ savePV;
    SDC^ _ saveSDC;
    ReadyList^ _ saveReadyList;
    CurrentPSB^ _ saveCurrentPSB;
    CurrentState^ _ saveCurrentState;
    END;
  EnterMapItem: PROCEDURE [vmpage: PageNumber, pages: PageCount] =
    BEGIN
    map: POINTER TO ARRAY [0..0) OF normal MapItem = LOOPHOLE[@Image.map];
    IF pages > 127 THEN SIGNAL SwapErrorDuringMakeImage;
    IF mapindex >= MapSpace THEN SIGNAL NoRoomInImageMap;
    map[mapindex] _ MapItem[vmpage, pages, normal[]];
    mapindex _ mapindex + SIZE[normal MapItem];
    END;
  CountFileSegments: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF s # diskKD THEN
      BEGIN
      [] _ BootDefs.PositionSeg[s, FALSE];
      IF s.swappedin THEN
	BEGIN
	swappedinfilepages _ swappedinfilepages + s.pages;
	IF s.class=code THEN
	  maxFileSegPages _ MAX[maxFileSegPages, s.pages];
	END
      ELSE
	BEGIN
	swappedoutfilepages _ swappedoutfilepages + s.pages;
	maxFileSegPages _ MAX[maxFileSegPages, s.pages];
	END
      END;
    RETURN[FALSE];
    END;
  CountDataSegments: PROCEDURE [s: DataSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF s # bufferseg THEN datapages _ datapages + s.pages;
    RETURN[FALSE];
    END;
  MapDataSegments: PROCEDURE [s: DataSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF s # HeaderSeg AND s # bufferseg THEN
      BEGIN
      EnterMapItem[s.VMpage, s.pages];
      nextpage _ nextpage + s.pages;
      END;
    RETURN[FALSE];
    END;
  WriteSwappedIn: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF s.swappedin THEN
      BEGIN
      imageDA _ TransferFileSegment[buffer, s, ImageFile, nextpage, imageDA];
      EnterMapItem[s.VMpage, s.pages];
      nextpage _ nextpage + s.pages;
      END;
    RETURN[FALSE];
    END;
  WriteSwappedOutCode: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF ~s.swappedin AND s.class = code THEN
      BEGIN
      imageDA _ TransferFileSegment[buffer, s, ImageFile, nextpage, imageDA];
      nextpage _ nextpage + s.pages;
      END;
    RETURN[FALSE];
    END;
  WriteSwappedOutNonCode: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF ~s.swappedin AND s.class # code AND s # diskKD THEN
      BEGIN
      imageDA _ TransferFileSegment[buffer, s, ImageFile, nextpage, imageDA];
      nextpage _ nextpage + s.pages;
      END;
    RETURN[FALSE];
    END;
  SaveBcd: PROCEDURE [config: ConfigIndex, addr: BcdAddress] RETURNS [BOOLEAN] =
    BEGIN
    bcds[config] _ LoadStateDefs.BcdSegFromLoadState[config];
    RETURN [FALSE];
    END;

  SD[SDDefs.sAddFileRequest] _ AddFileRequest;
  ImageFile _ GetImageFile[name];
  diskKD _ KDSegment[];
  ProcessDefs.DisableInterrupts[];
  wdc _ REGISTER[WDCreg];
  CoreSwapDefs.SetLevel[-1];
  SaveProcesses[];
  ImageDefs.UserCleanupProc[Save];

-- clean up high banks --									--XM
  BEGIN OPEN XMESA;
  i: XMesaDefs.BankIndex;
  XSegment: PROCEDURE [op: ObjectHandle] RETURNS [BOOLEAN] =
    BEGIN OPEN objptr: LOOPHOLE[op, POINTER TO XObject];
    WITH o: objptr SELECT FROM
      segment =>
	WITH xs: o SELECT FROM
	  data => IF xs.VMpage = 0 THEN SIGNAL XMesaDefs.ImmovableSegmentInHighBank[LOOPHOLE[@xs]];
	  file =>
	    WITH x: xs SELECT FROM
	      remote =>
		IF x.proc = XMremote THEN
		  IF xs.lock # 0 THEN
		    SIGNAL XMesaDefs.ImmovableSegmentInHighBank[LOOPHOLE[@xs]]
		  ELSE XMESA.SwapOutFileSegment[LOOPHOLE[@xs, FileSegmentHandle]];
	      ENDCASE;
	  ENDCASE;
      ENDCASE;
    RETURN[FALSE]
    END;

  MoveLockedCode[direction: down];
  FOR i IN (FIRST[XMesaDefs.BankIndex]..LAST[XMesaDefs.BankIndex]] DO DisableBank[i] ENDLOOP;
  [] _ BootDefs.EnumerateObjects[segment, XSegment];
  END;


-- handle bcds

  SwapIn[initstateseg];
  initloadstate _ FileSegmentAddress[initstateseg];
  MiscDefs.Zero[initloadstate, initstateseg.pages*AltoDefs.PageSize];
  initgft _ DESCRIPTOR[@initloadstate.gft, SD[SDDefs.sGFTLength]];
  bcdstream _ StreamDefs.NewWordStream["makeimage.scratch$", Read+Write+Append];
  nbcds _ LoadStateDefs.InputLoadState[];  -- bring it in for first time
  bcdnames _ GetBcdFileNames[nbcds];
  nbcds _ IF merge THEN 1 ELSE nbcds;
  bcds _ DESCRIPTOR[GetSpace[nbcds], nbcds];
  page _ 0;
  InitLoadStateGFT[initgft, merge, nbcds];
  IF merge THEN
    BEGIN OPEN MIUtilityDefs;
    MergeAllBcds[initgft, code, bcdnames];
    [page, bcds[0]] _ NewBcdSegmentFromStream[bcdstream, page];
    maxbcdsize _ bcds[0].pages;
    END
  ELSE
    BEGIN OPEN MIUtilityDefs;
    [] _ LoadStateDefs.EnumerateLoadStateBcds[recentlast, SaveBcd];
    FOR con IN [0..nbcds) DO
      MergeABcd[con, initgft, code, bcdnames];
      [page, bcds[con]] _ NewBcdSegmentFromStream[bcdstream, page];
      maxbcdsize _ MAX[maxbcdsize, bcds[con].pages];
      ENDLOOP;
    END;
  bcdstream.destroy[bcdstream];
  IF merge THEN PatchUpGFT[];

  [] _ SystemDefs.PruneHeap[];

  SetupAuxStorage[];
  EnumerateNeededModules[LockCodeSegment];
  HeaderDA _ DAofPage[ImageFile, 1];
  -- [] _ FrameDefs.EnumerateGlobalFrames[SwapOutUnlockedCode];
  -- [] _ EnumerateFileSegments[SwapOutUnlocked];

  -- set up private frame allocation trap
  ControlDefs.Free[ControlDefs.Alloc[0]]; -- flush large frames
  savealloctrap _ SD[SDDefs.sAllocTrap];
  SD[SDDefs.sAllocTrap] _ auxtrapFrame _ auxtrap[];
  saveAllocationVector _ AV^;
  AV^ _ LOOPHOLE[DataSegmentAddress[AuxSeg], POINTER TO AllocationVector]^;

  BufferPages _ maxbcdsize+initstateseg.pages;
  bufferseg _ NewDataSegment[DefaultBase, BufferPages];
  [] _ EnumerateDataSegments[CountDataSegments];
  swappedinfilepages _ swappedoutfilepages _ 0;
  [] _ EnumerateFileSegments[CountFileSegments];
  SetEndOfFile[ImageFile,
    datapages+swappedinfilepages+swappedoutfilepages+FirstImageDataPage-1,
    AltoDefs.BytesPerPage];
  [] _ DiskKDDefs.CloseDiskKD[];

  HeaderSeg _ NewDataSegment[DefaultBase, 1];
  Image _ DataSegmentAddress[HeaderSeg];
  MiscDefs.Zero[Image,ImageDefs.HeaderPages*AltoDefs.PageSize];
  Image.prefix.versionident _ ImageDefs.VersionID;
--Image.prefix.options _ 0;
--Image.prefix.state.stk[0] _ Image.prefix.state.stk[1] _ 0;
  Image.prefix.state.stkptr _ 2;
  Image.prefix.state.dest _ REGISTER[Lreg];
  Image.prefix.type _ makeimage;
  Image.prefix.leaderDA _ ImageFile.fp.leaderDA;
  time _ MiscDefs.DAYTIME[];
  Image.prefix.version _ BcdDefs.VersionStamp[
    time: TimeDefs.PackedTime[lowbits: time.low, highbits: time.high],
    zapped: FALSE,
    net: net,
    host: OsStaticDefs.OsStatics.SerialNumber];
  Image.prefix.creator _ ImageDefs.ImageVersion[]; -- version stamp of currently running image

  nextpage _ FirstImageDataPage;
  [] _ SegmentDefs.EnumerateDataSegments[MapDataSegments];
  IF nextpage # FirstImageDataPage+datapages THEN ERROR;
  endofdatamapindex _ mapindex;

  -- now disable swapping
  saveswaptrap _ SD[SDDefs.sSwapTrap];
  SD[SDDefs.sSwapTrap] _ SwapTrapError;
  AllocDefs.AddSwapStrategy[@SwapOutErrorStrategy];
  imageDA _ DAofPage[ImageFile, nextpage];
  buffer _ SegmentDefs.DataSegmentAddress[bufferseg];
  [] _ SegmentDefs.EnumerateFileSegments[WriteSwappedIn];
  IF nextpage # FirstImageDataPage+datapages+swappedinfilepages THEN ERROR;
  [] _ SegmentDefs.EnumerateFileSegments[WriteSwappedOutCode];
  [] _ SegmentDefs.EnumerateFileSegments[WriteSwappedOutNonCode];
  SegmentDefs.DeleteDataSegment[bufferseg];

  SegmentDefs.CloseFile[ImageFile ! SegmentDefs.FileError => RESUME];
  ImageFile.write _ ImageFile.append _ FALSE;

  FOR con IN [0..nbcds) DO
    [unresolved, exports] _ MapSegmentsInBcd[initgft, con, bcds[con]];
    initloadstate.bcds[con] _ [fp: NullFP, da: AltoFileDefs.eofDA,
      base: bcds[con].base, unresolved: unresolved, exports: exports,
      pages: bcds[con].pages, fill: 0];
    ENDLOOP;
  SegmentDefs.SwapUp[initstateseg];
  Image.prefix.loadStateBase _ stateseg.base;
  Image.prefix.initialLoadStateBase _ initstateseg.base;
  Image.prefix.loadStatePages _ initstateseg.pages;

  diskrequest _ DiskRequest[
    ca: auxalloc[datapages+3],
    da: auxalloc[datapages+3],
    fixedCA: FALSE,
    fp: auxalloc[SIZE[FP]],
    firstPage: FirstImageDataPage-1,
    lastPage: FirstImageDataPage+datapages-1,
    action: WriteD,
    lastAction: WriteD,
    signalCheckError: FALSE,
    option: update[BFSDefs.GetNextDA]];

  diskrequest.fp^ _ ImageFile.fp;
  [] _ SegmentDefs.EnumerateFileSegments[BashHint];
  [] _ SegmentDefs.EnumerateFiles[BashFile];
  (diskrequest.ca+1)^ _ Image;
  FillInCAs[Image, endofdatamapindex, diskrequest.ca+2];
  MiscDefs.SetBlock[diskrequest.da,fillinDA,datapages+3];
  (diskrequest.da+1)^ _ HeaderDA;

  saveXferTrap _ SD[SDDefs.sXferTrap];
  SD[SDDefs.sXferTrap] _ REGISTER[Lreg];
  saveXferTrapStatus _ REGISTER[XTSreg];

  [lpn,numChars] _ BFSDefs.ActOnPages[LOOPHOLE[@diskrequest]];
  IF lpn # 0 OR numChars # 0 THEN
    BEGIN
    DisplayHeader^ _ SD[SDDefs.sGoingAway] _ 0;
    ImageDefs.StopMesa[];
    END;
  REGISTER[WDCreg] _ wdc;
  AV^ _ saveAllocationVector;
  SD[SDDefs.sAllocTrap] _ savealloctrap;
  SD[SDDefs.sXferTrap] _ saveXferTrap;
  REGISTER[XTSreg] _ saveXferTrapStatus;
  SD[SDDefs.sAddFileRequest] _ 0;
  Free[auxtrapFrame];
  XMESA.InitMemoryConfig[];									--XM
  SegmentDefs.DeleteDataSegment[HeaderSeg];
  ptSeg _ SegmentDefs.NewDataSegment[PageFromAddress[ptPointer^],1];
  [] _ DiskDefs.ResetDisk[];
  DiskKDDefs.InitializeDiskKD[];
  BootPageTable[ImageFile, ptPointer^];
  SegmentDefs.DeleteDataSegment[ptSeg];

  -- set up high banks --									--XM
  BEGIN OPEN XMesaDefs;
  i: BankIndex;
  memoryConfig: MemoryConfig _ GetMemoryConfig[];
  IF memoryConfig.useXM THEN
    FOR i IN (FIRST[BankIndex]..LAST[BankIndex]] DO
      IF InlineDefs.BITAND[XMESA.BankMasks[i], memoryConfig.banks] # 0 THEN XMESA.EnableBank[i] ENDLOOP;
  END;

  -- turn swapping back on
  AllocDefs.RemoveSwapStrategy[@SwapOutErrorStrategy];
  SD[SDDefs.sSwapTrap] _ saveswaptrap;

  RestoreProcesses[];
  ProcessDefs.EnableInterrupts[];
  ProcessFileRequests[];

  InlineDefs.COPY[from: initloadstate, to: FileSegmentAddress[stateseg],
    nwords: initstateseg.pages*AltoDefs.PageSize];
  FOR con IN [0..nbcds) DO
    LoadStateDefs.UpdateLoadState[con, bcds[con],
      initloadstate.bcds[con].unresolved, initloadstate.bcds[con].exports];
    DeleteFileSegment[bcds[con]];
    ENDLOOP;
  LoadStateDefs.ReleaseLoadState[];
  SegmentDefs.Unlock[initstateseg];
  SegmentDefs.SwapOut[initstateseg];
  SegmentDefs.DeleteDataSegment[AuxSeg];

  FreeAllSpace[];
  EnumerateNeededModules[UnlockCodeSegment];
  XMESA.MoveLockedCode[direction: up];								--XM
  SwapOutMakeImageCode[];
  ImageDefs.UserCleanupProc[Restore];
  RETURN
  END;



-- auxillary storage for frames and non-saved items
AuxSeg: DataSegmentHandle;
freepointer: POINTER;
wordsleft: CARDINAL;

SetupAuxStorage: PROCEDURE =
  BEGIN
  av : POINTER;
  i: CARDINAL;
  AuxSeg _ NewDataSegment[DefaultBase,10];
  av _ freepointer _ DataSegmentAddress[AuxSeg];
  wordsleft _ 10*AltoDefs.PageSize;
  [] _ auxalloc[AllocationVectorSize];
  freepointer _ freepointer+3; wordsleft _ wordsleft-3;
  FOR i IN [0..MaxAllocSlot) DO
    (av+i)^ _ (i+1)*4+2;
    ENDLOOP;
  (av+6)^ _ (av+MaxAllocSlot)^ _ (av+MaxAllocSlot+1)^ _ 1;
  END;

auxalloc: PROCEDURE [n: CARDINAL] RETURNS [p: POINTER] =
  BEGIN -- allocate in multiples of 4 words
  p _ freepointer;
  n _ InlineDefs.BITAND[n+3,177774B];
  freepointer _ freepointer+n;
  IF wordsleft < n THEN ImageDefs.PuntMesa[];
  wordsleft _ wordsleft-n;
  RETURN
  END;

auxtrap: PROCEDURE RETURNS [myframe: FrameHandle] =
  BEGIN
  state: StateVector;
  newframe: FrameHandle;
  eventry: POINTER TO EntryVectorItem;
  fsize, findex: CARDINAL;
  newG: GlobalFrameHandle;
  dest, tempdest: ControlLink;
  alloc: BOOLEAN;
  gfi: GFTIndex;
  ep: CARDINAL;

  myframe _ LOOPHOLE[REGISTER[Lreg]];
  state.dest _ myframe.returnlink; state.source _ 0;
  state.instbyte_0;
  state.stk[0]_myframe;
  state.stkptr_1;

  ProcessDefs.DisableInterrupts[];

  DO
    ProcessDefs.EnableInterrupts[];
    TRANSFER WITH state;
  
    ProcessDefs.DisableInterrupts[];
    state _ STATE;
  
    dest _ LOOPHOLE[REGISTER[ATPreg]];
    myframe.returnlink _ state.source;
    tempdest _ dest;
    DO 
      SELECT tempdest.tag FROM
	frame =>
	  BEGIN
	  alloc _ TRUE;
	  findex _ LOOPHOLE[tempdest, CARDINAL]/4;
	  EXIT
	  END;
	procedure =>
	  BEGIN OPEN proc: LOOPHOLE[tempdest, ControlDefs.ProcDesc];
	  gfi _ proc.gfi;  ep _ proc.ep;
	  [frame: newG, epbase: findex] _ GFT[gfi];
	  eventry _ @newG.code.prefix.entry[findex+ep];
	  findex _ eventry.framesize;
	  alloc _ FALSE;
	  EXIT
	  END;
	indirect => tempdest _ tempdest.link^;
	ENDCASE => ImageDefs.PuntMesa[];
      ENDLOOP;

    IF findex >= MaxAllocSlot THEN ImageDefs.PuntMesa[]
    ELSE
      BEGIN
      fsize _ FrameVec[findex]+1;  -- includes overhead word
      newframe _ LOOPHOLE[freepointer+1];
      freepointer^ _ findex;
      freepointer _ freepointer + fsize;
      IF wordsleft < fsize THEN ImageDefs.PuntMesa[]
      ELSE wordsleft _ wordsleft - fsize;
      END;
  
    IF alloc THEN
      BEGIN
      state.dest _ myframe.returnlink;
      state.stk[state.stkptr] _ newframe;
      state.stkptr _ state.stkptr+1;
      END
    ELSE
      BEGIN
      IF dest.tag # indirect THEN
	BEGIN
	state.dest _ newframe;
	newframe.accesslink _ newG;
	newframe.pc _ eventry.initialpc;
	newframe.returnlink _ myframe.returnlink;
	END
      ELSE
	BEGIN
	IF findex = MaxAllocSlot THEN ImageDefs.PuntMesa[];
	state.dest _ dest;
	newframe.accesslink _ LOOPHOLE[AV[findex].frame];
	AV[findex].frame _ newframe;
	END;
      state.source _ myframe.returnlink;
      END;
  
    ENDLOOP;
    END;

  PageTable: TYPE = MACHINE DEPENDENT RECORD [
    fp: AltoFileDefs.CFP,
    firstpage: CARDINAL,
    table: ARRAY [0..1) OF DiskDefs.DA];
  ptPointer: POINTER TO POINTER TO PageTable = LOOPHOLE[24B];

  BootPageTable: PROCEDURE [file:FileHandle, pt:POINTER TO PageTable] =
    BEGIN OPEN AltoFileDefs;
    lastpage: PageNumber;
    pageInc: PageNumber = pt.firstpage - ImageDefs.FirstImageDataPage;
    PlugHint: PROCEDURE [seg:FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      IF seg.file = file THEN
	BEGIN
	seg.base _ seg.base + pageInc;
	IF seg.base IN [pt.firstpage..lastpage] THEN
	  WITH s: seg SELECT FROM
	    disk => s.hint _ FileHint[
	      page: s.base,
	      da: DiskDefs.VirtualDA[pt.table[s.base-pt.firstpage]]];
	    ENDCASE;
	END;
      RETURN[FALSE]
      END;
    DropFileRequest[file];
    file.open _ TRUE;
    file.fp _ FP[serial: pt.fp.serial, leaderDA: pt.fp.leaderDA];
    FOR lastpage _ 0, lastpage+1
    UNTIL pt.table[lastpage] = DiskDefs.DA[0,0,0,0,0]
      DO NULL ENDLOOP;
    IF lastpage = 0 THEN RETURN;
    lastpage _ lastpage+pt.firstpage-1;
    [] _ EnumerateFileSegments[PlugHint];
    RETURN
    END;

-- The driver

  MakeImage: PUBLIC PROCEDURE [name: STRING] =
    BEGIN
    s: StateVector;
    InitFileRequest[];
    InitSpace[];
    s.stk[0] _ REGISTER[Greg];
    s.stkptr _ 1;
    s.instbyte _ 0;
    s.dest _ FrameDefs.SwapOutCode;
    s.source _ GetReturnLink[];
    InstallImage[name, TRUE, TRUE];
    RETURN WITH s;
    END;

  MakeUnMergedImage: PUBLIC PROCEDURE [name: STRING] =
    BEGIN
    s: StateVector;
    InitFileRequest[];
    InitSpace[];
    s.stk[0] _ REGISTER[Greg];
    s.stkptr _ 1;
    s.instbyte _ 0;
    s.dest _ FrameDefs.SwapOutCode;
    s.source _ GetReturnLink[];
    InstallImage[name, FALSE, TRUE];
    RETURN WITH s;
    END;

  END..