-- MakeImage.Mesa   Edited by Sandman on  September 24, 1980  10:46 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AllocDefs USING [
    AddSwapStrategy, RemoveSwapStrategy, SwappingProcedure, SwapStrategy],
  AltoDefs USING [BytesPerPage, PageCount, PageNumber, PageSize],
  AltoDisplay USING [DCBchainHead],
  AltoFileDefs USING [CFA, CFP, eofDA, fillinDA, FP, vDA],
  BcdDefs USING [VersionStamp],
  BcdMergeOps USING [MergeBcd],
  BcdOps USING [ProcessModules],
  SymbolOps: FROM "BcdSymbolOps" USING [FindString],
  BFSDefs USING [ActOnPages, GetNextDA],
  ControlDefs USING [
    AllocationVector, AllocationVectorSize, AV, ControlLink, EntryVectorItem,
    FrameHandle, FrameVec, GFT, GFTIndex, GlobalFrameHandle, LargeReturnSlot,
    LastAVSlot, PrefixHandle, ProcDesc, SpecialReturnSlot, StateVector,
    SVPointer],
  CoreSwapDefs USING [level],
  DiskDefs USING [
    DA, DiskPageDesc, DiskRequest, StandardDisk, SwapPages, sysDisk, VirtualDA],
  DiskKDDefs USING [CloseDiskKD, InitializeDiskKD],
  FrameDefs USING [GlobalFrame, SwapOutCode],
  FrameOps USING [
    CodeHandle, FlushLargeFrames, Free, GetReturnLink, MyGlobalFrame,
    MyLocalFrame],
  ImageDefs USING [
    FileRequest, ImageVersion, PuntMesa, StopMesa, UserCleanupProc],
  ImageFormat USING [
    FirstImageDataPage, HeaderPages, ImageHeader, MapItem, MapSpace, VersionID],
  InlineDefs USING [BITAND, COPY],
  LoadStateOps USING [ForceDirty, initstate, ReleaseLoadState, state],
  MiscDefs USING [CurrentTime, GetNetworkNumber, SetBlock, Zero],
  MakeImageOps USING [
    AddFileRequest, BashFile, BashHint, DAofPage, DropFileRequest, FillInCAs,
    FreeAllSpace, InitFileRequest, InitLoadStates, InitSpace, KDSegment,
    LockCodeSegment, ProcessBcds, ProcessFileRequests, UnlockCodeSegment],
  NucleusOps USING [
    BFS, Directory, DiskKD, Faults, Files, FSP, HyperRegion, LoadState, MesaInit,
    Miscellaneous, Modules, NonResident, OurProcess, SegmentsA, SegmentsB,
    StreamsA, StreamsB, StreamsC, StringsA, StringsB],
  OsStaticDefs USING [OsStatics],
  ProcessDefs USING [
    CV, DisableInterrupts, DIW, EnableInterrupts, Priority, SetPriority],
  ProcessOps USING [
    ActiveWord, CurrentPSB, CurrentState, FirstProcess, LastProcess,
    NullQueueHandle, Queue, ReadWDC, ReadyList, Requeue, WakeupsWaiting,
    WriteWDC],
  PSBDefs USING [ProcessHandle, PSB],
  Region USING [Node, NodeObject],
  SDDefs USING [
    sAddFileRequest, sAllocTrap, SD, sGoingAway, sSwapTrap, sXferTrap],
  SegmentDefs USING [
    AddressFromPage, Append, CloseFile, DataSegmentAddress, DataSegmentHandle,
    DefaultMDSBase, DefaultVersion, DeleteDataSegment, EasyDown,
    EnumerateDataSegments, EnumerateFiles, EnumerateFileSegments, FileError,
    FileHandle, FileHint, FileSegmentAddress, FileSegmentHandle, HardDown,
    MakeDataSegment, NewFile, Object, ObjectHandle, Read, ReleaseFile, SetEndOfFile,
    SetFileSegmentDA, SwapOut, Unlock, Write],
  StreamDefs USING [StreamHandle],
  SwapperOps USING [
    AllocateObject, LiberateObject, PositionSeg, mdsNodes, MoveCode, DisableHyperspace,
    EnableHyperspace, InitMemoryConfig],
  Storage USING [Prune, PagesForWords],
  Table USING [Allocate],
  TrapOps USING [ReadATP, ReadOTP, ReadXTS, WriteXTS];

