-- File: CedarSnapshotMain.mesa
-- last edited by Levin:   3-Dec-81 11:21:40

DIRECTORY
  BcdDefs USING [GFTIndex, MTIndex],
  BcdOps USING [BcdBase, MTHandle, ProcessModules],
  Boot USING [BootFileType, Location, LVBootFiles],
  BootFile USING [MemorySizeToFileSize],
  BootSwap USING [Mon, OutLoad],
  BootSwapCross USING [pMon],
  CachedSpace USING [Desc, Handle, Level],
  CedarSnapshot USING [Outcome],
  DeviceCleanup USING [Perform],
  -- DiskChannel USING [Idle, Restart],
  Directory USING [CreateFile],  -- used only to find GF of DirectoryFilesImpl
  DirectoryFiles USING [DCEntry, --directoryCache,-- maxDCache],
  DirectoryFilesImpl USING [directoryCache],
  DiskChannelImpl USING [ChannelHandle, ChannelObject],
  Environment USING [Base, first64K, wordsPerPage],
  File USING [
    Capability, Create, Delete, delete, GetAttributes, GetSize, ID,
    LimitPermissions, nullID, PageCount, PageNumber, Permissions,
    read, Unknown, write],
  FileTypes USING [tUntypedFile],
  Frame USING [MyGlobalFrame],
  -- Hierarchy USING [GetDescriptor],
  HierarchyImpl USING [GetDescriptor],
  Inline USING [BITOR, BITXOR],
  KernelFile USING [GetBootLocation],
  -- LogicalVolume USING [CloseLogicalVolume, OpenLogicalVolume],
  MapLogImpl USING [WriteLog1],  -- should be VMMapLog.WriteLog
  PilotFileTypes USING [tVMBackingFile],
  -- PilotLoaderOps USING [
  --   CloseLinkSpace, LinkSegmentLength, OpenLinkSpace, ReadLink, WriteLink],
  PilotLoaderSupport USING [
    CloseLinkSpace, LinkSegmentLength, OpenLinkSpace, ReadLink, WriteLink],
  PilotLoadStateOps USING [
    AcquireBcd, ConfigIndex, EnumerateBcds, GetMap, GetModule, InputLoadState,
    Map, ReleaseBcd, ReleaseLoadState, ReleaseMap],
  PilotMP USING [cClient],
  PrincOps USING [ControlLink, GFTIndex, GlobalFrameHandle],
  PrincOpsRuntime USING [GetFrame, GFT],
  Process USING [
    GetPriority, Pause, Priority, SecondsToTicks, SetPriority --, Yield--],
  ProcessInternal USING [DisableInterrupts, EnableInterrupts],
  ProcessOperations USING [EnableAndRequeue, ReadPSB, ReadPTC, ReadWDC, WritePSB, WritePTC, WriteWDC],
  ProcessorFace USING [SetMP],
  ProcessPriorities USING [priorityPageFaultLow],
  PSB USING [PDA, PsbHandle],
  Runtime USING [GlobalFrame, LoadConfig -- for PilotLoaderOps hack only --],
  Snapshot USING [InLoad],
  Space USING [
    CopyIn, CopyOut, Create, Deactivate, defaultWindow, Delete, GetAttributes,
    GetHandle, GetWindow, Handle, LongPointer, MakeReadOnly, MakeWritable,
    Map, nullHandle, PageCount, PageFromLongPointer, PageOffset, Unmap,
    virtualMemory, WindowOrigin],
  SpecialFile USING [Link, MakeBootable],
  SpecialSpace USING [
    MakeGlobalFrameResident, MakeGlobalFrameSwappable, MakeProcedureResident,
    MakeProcedureSwappable, MakeResident, MakeSwappable, realMemorySize],
  SpecialVolume USING [GetLogicalVolumeBootFiles, SetLogicalVolumeBootFiles],
  SubVolumeImpl USING [CacheEntry, ceFirst, ceLast, CePtr],
  TemporarySetGMT USING [SetGMT],
  UserTerminal USING [CursorArray, GetCursorPattern, SetCursorPattern],
  VM USING [PageNumber],
  -- VMMapLog USING [WriteLog1],
  Volume USING [ID, InsufficientSpace, nullID, systemID],
  VolumeExtras USING [OpenVolume],
  -- VolumeImplInterface USING [SubvolumeOffline, SubvolumeOnline],
  VolumeImpl USING [CloseLogicalVolume, OpenLogicalVolume, SubvolumeOffline, SubvolumeOnline];

CedarSnapshotMain: MONITOR
  IMPORTS
    BcdOps, BootFile, BootSwap, DeviceCleanup, Directory, -- DiskChannel, -- File, Frame,
    -- Hierarchy, -- Inline, KernelFile, -- LogicalVolume, PilotLoaderOps, --
    PilotLoadStateOps, PrincOpsRuntime, Process, ProcessInternal,
    ProcessOperations, ProcessorFace, Runtime, Snapshot, Space, SpecialFile, SpecialSpace,
    SpecialVolume, TemporarySetGMT, UserTerminal, -- VMMapLog, -- Volume, VolumeExtras
  EXPORTS CedarSnapshot, BootSwap -- hack!!
  SHARES BootSwap, BootSwapCross, DiskChannelImpl, File, SubVolumeImpl =

BEGIN


-- Miscellaneous Constants --