MakeImage: PROGRAM
  IMPORTS
    AllocDefs, BcdMergeOps, BcdOps, SymbolOps, BFSDefs, CoreSwapDefs, DiskDefs,
    DiskKDDefs, FrameDefs, FrameOps, ImageDefs, InlineDefs, LoadStateOps,
    MiscDefs, MakeImageOps, NucleusOps, ProcessDefs, ProcessOps, SegmentDefs,
    SwapperOps, Storage, Table, TrapOps
  EXPORTS ImageDefs
  SHARES ProcessDefs, DiskDefs, SegmentDefs, ControlDefs, ImageDefs =
  BEGIN OPEN DiskDefs, ImageDefs, ControlDefs, SegmentDefs, MakeImageOps;

  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;
  vDA: TYPE = AltoFileDefs.vDA;
  GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
  StreamHandle: TYPE = StreamDefs.StreamHandle;
  ProcDesc: TYPE = ControlDefs.ProcDesc;

  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 _ TrapOps.ReadOTP[];
    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 _ 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 [GlobalFrameHandle]] =
    BEGIN
    proc[FrameDefs.GlobalFrame[EnumerateNeededModules]];
    proc[FrameDefs.GlobalFrame[MakeImageOps.AddFileRequest]];
    proc[FrameDefs.GlobalFrame[BcdOps.ProcessModules]];
    proc[LOOPHOLE[NucleusOps.BFS]];
    proc[LOOPHOLE[NucleusOps.SegmentsA]];
    proc[LOOPHOLE[NucleusOps.SegmentsB]];
    proc[LOOPHOLE[NucleusOps.Files]];
    proc[LOOPHOLE[NucleusOps.Faults]];
    proc[LOOPHOLE[NucleusOps.DiskKD]];
    proc[LOOPHOLE[NucleusOps.Miscellaneous]];
    proc[LOOPHOLE[NucleusOps.Directory]];
    proc[LOOPHOLE[NucleusOps.StreamsA]];
    proc[LOOPHOLE[NucleusOps.StreamsB]];
    proc[LOOPHOLE[NucleusOps.StreamsC]];
    proc[LOOPHOLE[NucleusOps.FSP]];
    proc[LOOPHOLE[NucleusOps.StringsA]];
    proc[LOOPHOLE[NucleusOps.StringsB]];
    proc[LOOPHOLE[NucleusOps.LoadState]];
    proc[LOOPHOLE[NucleusOps.MesaInit]];
    proc[LOOPHOLE[NucleusOps.NonResident]];
    proc[LOOPHOLE[NucleusOps.OurProcess]];
    proc[LOOPHOLE[NucleusOps.HyperRegion]];
    proc[LOOPHOLE[NucleusOps.Modules]];
    END;

  SwapOutMakeImageCode: PROCEDURE =
    BEGIN OPEN FrameDefs;
    SwapOutCode[GlobalFrame[MakeImageOps.AddFileRequest]];
    SwapOutCode[GlobalFrame[Table.Allocate]];
    SwapOutCode[GlobalFrame[SymbolOps.FindString]];
    SwapOutCode[GlobalFrame[BcdOps.ProcessModules]];
    SwapOutCode[GlobalFrame[LoadStateOps.ReleaseLoadState]];
    SwapOutCode[GlobalFrame[BcdMergeOps.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 = FrameOps.CodeHandle[GFT[ResidentGFI].frame].file THEN
      SIGNAL InvalidImageName;
    RETURN
    END;

  GetSegment: PROCEDURE [pages: CARDINAL] RETURNS [DataSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    RETURN[MakeDataSegment[base: DefaultMDSBase, pages: pages, info: HardDown]];
    END;

  AssureObjects: PROCEDURE = {
    OPEN SwapperOps, SegmentDefs;
    a: FileHandle;
    b: DataSegmentHandle;
    c: FileSegmentHandle;
    a _ LOOPHOLE[SwapperOps.AllocateObject[SIZE[file Object]]];
    a^ _ [,file[,,,,,,,,,,,]];
    b _ LOOPHOLE[SwapperOps.AllocateObject[SIZE[data segment Object]]];
    b^ _ [,segment[,data[,]]];
    c _ LOOPHOLE[SwapperOps.AllocateObject[SIZE[file segment Object]]];
    c^ _ [,segment[,file[,,,,,,,,]]];
    SwapperOps.LiberateObject[a];
    SwapperOps.LiberateObject[b];
    SwapperOps.LiberateObject[c]};

  InstallImage: PROCEDURE [name: STRING, merge: 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;
    HeaderSeg: DataSegmentHandle;
    Image: POINTER TO ImageFormat.ImageHeader;
    imageDA, HeaderDA: vDA;
    ImageFile: FileHandle;
    diskKD: FileSegmentHandle;
    saveDIW: WORD;
    savePV: ARRAY [0..15] OF UNSPECIFIED;
    saveReadyList: ProcessOps.Queue;
    savePriority: ProcessDefs.Priority;
    saveCurrentPSB: PSBDefs.ProcessHandle;
    saveCurrentState: ControlDefs.SVPointer;
    initstateseg: FileSegmentHandle _ LoadStateOps.initstate;
    stateseg: FileSegmentHandle _ LoadStateOps.state;
    net: CARDINAL _ MiscDefs.GetNetworkNumber[];
    maxbcdsize: CARDINAL;
    creator: BcdDefs.VersionStamp _ ImageDefs.ImageVersion[];
    mdsFreeList: DESCRIPTOR FOR ARRAY OF Region.NodeObject;
    SaveMDSFreeList: PROCEDURE =
      BEGIN OPEN SwapperOps;
      nNodes, i: CARDINAL;
      node: Region.Node;
      nNodes _ 0;
      FOR node _ mdsNodes.fwd, node.fwd UNTIL node = @mdsNodes DO
	nNodes _ nNodes + 1; ENDLOOP;
      IF nNodes = 0 THEN BEGIN mdsFreeList _ DESCRIPTOR[NIL, 0]; RETURN END;
      mdsFreeList _ DESCRIPTOR[auxalloc[nNodes*SIZE[Region.NodeObject]], nNodes];
      i _ 0;
      FOR node _ mdsNodes.fwd, node.fwd UNTIL node = @mdsNodes DO
	mdsFreeList[i] _ node^; i _ i + 1; ENDLOOP;
      END;
    RestoreMDSFreeList: PROCEDURE =
      BEGIN OPEN SwapperOps;
      i: CARDINAL _ 0;
      node: Region.Node;
      IF LENGTH[mdsFreeList] = 0 THEN RETURN;
      FOR i IN [0..LENGTH[mdsFreeList]) DO
	node _ AddressFromPage[mdsFreeList[i].base];
	node^ _ mdsFreeList[i];
	ENDLOOP;
      END;
    SaveProcesses: PROCEDURE =
      BEGIN OPEN ProcessOps;
      saveDIW _ ProcessDefs.DIW^;
      ProcessDefs.DIW^ _ 0;
      savePV _ ProcessDefs.CV^;
      WakeupsWaiting^ _ 0;
      saveReadyList _ ReadyList^;
      saveCurrentPSB _ CurrentPSB^;
      savePriority _ CurrentPSB.priority;
      saveCurrentState _ CurrentState^;
      END;
    RestoreProcesses: PROCEDURE =
      BEGIN OPEN ProcessDefs, ProcessOps;
      p: PSBDefs.ProcessHandle;
      ActiveWord^ _ 77777B;
      ProcessDefs.DIW^ _ saveDIW;
      ProcessDefs.CV^ _ savePV;
      ReadyList^ _ saveReadyList;
      CurrentPSB^ _ saveCurrentPSB;
      CurrentPSB.priority _ LAST[Priority];
      CurrentState^ _ saveCurrentState;
      FOR p _ FirstProcess^, p + SIZE[PSBDefs.PSB] UNTIL p = LastProcess^ DO
	IF p.state = alive AND p.timeout # 0 AND p.waitingOnCV THEN
	  BEGIN
	  p.waitingOnCV _ FALSE;
	  Requeue[from: NullQueueHandle, to: ReadyList, p: p];
	  END;
	ENDLOOP;
      SetPriority[savePriority];
      RETURN
      END;
    EnterMapItem: PROCEDURE [vmpage: PageNumber, pages: PageCount] =
      BEGIN OPEN ImageFormat;
      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
	[] _ SwapperOps.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 # HeaderSeg AND 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;
    SDDefs.SD[SDDefs.sAddFileRequest] _ AddFileRequest;
    ImageFile _ GetImageFile[name];
    diskKD _ KDSegment[];
    ProcessDefs.DisableInterrupts[];
    wdc _ ProcessOps.ReadWDC[];
    CoreSwapDefs.level _ -1;
    SaveProcesses[];
    ImageDefs.UserCleanupProc[Save];
    maxbcdsize _ ProcessBcds[initstateseg, merge];
    [] _ Storage.Prune[];
    SwapperOps.MoveCode[direction: intoMDS];
    SwapperOps.DisableHyperspace[];
    SetupAuxStorage[];
    EnumerateNeededModules[LockCodeSegment];
    HeaderDA _ DAofPage[ImageFile, 1];
    -- [] _ FrameDefs.EnumerateGlobalFrames[SwapOutUnlockedCode];
    -- [] _ EnumerateFileSegments[SwapOutUnlocked];
    -- set up private frame allocation trap
    FrameOps.FlushLargeFrames[];
    savealloctrap _ SDDefs.SD[SDDefs.sAllocTrap];
    SDDefs.SD[SDDefs.sAllocTrap] _ auxtrapFrame _ auxtrap[];
    saveAllocationVector _ AV^;
    AV^ _ LOOPHOLE[DataSegmentAddress[AuxSeg], POINTER TO AllocationVector]^;
    BufferPages _ maxbcdsize + initstateseg.pages;
    bufferseg _ GetSegment[BufferPages];
    HeaderSeg _ GetSegment[1];
    datapages _ 0;
    AssureObjects[];
    [] _ EnumerateDataSegments[CountDataSegments];
    swappedinfilepages _ swappedoutfilepages _ 0;
    [] _ EnumerateFileSegments[CountFileSegments];
    SetEndOfFile[
      ImageFile,
      datapages + swappedinfilepages + swappedoutfilepages +
	ImageFormat.FirstImageDataPage - 1, AltoDefs.BytesPerPage];
    [] _ DiskKDDefs.CloseDiskKD[];
    Image _ DataSegmentAddress[HeaderSeg];
    MiscDefs.Zero[Image, ImageFormat.HeaderPages*AltoDefs.PageSize];
    Image.prefix.versionident _ ImageFormat.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 _ FrameOps.MyLocalFrame[];
    Image.prefix.type _ makeimage;
    Image.prefix.diskAddresses _ Image;
    Image.prefix.leaderDA _ ImageFile.fp.leaderDA;
    Image.prefix.version _ BcdDefs.VersionStamp[
      time: MiscDefs.CurrentTime[], net: net,
      host: OsStaticDefs.OsStatics.SerialNumber];
    Image.prefix.creator _ creator; -- now disable swapping
    saveswaptrap _ SDDefs.SD[SDDefs.sSwapTrap];
    SDDefs.SD[SDDefs.sSwapTrap] _ SwapTrapError;
    AllocDefs.AddSwapStrategy[@SwapOutErrorStrategy];
    datapages _ 0;
    [] _ EnumerateDataSegments[CountDataSegments];
    swappedinfilepages _ swappedoutfilepages _ 0;
    [] _ EnumerateFileSegments[CountFileSegments];
    nextpage _ ImageFormat.FirstImageDataPage;
    [] _ SegmentDefs.EnumerateDataSegments[MapDataSegments];
    IF nextpage # ImageFormat.FirstImageDataPage + datapages THEN ERROR;
    endofdatamapindex _ mapindex;
    imageDA _ DAofPage[ImageFile, nextpage];
    buffer _ SegmentDefs.DataSegmentAddress[bufferseg];
    [] _ SegmentDefs.EnumerateFileSegments[WriteSwappedIn];
    IF nextpage # ImageFormat.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;
    InitLoadStates[stateseg];
    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: ImageFormat.FirstImageDataPage - 1,
      lastPage: ImageFormat.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;
    SaveMDSFreeList[];
    saveXferTrap _ SDDefs.SD[SDDefs.sXferTrap];
    SDDefs.SD[SDDefs.sXferTrap] _ FrameOps.MyLocalFrame[];
    saveXferTrapStatus _ TrapOps.ReadXTS[];
    [lpn, numChars] _ BFSDefs.ActOnPages[LOOPHOLE[@diskrequest]];
    IF lpn # 0 OR numChars # 0 THEN
      BEGIN
      AltoDisplay.DCBchainHead^ _ SDDefs.SD[SDDefs.sGoingAway] _ NIL;
      ImageDefs.StopMesa[];
      END;
    ProcessOps.WriteWDC[wdc];
    AV^ _ saveAllocationVector;
    SDDefs.SD[SDDefs.sAllocTrap] _ savealloctrap;
    SDDefs.SD[SDDefs.sXferTrap] _ saveXferTrap;
    TrapOps.WriteXTS[saveXferTrapStatus];
    SDDefs.SD[SDDefs.sAddFileRequest] _ 0;
    FrameOps.Free[auxtrapFrame];
    RestoreMDSFreeList[];
    SwapperOps.InitMemoryConfig[];
    BootImageFile[ImageFile, LOOPHOLE[Image]];
    DiskDefs.sysDisk _ DiskDefs.StandardDisk;
    DiskKDDefs.InitializeDiskKD[];
    BootPageTable[ImageFile, LOOPHOLE[Image]];
    SegmentDefs.DeleteDataSegment[HeaderSeg]; -- turn swapping back on
    AllocDefs.RemoveSwapStrategy[@SwapOutErrorStrategy];
    SDDefs.SD[SDDefs.sSwapTrap] _ saveswaptrap;
    SwapperOps.EnableHyperspace[];
    CollectDiskAddresses[ImageFile];
    RestoreProcesses[];
    ProcessDefs.EnableInterrupts[];
    ProcessFileRequests[];
    InlineDefs.COPY[
      from: SegmentDefs.FileSegmentAddress[initstateseg],
      to: SegmentDefs.FileSegmentAddress[stateseg],
      nwords: stateseg.pages*AltoDefs.PageSize];
    LoadStateOps.ForceDirty[];
    LoadStateOps.ReleaseLoadState[];
    SegmentDefs.Unlock[initstateseg];
    SegmentDefs.SwapOut[initstateseg];
    SegmentDefs.DeleteDataSegment[AuxSeg];
    FreeAllSpace[];
    EnumerateNeededModules[UnlockCodeSegment];
    SwapperOps.MoveCode[direction: outofMDS];
    SwapOutMakeImageCode[];
    ImageDefs.UserCleanupProc[Restore];
    RETURN
    END;

  -- auxillary storage for frames and non-saved items

  AuxSeg: DataSegmentHandle;
  freepointer: POINTER;
  wordsleft: CARDINAL;
  StoragePages: CARDINAL = 10;

  SetupAuxStorage: PROCEDURE =
    BEGIN
    av: POINTER;
    i: CARDINAL;
    AuxSeg _ GetSegment[StoragePages];
    av _ freepointer _ DataSegmentAddress[AuxSeg];
    wordsleft _ StoragePages*AltoDefs.PageSize;
    [] _ auxalloc[AllocationVectorSize];
    freepointer _ freepointer + 3;
    wordsleft _ wordsleft - 3;
    FOR i IN [0..LastAVSlot] DO (av + i)^ _ (i + 1)*4 + 2; ENDLOOP;
    (av + 6)^ _ (av + LargeReturnSlot)^ _ (av + SpecialReturnSlot + 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[FrameOps.MyLocalFrame[]];
    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 _ TrapOps.ReadATP[];
      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 _ @LOOPHOLE[newG.code.shortbase, PrefixHandle].entry[
	      findex + ep];
	    findex _ eventry.info.framesize;
	    alloc _ FALSE;
	    EXIT
	    END;
	  indirect => tempdest _ tempdest.link^;
	  ENDCASE => ImageDefs.PuntMesa[];
	ENDLOOP;
      IF findex > LastAVSlot THEN ImageDefs.PuntMesa[];
      fsize _ FrameVec[findex];
      IF fsize MOD 4 # 0 THEN fsize _ fsize + 1;
      newframe _ LOOPHOLE[freepointer + 1];
      freepointer^ _ findex;
      freepointer _ freepointer + fsize;
      IF wordsleft < fsize THEN ImageDefs.PuntMesa[]
      ELSE wordsleft _ wordsleft - fsize;
      IF alloc THEN
	BEGIN
	state.dest _ myframe.returnlink;
	state.stk[state.stkptr] _ newframe;
	state.stkptr _ state.stkptr + 1;
	END
      ELSE
	BEGIN
	state.dest _ dest;
	newframe.accesslink _ LOOPHOLE[AV[findex].frame];
	AV[findex].frame _ newframe;
	state.source _ myframe.returnlink;
	END;
      ENDLOOP;
    END;

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

  BootImageFile: PROCEDURE [file: FileHandle, pt: POINTER TO PageTable] =
    BEGIN OPEN AltoFileDefs;
    DropFileRequest[file];
    file.open _ TRUE;
    file.fp _ FP[serial: pt.fp.serial, leaderDA: pt.fp.leaderDA];
    RETURN
    END;

  BootPageTable: PROCEDURE [file: FileHandle, pt: POINTER TO PageTable] =
    BEGIN OPEN AltoFileDefs;
    lastpage: PageNumber;
    pageInc: PageNumber = pt.firstpage - ImageFormat.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;

    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;

  CollectDiskAddresses: PROCEDURE [imageFile: FileHandle] =
    BEGIN OPEN Storage, SegmentDefs, AltoFileDefs;
    DAs: DESCRIPTOR FOR ARRAY OF vDA;
    maxunknown, maxknown: CARDINAL _ FIRST[CARDINAL];
    minunknown: CARDINAL _ LAST[CARDINAL];
    maxknownDA: vDA;
    DisplayHead: POINTER TO WORD = LOOPHOLE[420B];
    saveDisplay: WORD;
    diskrequest: DiskDefs.DiskRequest;
    bufseg, DAseg: DataSegmentHandle;

    FindEnds: PROCEDURE [seg: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      WITH s: seg SELECT FROM
	disk =>
	  IF s.file = imageFile AND s.hint.da = eofDA THEN
	    BEGIN
	    maxunknown _ MAX[maxunknown, s.base];
	    minunknown _ MIN[minunknown, s.base];
	    END;
	ENDCASE;
      RETURN[FALSE];
      END;

    -- of FindEnds --

    FindKnown: PROCEDURE [seg: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      WITH s: seg SELECT FROM
	disk =>
	  IF s.file = imageFile AND s.hint.da # eofDA AND s.base < minunknown AND
	    s.base > maxknown THEN
	    BEGIN maxknown _ s.base; maxknownDA _ s.hint.da END;
	ENDCASE;
      RETURN[FALSE];
      END;

    -- of FindKnown --

    PlugDA: PROCEDURE [seg: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      WITH s: seg SELECT FROM
	disk =>
	  IF s.file = imageFile AND s.hint.da = eofDA AND s.base IN
	    (maxknown..maxunknown] THEN
	    SegmentDefs.SetFileSegmentDA[@s, DAs[s.base]];
	ENDCASE;
      RETURN[FALSE];
      END;

    -- of PlugDA --
    saveDisplay _ DisplayHead^;
    DisplayHead^ _ 0;
    [] _ EnumerateFileSegments[FindEnds];
    [] _ EnumerateFileSegments[FindKnown];
    bufseg _ MakeDataSegment[DefaultMDSBase, 1, EasyDown];
    DAseg _ MakeDataSegment[
      DefaultMDSBase, PagesForWords[maxunknown - maxknown + 3], EasyDown];
    DAs _ DESCRIPTOR[DataSegmentAddress[DAseg] - (maxknown - 1), maxunknown + 2];
    diskrequest _ DiskDefs.DiskRequest[
      ca: DataSegmentAddress[bufseg], fixedCA: TRUE, da: @DAs[0],
      fp: @imageFile.fp, firstPage: maxknown, lastPage: maxunknown, action: ReadD,
      lastAction: ReadD, signalCheckError: FALSE,
      option: update[cleanup: BFSDefs.GetNextDA]];
    MiscDefs.SetBlock[@DAs[maxknown - 1], fillinDA, maxunknown - maxknown + 3];
    DAs[maxknown] _ maxknownDA;
    [] _ BFSDefs.ActOnPages[LOOPHOLE[@diskrequest]];
    -- we know it is an Update diskrequest
    [] _ EnumerateFileSegments[PlugDA];
    DeleteDataSegment[DAseg];
    DeleteDataSegment[bufseg];
    DisplayHead^ _ saveDisplay;
    END;

  -- of CollectDiskAddresses --

  -- The driver


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


  END..