read: File.Permissions = File.read;
write: File.Permissions = File.write;
delete: File.Permissions = File.delete;

clientImage: Boot.BootFileType = hardMicrocode;      -- as good as any...
firstOutloadPage: CARDINAL = 1;      -- can't use 0 with temporary file => label check
initialSpaceScriptPages: Space.PageCount = 3;
initialLinkScriptPages: Space.PageCount = 4;
maxReasonableSwapUnit: Space.PageCount = 32;

-- The following hacks allow us to get to the interfaces that PilotKernel doesn't
-- export.  BEWARE IF THE GFIs CHANGE!

BootSwapCrossGfi: PrincOps.GFTIndex = 3B;
HierarchyImplGfi: PrincOps.GFTIndex = 55B;
MapLogImplGfi: PrincOps.GFTIndex = 61B;
SubVolumeImplGfi: PrincOps.GFTIndex = 26B;
VolumeImplGfi: PrincOps.GFTIndex = 53B;

-- Hack export to BootSwap --

pMon: PUBLIC LONG POINTER TO BootSwap.Mon _
  LOOPHOLE[PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[BootSwapCrossGfi]],
  	    POINTER TO FRAME[BootSwapCross]].pMon;


-- Checkpoint --

Checkpoint: PUBLIC PROCEDURE [volume: Volume.ID _ Volume.nullID]
  RETURNS [outcome: CedarSnapshot.Outcome] =
  BEGIN
  
  outloadLocation: disk Boot.Location;
  ScriptFull: ERROR = CODE;

  -- Cork --

  oldCursor: UserTerminal.CursorArray;
  oldPriority: Process.Priority = Process.GetPriority[];
  cork: PROCESS;
  state: {initial, corked, uncork} _ initial;
  stateChange: CONDITION _ [timeout: 0];

  CorkRestOfWorld: PROCEDURE =
    BEGIN
    EnsureCorked: ENTRY PROCEDURE = INLINE
      {cork _ FORK Cork[]; UNTIL state = corked DO WAIT stateChange; ENDLOOP};
    Process.SetPriority[ProcessPriorities.priorityPageFaultLow];
    oldCursor _ UserTerminal.GetCursorPattern[];
    EnsureCorked[];
    -- The cork is now at the head of the ready list for priorityPageFaultLow,
    -- and since it never faults, it yields only to its own priority level,
    -- so nothing below priorityPageFaultLow will run.  This is assumed to
    -- include the Ethernet driver(s), Cedar runtime processes, and anything
    -- else that uses the Space machinery.
    END;

  UncorkRestOfWorld: PROCEDURE =
    BEGIN
    state _ uncork; JOIN cork;
    UserTerminal.SetCursorPattern[oldCursor];
    Process.SetPriority[oldPriority];
    END;

  Cork: PROCEDURE =
    BEGIN
    myGF: PrincOps.GlobalFrameHandle = Frame.MyGlobalFrame[];
    AnnounceCorked: ENTRY PROCEDURE = INLINE
      {state _ corked; NOTIFY stateChange};
    OutermostProcOf: PROCEDURE [p: UNSPECIFIED] RETURNS [link: PrincOps.ControlLink] =
      BEGIN
      -- This gets around a bug in SpecialSpace.MakeProcedure{Resident|Swappable}
      link _ LOOPHOLE[p];
      WHILE link.indirect AND ~link.proc DO link _ link.link^; ENDLOOP;
      IF ~link.proc THEN ERROR;
      RETURN[link]
      END;
    Yield: PROCEDURE =
      -- stolen from Processes to ensure residency
      BEGIN OPEN ProcessOperations;
      ProcessInternal.DisableInterrupts[];
      EnableAndRequeue[@PSB.PDA.ready, @PSB.PDA.ready, ReadPSB[]];
      END;
    Process.SetPriority[ProcessPriorities.priorityPageFaultLow];
    SpecialSpace.MakeProcedureResident[OutermostProcOf[Cork]];
    IF ~myGF.alloced THEN
      SpecialSpace.MakeGlobalFrameResident[CedarSnapshotMain];
    AnnounceCorked[];
    UNTIL state = uncork DO --Process.--Yield[]; ENDLOOP;
    IF ~myGF.alloced THEN
      SpecialSpace.MakeGlobalFrameSwappable[CedarSnapshotMain];
    SpecialSpace.MakeProcedureSwappable[OutermostProcOf[Cork]];
    END;

  -- Space script management

  outloadFile: File.Capability;
  firstVMPage: File.PageNumber;
  vmPages: File.PageCount;

  RollbackAction: TYPE = {keep, delete};
  SpaceScriptEntry: TYPE = RECORD [
    rollbackAction: RollbackAction, fill: [0..17777B] _ 0,
    level: CachedSpace.Level,
    page: VM.PageNumber];
  spaceScript: LONG DESCRIPTOR FOR ARRAY OF SpaceScriptEntry _ NIL;
  spaceScriptSpace: Space.Handle _ Space.nullHandle;
  nSpaceScriptPages: Space.PageCount _ initialSpaceScriptPages;
  nSpaceEntries: CARDINAL;

  Hierarchy: POINTER TO FRAME [HierarchyImpl] _
    LOOPHOLE[PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[HierarchyImplGfi]]];
  VMMapLog: POINTER TO FRAME [MapLogImpl] _
    LOOPHOLE[PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[MapLogImplGfi]]];

  InitializeSpaceScript: PROCEDURE =
    BEGIN
    IF spaceScriptSpace ~= Space.nullHandle THEN FlushSpaceScript[];
    spaceScriptSpace _ Space.Create[nSpaceScriptPages, Space.virtualMemory];
    Space.Map[spaceScriptSpace];
    SpecialSpace.MakeResident[spaceScriptSpace];
    spaceScript _ DESCRIPTOR[Space.LongPointer[spaceScriptSpace],
                        nSpaceScriptPages*Environment.wordsPerPage/SIZE[SpaceScriptEntry]];
    nSpaceEntries _ 2;  -- leave slots for space/region data base and maplog
    vmPages _ 0;
    END;
  FlushSpaceScript: PROCEDURE =
    BEGIN
    SpecialSpace.MakeSwappable[spaceScriptSpace];
    Space.Unmap[spaceScriptSpace];
    Space.Delete[spaceScriptSpace];
    END;
  EnumerateChildren: PROCEDURE [space: Space.Handle, proc: PROCEDURE [Space.Handle]] =
    BEGIN
    FOR child: Space.Handle _ Space.GetAttributes[space].lowestChild, Space.GetAttributes[child].nextSibling
    UNTIL child = Space.nullHandle DO proc[child]; ENDLOOP;
    END;
  AddSpace: PROCEDURE [
    space: Space.Handle, size: Space.PageCount, rollbackAction: RollbackAction] =
    BEGIN
    -- Possible future optimization:  don't enter the space in the list if it is
    -- dead (i.e., the backing storage contents are worthless).  To do this, we must
    -- iterate through the region cache, looking at every descriptor that overlaps
    -- the interval associated with 'space' and ask about its state.  If all regions
    -- happen to be dead, we don't enter the space in the spaceScript (if the
    -- rollback action is 'delete', we should delete the space now).
    sH: CachedSpace.Handle = LOOPHOLE[space];
    IF nSpaceEntries = LENGTH[spaceScript] THEN ERROR ScriptFull;
    spaceScript[nSpaceEntries] _
      [rollbackAction: rollbackAction, level: sH.level, page: sH.page];
    nSpaceEntries _ nSpaceEntries + 1;
    vmPages _ vmPages + size;
    END;
  EntryToHandle: PROCEDURE [i: CARDINAL] RETURNS [Space.Handle] =
    BEGIN
    sH: CachedSpace.Handle =
      [level: spaceScript[i].level, page: spaceScript[i].page];
    RETURN[LOOPHOLE[sH]]
    END;
  BuildSpaceScript: PROCEDURE [space: Space.Handle] =
    BEGIN
    size: Space.PageCount;
    mapped: BOOLEAN;
    [size: size, mapped: mapped] _ Space.GetAttributes[space];
    IF mapped THEN
      BEGIN
      window: Space.WindowOrigin = Space.GetWindow[space];
      SELECT TRUE FROM
        space = spaceScriptSpace,
	space = linkScriptSpace => NULL;
	window = Space.defaultWindow =>
          BEGIN
	  -- The following ugly code is used to determine whether the space under
	  -- consideration is pinned.  If so, there is no need to save it in the
	  -- VM checkpoint, since it will be saved by OutLoad.  (Also, as it turns
	  -- out, the implementation of CopyOut/CopyIn can't handle such spaces,
	  -- even though the operations make sense.)
	  desc: CachedSpace.Desc;
	  validSpace, validSwapUnit: BOOLEAN;
          [validSpace, validSwapUnit] _ Hierarchy.GetDescriptor[@desc, LOOPHOLE[space]];
	  IF ~(validSpace AND ~validSwapUnit) THEN ERROR;
	  IF ~desc.pinned THEN  -- pinned spaces will be saved by OutLoad.
	    BEGIN
	    -- Because of limitations in the implementation of CopyIn/CopyOut, we
	    -- dare not present a space beyond a certain size, even though it has
	    -- swap units.  If a space is too big and has swap units, we perform
	    -- the CopyIn/CopyOut on the swap units instead.  If, however, a big
	    -- space has no swap units, we have two options:  we can do the copy in
	    -- a single lump and hope enough main memory can be found, or we can
	    -- temporarily add our own swap units and copy them out.  Although the
	    -- latter course is feasible, it doesn't seem worth the effort, since
	    -- the guy who created the space will cause it to swap as a unit when
	    -- he touches it, and there will have to be sufficient main memory then
	    -- to accommodate it.
	    child: Space.Handle;
	    parentSize: Space.PageCount;
	    [size: parentSize, lowestChild: child] _ Space.GetAttributes[space];
	    IF size <= maxReasonableSwapUnit OR child = Space.nullHandle THEN
	      AddSpace[space, size, keep]
	    ELSE
	      BEGIN
	      -- We do the CopyOut on the swap units here.  We must be careful,
	      -- however, since the parent space may not be completely tiled with
	      -- swap units.  This can't happen with uniform swap units, only with
	      -- explicit subspaces; for example, the bitmap allocated by UserTerminalImpl
	      -- works this way.
	      expectedBase: Space.PageOffset _ 0;
	      FillTo: PROCEDURE [nextBase: Space.PageOffset] =
	        BEGIN
		fillerSize: Space.PageCount = nextBase - expectedBase;
		filler: Space.Handle =
		  Space.Create[size: fillerSize, parent: space, base: expectedBase];
		AddSpace[filler, fillerSize, delete];
		END;
	      DO
	        base: Space.PageOffset;
	        size: Space.PageCount;
	        nextSibling: Space.Handle;
	        [base: base, size: size, nextSibling: nextSibling] _ Space.GetAttributes[child];
		IF base ~= expectedBase THEN FillTo[expectedBase];
		AddSpace[child, size, keep];
		expectedBase _ base + size;
		IF nextSibling = Space.nullHandle THEN EXIT;
	        child _ nextSibling;
	        ENDLOOP;
	      IF expectedBase ~= parentSize THEN FillTo[parentSize];
	      END;
	    END;
	  END;
        window.file.fID = File.nullID => NULL;  -- initial, pinned space
        File.GetAttributes[window.file].type = PilotFileTypes.tVMBackingFile =>
	  BEGIN
	  -- spaceScript[0]: space/region data base, spaceScript[1]: maplog
	  -- Note:  it is assumed that these two spaces are not pinned!  (If they
	  -- were, we wouldn't have to copy them.)
	  sH: CachedSpace.Handle = LOOPHOLE[space];
	  spaceScript[IF window.base = 0 THEN 1 ELSE 0] _
	    [rollbackAction: keep, level: sH.level, page: sH.page];
	  vmPages _ vmPages + size;
	  END;
        ENDCASE =>
	  -- This deactivation isn't really necessary, but we want to be friendly.
	  -- After the rollback, non-pinned spaces mapped to persistent files (as opposed
	  -- to data spaces) will reflect the current contents of the disk.  Also,
	  -- by doing a Deactivate here, we increase the amount of memory available for
	  -- the CopyOuts of data spaces.  Note:  the spaces that are mapped to the files
	  -- that implement the Common Software directory are fixed up explicitly during
	  -- rollback by RationalizeDirectory, below.  Deactivation here is not sufficient.
	  Space.Deactivate[space];
      END
    ELSE EnumerateChildren[space, BuildSpaceScript];
    END;
  CheckpointVM: PROCEDURE =
    BEGIN
    window: Space.WindowOrigin;
    BEGIN
    ENABLE ScriptFull => {nSpaceScriptPages _ nSpaceScriptPages + 1; RETRY};
    InitializeSpaceScript[];
    EnumerateChildren[Space.virtualMemory, BuildSpaceScript];
    END;
    [outloadFile, firstVMPage, outloadLocation] _ MakeSnapshotFile[volume, firstOutloadPage, vmPages];
    SetPhase[2, checkpoint];
    -- Initialize the window to leave space for the space/region data base.
    window _ [outloadFile, firstVMPage + Space.GetAttributes[EntryToHandle[0]].size];
    -- Save all spaces in the script except the space/region data base.
    FOR i: CARDINAL IN [1..nSpaceEntries) DO
      space: Space.Handle = EntryToHandle[i];
      size:  Space.PageCount;
      mapped: BOOLEAN;
      [mapped: mapped, size: size] _ Space.GetAttributes[space];
      Space.CopyOut[space: space, window: window];
      -- The following is an optimization.  If the entry in the space script
      -- corresponds to a swap unit of a mapped space (rather than the mapped
      -- space itself, it means the mapped space is "unreasonably large" (see
      -- comments in BuildSpaceScript).  We would prefer not to have this
      -- unreasonably large space hanging around in memory, so we Deactivate it.
      IF ~mapped THEN Space.Deactivate[space];
      window.base _ window.base + size;
      Twiddle[];
      ENDLOOP;
    -- Write the space/region data base.  This requires a bit of care, since we want to be
    -- certain that the data base saved in the outloadFile is consistent with the region and
    -- space caches saved by the Snapshot.Outload.  Once the data base is written, no changes
    -- to the caches are permitted.  Since the act of doing a CopyOut on the data base may cause
    -- the caches to be loaded with descriptors for the space and regions that describe the data
    -- base itself, we CopyOut the data base a second time, assuming that the caches will not
    -- change again.  Note that we require that there be enough main memory to hold the entire
    -- space/region data base at one time.  If, in the future, this becomes unworkable, a more
    -- elaborate scheme for copying out the data base in pieces without sacrificing its
    -- consistency will have to be worked out.
    window _ [outloadFile, firstVMPage];
    Space.CopyOut[space: EntryToHandle[0], window: window];
    Space.CopyOut[space: EntryToHandle[0], window: window];  -- no, you aren't seeing double...
    END;
  RollbackVM: PROCEDURE =
    BEGIN
    window: Space.WindowOrigin _ [outloadFile, firstVMPage];
    prevMappingSpace: Space.Handle _ Space.nullHandle;
    readOnly: BOOLEAN;
    SetPhase[0, rollback];
    FOR i: CARDINAL IN [0..nSpaceEntries) DO
      special: BOOLEAN = i < 2;  -- space/region data base and maplog
      space: Space.Handle = EntryToHandle[i];
      size:  Space.PageCount;
      mapped: BOOLEAN;
      parent: Space.Handle;
      mappingSpace: Space.Handle _ space;
      [mapped: mapped, size: size, parent: parent] _ Space.GetAttributes[space];
      IF ~mapped THEN
	DO
	  isMapped: BOOLEAN;
	  mappingSpace _ parent;
	  [parent: parent, mapped: isMapped] _ Space.GetAttributes[mappingSpace];
	  IF isMapped THEN EXIT;
	  IF parent = Space.virtualMemory THEN ERROR;
	  ENDLOOP;
      IF special THEN readOnly _ FALSE
      ELSE
        IF prevMappingSpace ~= mappingSpace THEN
	  BEGIN
          -- The following dicey bit of code ensures that anonymous memory exists
          -- to back up the data space being restored.  It obtains the file ID of the
          -- backing file behind the data space and touches it (File.GetSize) to see if
          -- it still exists.  If not, we create a new backing file by unmapping and
          -- remapping the space.  Note that this will never remap a data space whose
          -- backing storage is in the VM backing file, since this is assumed not to
          -- go away.  (In principle, the space monitor should be locked while calling
          -- Hierarchy.GetDescriptor, but we're already playing fast and loose here...)
          desc: CachedSpace.Desc;
          needFile: BOOLEAN _ FALSE;
          validSpace, validSwapUnit: BOOLEAN;
          -- We must reapply write protect to the previous space if it originally had it.
	  IF readOnly THEN Space.MakeReadOnly[prevMappingSpace];
	  [validSpace, validSwapUnit] _ Hierarchy.GetDescriptor[@desc, LOOPHOLE[mappingSpace]];
          IF ~(validSpace AND ~validSwapUnit) THEN ERROR;
          [] _ File.GetSize[desc.window.file ! File.Unknown => {needFile _ TRUE; CONTINUE}];
          IF needFile THEN
            BEGIN
	    Space.Unmap[mappingSpace ! File.Unknown =>
	      VMMapLog.WriteLog1[interval: desc.interval, pSpaceD: NIL] -- the Unmap wasn't done --];
	    Space.Map[mappingSpace];
	    END;
          IF (readOnly _ desc.writeProtected) THEN
            BEGIN
	    -- We must make the space writable before rolling it back.
	    window: Space.WindowOrigin _ Space.GetWindow[mappingSpace];
	    window.file.permissions _ Inline.BITOR[window.file.permissions, write];
	    Space.MakeWritable[mappingSpace, window.file];
	    END;
	  prevMappingSpace _ mappingSpace;
          END;
      Space.CopyIn[space: space, window: window];
      -- The following is the same performance optimization as we did in
      -- CheckpointVM, with the additional provision that we don't deactivate
      -- "special" spaces, since they will come back in right away anyway.
      IF ~(mapped OR special) THEN Space.Deactivate[space];
      window.base _ window.base + size;
      Twiddle[];
      IF spaceScript[i].rollbackAction = delete THEN Space.Delete[space];
      REPEAT
        FINISHED => IF readOnly THEN Space.MakeReadOnly[prevMappingSpace];
      ENDLOOP;
    FlushSpaceScript[];
    END;

  -- Link script management

  PLinkScriptEntry: TYPE = LONG ORDERED POINTER TO LinkScriptEntry;
  LinkScriptEntry: TYPE = MACHINE DEPENDENT RECORD [
    frame: PrincOps.GlobalFrameHandle,
    mth: BcdOps.MTHandle,
    bcd: BcdOps.BcdBase,
    links: ARRAY [0..0) OF PrincOps.ControlLink];
  
  linkScriptBase, linkScriptLimit: PLinkScriptEntry _ NIL;
  linkScriptSpace: Space.Handle _ Space.nullHandle;
  nLinkScriptPages: Space.PageCount _ initialLinkScriptPages;
  nLinkScriptEntries: CARDINAL;

  -- Until PilotLoaderOps is exported, we have to do the following ugliness:
  PilotLoaderOps: POINTER TO FRAME [PilotLoaderSupport] _
    LOOPHOLE[Runtime.GlobalFrame[Runtime.LoadConfig]];

  InitializeLinkScript: PROCEDURE =
    BEGIN
    IF linkScriptSpace ~= Space.nullHandle THEN FlushLinkScript[];
    linkScriptSpace _ Space.Create[nLinkScriptPages, Space.virtualMemory];
    Space.Map[linkScriptSpace];
    linkScriptBase _ LOOPHOLE[Space.LongPointer[linkScriptSpace]];
    linkScriptLimit _ linkScriptBase + nLinkScriptPages*Environment.wordsPerPage;
    nLinkScriptEntries _ 0;
    END;
  FlushLinkScript: PROCEDURE =
    BEGIN
    Space.Unmap[linkScriptSpace];
    Space.Delete[linkScriptSpace];
    END;
  CheckpointLinks: PROCEDURE =
    BEGIN OPEN PilotLoadStateOps;
    bootfID: File.ID = GetBootFileID[];
    lSE: PLinkScriptEntry;
    GetBootFileID: PROCEDURE RETURNS [File.ID] =
      BEGIN
      bootFiles: Boot.LVBootFiles;
      SpecialVolume.GetLogicalVolumeBootFiles[systemVolume, @bootFiles];
      RETURN[bootFiles[pilot].fID]
      END;
    InBootFile: PROCEDURE [p: LONG POINTER] RETURNS [BOOLEAN] = INLINE
      BEGIN
      OPEN Space;
      RETURN[GetWindow[GetHandle[PageFromLongPointer[p]]].file.fID = bootfID]
      END;
    ProcessBcd: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
      BEGIN
      bcd: BcdOps.BcdBase _ AcquireBcd[config];
      IF ~InBootFile[bcd] THEN
        BEGIN
	map: Map _ GetMap[config];
	ProcessLinks: PROCEDURE [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
	  RETURNS [BOOLEAN] =
	  BEGIN OPEN PrincOps, PrincOpsRuntime;
	  rgfi: GFTIndex = map[mth.gfi];
	  gf: GlobalFrameHandle = GetFrame[GFT[rgfi]];
	  IF ~GetModule[rgfi].resolved AND gf.codelinks THEN
	    BEGIN OPEN PilotLoaderOps;
	    nLinks: CARDINAL _ PilotLoaderOps.LinkSegmentLength[mth, bcd];
	    nextEntry: PLinkScriptEntry _
	      lSE + SIZE[LinkScriptEntry] + nLinks*SIZE[ControlLink];
	    IF nextEntry > linkScriptLimit THEN
	      {ReleaseMap[map]; ReleaseBcd[bcd]; ERROR ScriptFull};
	    lSE^ _ [frame: gf, mth: mth, bcd: bcd, links: ];
	    OpenLinkSpace[gf, mth, bcd];
	    FOR i: CARDINAL IN [0..nLinks) DO
	      lSE.links[i] _ ReadLink[i];
	      ENDLOOP;
	    CloseLinkSpace[gf];
	    lSE _ nextEntry;
	    nLinkScriptEntries _ nLinkScriptEntries + 1;
	    Twiddle[];
	    END;
	  RETURN [FALSE]
	  END;
	[] _ BcdOps.ProcessModules[bcd, ProcessLinks];
	ReleaseMap[map];
	END;
      ReleaseBcd[bcd];
      RETURN[FALSE]
      END;
    SetPhase[0, checkpoint];
    [] _ InputLoadState[];
    BEGIN
    ENABLE ScriptFull => {nLinkScriptPages _ nLinkScriptPages + 1; RETRY};
    InitializeLinkScript[];
    lSE _ linkScriptBase;
    [] _ EnumerateBcds[recentlast, ProcessBcd];
    END;
    ReleaseLoadState[];
    END;
  RollbackLinks: PROCEDURE =
    BEGIN
    lSE: PLinkScriptEntry _ linkScriptBase;
    SetPhase[1, rollback];
    THROUGH [0..nLinkScriptEntries) DO
      OPEN PilotLoaderOps, PrincOps;
      nLinks: CARDINAL = LinkSegmentLength[lSE.mth, lSE.bcd];
      OpenLinkSpace[lSE.frame, lSE.mth, lSE.bcd];
      FOR i: CARDINAL IN [0..nLinks) DO
        WriteLink[i, lSE.links[i]];
	ENDLOOP;
      CloseLinkSpace[lSE.frame];
      lSE _ lSE + SIZE[LinkScriptEntry] + nLinks*SIZE[ControlLink];
      Twiddle[];
      ENDLOOP;
    FlushLinkScript[];
    END;

  -- System volume cleanup

  LogicalVolume: POINTER TO FRAME [VolumeImpl] _
    LOOPHOLE[PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[VolumeImplGfi]]];
  VolumeImplInterface: POINTER TO FRAME [VolumeImpl] _ LogicalVolume;

  CheckpointSystemVolume: PROCEDURE =
    BEGIN
    -- We now flush the file cache to make sure that files deleted after the
    -- checkpoint will not be "remembered" when the rollback occurs.  It is
    -- assumed that uses of the space machinery by the volume open/close do not
    -- cause any changes in the space/region caches (for reasons described in
    -- CheckpointVM, above).  This works because the volume stuff uses
    -- SimpleSpace exclusively, which pins all descriptors in the caches.  Since
    -- this is a logical requirement of the FileMgr, we aren't likely to get
    -- burned in the future.
    WaitForDiskToIdle: PROCEDURE =
      BEGIN
      -- All this is because the disk must be quiet before we can close the volume.
      subVolumeFrame: POINTER TO FRAME [SubVolumeImpl] _
        LOOPHOLE[PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[SubVolumeImplGfi]]];
      diskChannelFrame: POINTER TO FRAME [DiskChannelImpl];
      BEGIN OPEN subVolumeFrame;
      FOR cePtr: CePtr _ ceFirst, cePtr + SIZE[CacheEntry] WHILE cePtr <= ceLast DO
        IF cePtr.occupied THEN
          BEGIN
          -- Some turkey put the following procedures in a DISCARD CODE PACK, so we
          -- REALLY get our hands dirty!
          -- DiskChannel.Idle[cePtr.svDesc.channel];
          -- DiskChannel.Restart[cePtr.svDesc.channel];
          base: Environment.Base = Environment.first64K;
          channelObj: LONG POINTER TO diskChannelFrame.ChannelObject _
            @base[LOOPHOLE[cePtr.svDesc.channel, diskChannelFrame.ChannelHandle]];
          UNTIL channelObj.ioCount = 0 DO Process.Pause[Process.SecondsToTicks[1]]; ENDLOOP;
          END;
        ENDLOOP;
      END;
      END;
    SetPhase[3, checkpoint];
    WaitForDiskToIdle[];
    -- We now want to close the system volume, causing Pilot (specifically, the FileMgr) to
    -- forget everything it has cached about the contents of the system volume.  This includes
    -- the file cache, the VFM, and the volume root page.  LogicalVolume.CloseLogicalVolume
    -- should do all of these, but because of a bug, it retains a cached copy of the
    -- volume root page.  To get around this, witness the crazy stuff below with
    -- bringing subvolumes on- and off-line, and observe the 'root' parameter is TRUE in
    -- the offline case.  This has the effect of leaving the logical volume table unchanged,
    -- but causing the volume root page to be flushed.  Look at the code in VolumeImpl if
    -- you are skeptical.
    VolumeImplInterface.SubvolumeOnline[lvID: systemVolume, root: TRUE];
    LogicalVolume.CloseLogicalVolume[@systemVolume];
    VolumeImplInterface.SubvolumeOffline[lvID: systemVolume, root: TRUE];
    END;
  RollbackSystemVolume: PROCEDURE =
    BEGIN
    [] _ LogicalVolume.OpenLogicalVolume[@systemVolume];
    END;

  -- OutLoad implementation

  OutLoad: PROCEDURE RETURNS [inLoaded: BOOLEAN] =
    BEGIN
    -- This code is stolen directly from SnapshotImpl.OutLoad.
    psb: PSB.PsbHandle; ptc: CARDINAL; wdc: CARDINAL;
    -- Save process state not captured in PDA:
    ProcessInternal.DisableInterrupts[]; -- make it hold still first
    psb _ ProcessOperations.ReadPSB[];
    ptc _ ProcessOperations.ReadPTC[];
    wdc _ ProcessOperations.ReadWDC[];
    DeviceCleanup.Perform[turnOff]; -- turn all devices off.
    -- Save our state on a boot file:  (If the boot file is inloaded
    -- later, we will reappear here with inLoaded=TRUE.)
    inLoaded _ BootSwap.OutLoad[@outloadLocation, restore] ~= outLoaded;
    IF inLoaded THEN
      BEGIN
      -- Restore process state not captured in PDA.
      ProcessOperations.WriteWDC[wdc];
      ProcessOperations.WritePTC[ptc];
      ProcessOperations.WritePSB[psb];
      -- The following is a temporary substitute for a clock chip.
      -- We must do it with interrupts off or Communication will be using the Ethernet--
      -- if we get an allocation trap, all is lost.
      [] _ TemporarySetGMT.SetGMT[];
      END;
    DeviceCleanup.Perform[turnOn]; -- turn devices back on
    ProcessorFace.SetMP[PilotMP.cClient]; -- announce our return
    ProcessInternal.EnableInterrupts[];
    END;

  -- Directory cleanup

  RationalizeDirectory: PROCEDURE =
    BEGIN
    directoryFilesFrame: POINTER TO FRAME [DirectoryFilesImpl] _
      LOOPHOLE[Runtime.GlobalFrame[Directory.CreateFile]];
    SetPhase[2, rollback];
    FOR i: CARDINAL IN [1 .. DirectoryFiles.maxDCache] DO
      dCE: LONG POINTER TO DirectoryFiles.DCEntry = @directoryFilesFrame.directoryCache[i];
      IF dCE.refCount > 0 THEN
        BEGIN
	-- This fixes up the space descriptor (in particular, the countMapped
	-- information) to account for any change in file size.
	window: Space.WindowOrigin = Space.GetWindow[dCE.dir.space];
	Space.Unmap[dCE.dir.space];
	Space.Map[dCE.dir.space, window];
	Twiddle[];
	END;
      ENDLOOP;
    END;

  -- *** Here's the real work ***
  
  systemVolume: Volume.ID _ Volume.systemID;

  CorkRestOfWorld[];
  IF volume = Volume.nullID THEN volume _ systemVolume;
  -- Save all necessary code links
  CheckpointLinks[];
  -- Save space/region data base, maplog, and all data spaces.
  BEGIN
  CheckpointVM[ ! Volume.InsufficientSpace => GO TO cantCheckpoint];
  EXITS
    cantCheckpoint =>
      {UncorkRestOfWorld[]; RETURN[insufficientDiskSpace]};
  END;
  -- Flush file cache and shut down the system volume.
  CheckpointSystemVolume[];
  -- Save real memory.  Note:  we can't use Snapshot.Outload because it requires
  -- that the volume containing the boot file be open, and we can't tolerate that.
  IF ~OutLoad[].inLoaded THEN
    BEGIN
    RollbackSystemVolume[];  -- system volume must be open before we proceed!
    UncorkRestOfWorld[];
    RETURN[checkpointed]
    END;
  -- Inload has restored real memory.  Reopen the system volume before restoring VM.
  RollbackSystemVolume[];
  -- Restore space/region data base, maplog, and data spaces.
  RollbackVM[];
  -- Restore code links that may have been invalidated.
  RollbackLinks[];
  -- Now that memory is back together, make the directory system believe the current
  -- state of the directory files on the disk.
  RationalizeDirectory[];
  UncorkRestOfWorld[];
  RETURN[rolledBack]
  END;

-- Rollback --

RollBack: PUBLIC PROCEDURE [volume: Volume.ID _ Volume.nullID] =
  BEGIN
  bootFiles: Boot.LVBootFiles;
  IF volume = Volume.nullID THEN volume _ Volume.systemID;
  SpecialVolume.GetLogicalVolumeBootFiles[volume, @bootFiles];
  IF volume ~= Volume.systemID THEN
    VolumeExtras.OpenVolume[volume: volume, readOnly: TRUE];
  Snapshot.InLoad[
    pMicrocode: NIL, pGerm: NIL, countGerm: 0,
    file: [fID: bootFiles[clientImage].fID, permissions: read],
    firstPage: bootFiles[clientImage].firstPage ! ANY => CONTINUE];
  -- Note: execution normally continues inside Checkpoint.  If the
  -- above InLoad failed, we make sure that there is no trace of a
  -- possibly bad checkpoint file before returning to the caller of
  -- Rollback, who can decide what to do instead of the rollback.
  bootFiles[clientImage].fID _ File.nullID;
  SpecialVolume.SetLogicalVolumeBootFiles[volume, @bootFiles];
  END;


-- Utilities --

MakeSnapshotFile: PROCEDURE [
  volume: Volume.ID, firstRMPage: File.PageNumber, pagesForVM: File.PageCount]
  RETURNS [file: File.Capability, firstVMPage: File.PageNumber, location: disk Boot.Location] =
  BEGIN
  pagesForRM: File.PageCount =
    BootFile.MemorySizeToFileSize[SpecialSpace.realMemorySize];
  filePages: File.PageCount = firstRMPage + pagesForRM + pagesForVM;
  bootFiles: Boot.LVBootFiles;
  found: BOOLEAN;
  CheckForExistingFile: PROCEDURE RETURNS [found: BOOLEAN, file: File.Capability] =
    BEGIN
    found _ FALSE;
    IF bootFiles[clientImage].fID = File.nullID THEN RETURN;
    file _ [fID: bootFiles[clientImage].fID, permissions: read+write+delete];
    IF File.GetSize[file ! File.Unknown => GO TO noGood] < filePages THEN
      {File.Delete[file]; GO TO noGood};
    found _ TRUE;
    EXITS
      noGood =>
        BEGIN
	bootFiles[clientImage].fID _ File.nullID;
	SpecialVolume.SetLogicalVolumeBootFiles[volume, @bootFiles];
	END;
    END;
  SetPhase[1, checkpoint];
  SpecialVolume.GetLogicalVolumeBootFiles[volume, @bootFiles];
  [found, file] _ CheckForExistingFile[];
  IF ~found THEN
    file _ File.Create[volume, filePages, FileTypes.tUntypedFile];
  Twiddle[];
  [] _ SpecialFile.MakeBootable[
      file: file, firstPage: firstRMPage, count: pagesForRM,
      lastLink: SpecialFile.Link[0]];
  Twiddle[];
  location.diskFileID _ [fID: file.fID, firstPage: firstRMPage, da:];
  [deviceType: location.deviceType, deviceOrdinal: location.deviceOrdinal,
    link: LOOPHOLE[location.diskFileID.da, SpecialFile.Link]] _
    KernelFile.GetBootLocation[file, firstRMPage];
  bootFiles[clientImage] _ [file.fID, firstRMPage, LOOPHOLE[location.diskFileID.da]];
  SpecialVolume.SetLogicalVolumeBootFiles[volume, @bootFiles];
  RETURN[File.LimitPermissions[file, read+write], firstRMPage + pagesForRM, location]
  END;


-- Feedback to User  --

cStart: CARDINAL = 0;
cEnd: CARDINAL = SIZE[UserTerminal.CursorArray];
cMiddle: CARDINAL = (cEnd + cStart) / 2;

Direction: TYPE = {checkpoint, rollback};

cursors: ARRAY Direction OF UserTerminal.CursorArray =
  [[075122B, 041122B, 041124B, 041734B, 041124B, 041122B, 075122B, 000000B,
    017370B, 011040B, 011040B, 016040B, 010040B, 010040B, 010040B, 000000B],
   [167210B, 125210B, 125210B, 145210B, 125210B, 125210B, 127356B, 000000B,
    147352B, 125212B, 125212B, 147214B, 125212B, 125212B, 145352B, 000000B]];

SetPhase: PROCEDURE [phase: [0..7], direction: Direction] =
  BEGIN
  cursor: UserTerminal.CursorArray _ cursors[direction];
  topMasks: ARRAY [0..4) OF WORD = [0, 177400B, 377B, 177777B];
  bottomMask: WORD = 177400B;
  topMask: WORD = topMasks[phase MOD 4];
  IF topMask ~= 0 THEN
    FOR i: CARDINAL IN [0..cMiddle) DO
      cursor[i] _ Inline.BITXOR[cursor[i], topMask];
      ENDLOOP;
  IF phase > 4 THEN
    FOR i: CARDINAL IN [cMiddle..cEnd) DO
      cursor[i] _ Inline.BITXOR[cursor[i], bottomMask];
      ENDLOOP;
  UserTerminal.SetCursorPattern[cursor];
  END;

Twiddle: PROCEDURE =
  BEGIN
  cursor: UserTerminal.CursorArray _ UserTerminal.GetCursorPattern[];
  FOR i: CARDINAL IN [cMiddle..cEnd) DO
    cursor[i] _ Inline.BITXOR[cursor[i], 377B];
    ENDLOOP;
  UserTerminal.SetCursorPattern[cursor];
  END;

END.