-- CheckPoint.Mesa
-- Edited by:
--		Levin on October 16, 1978  3:25 PM

DIRECTORY
  AllocDefs: FROM "allocdefs" USING [
    AddSwapStrategy, RemoveSwapStrategy, SwappingProcedure, SwapStrategy],
  AltoDefs: FROM "altodefs" USING [
    BytesPerPage, PageCount, PageNumber, PageSize],
  AltoFileDefs: FROM "altofiledefs" USING [CFA, FA, fillinDA, FP, TIME, vDA],
  BcdDefs: FROM "bcddefs" USING [VersionStamp],
  BFSDefs: FROM "bfsdefs" USING [ActOnPages, GetNextDA],
  BootDefs: FROM "BootDefs" USING [EnumerateObjects],
  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 [PuntInfo, GetLevel, SetLevel],
  DirectoryDefs: FROM "directorydefs" USING [EnumerateDirectory],
  DiskDefs: FROM "diskdefs" USING [DA, DiskRequest, RealDA],
  DiskKDDefs: FROM "diskkddefs" USING [CloseDiskKD],
  FrameDefs: FROM "framedefs" USING [MakeCodeResident, SwapInCode, SwapOutCode],
  ImageDefs: FROM "imagedefs" USING [
    FileRequest, FirstImageDataPage, HeaderPages, ImageHeader, ImagePrefix,
    ImageVersion, MapItem, PuntMesa, UserCleanupProc, VersionID],
  InlineDefs: FROM "inlinedefs" USING [BITAND, COPY],
  LoadStateDefs: FROM "loadstatedefs" USING [
    ConfigIndex, GetInitialLoadState, GetLoadState, InputLoadState,
    ReleaseLoadState],
  MiscDefs: FROM "miscdefs" USING [DAYTIME, GetNetworkNumber, SetBlock, Zero],
  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 [sAllocTrap, sSwapTrap, sXferTrap],
  SegmentDefs: FROM "segmentdefs" USING [
    AddressFromPage, Append, CloseFile, DataSegmentAddress, DataSegmentHandle,
    DefaultBase, DefaultVersion, DeleteDataSegment, EnumerateDataSegments,
    EnumerateFiles, EnumerateFileSegments, FileError, FileHandle,
    FileSegmentAddress, FileSegmentHandle, GetFileSegmentDA, JumpToPage,
    MapFileSegment, NewDataSegment, NewFile, ObjectHandle, Read, SetEndOfFile, SwapIn,
    SwapOut, Unlock, Write],
  StreamDefs: FROM "streamdefs" USING [
    CreateWordStream, ReadBlock, StreamHandle],
  StringDefs: FROM "stringdefs" USING [EquivalentString],
  SystemDefs: FROM "systemdefs" USING [AllocatePages, FreePages, PruneHeap],
  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;

CheckPoint: PROGRAM
  IMPORTS AllocDefs, BFSDefs, BootDefs, CoreSwapDefs,
    DirectoryDefs, DiskDefs, DiskKDDefs, FrameDefs, ImageDefs,
    LoadStateDefs, MiscDefs, SegmentDefs, StreamDefs, StringDefs, SystemDefs, XMESA, XMesaDefs
  EXPORTS ImageDefs
  SHARES ProcessDefs, DiskDefs, SegmentDefs, ControlDefs, ImageDefs, XMESA =
  BEGIN

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

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

SwapTrapDuringMakeCheck: PUBLIC SIGNAL = CODE;
SwapErrorDuringMakeCheck: PUBLIC SIGNAL = CODE;
SwapOutDuringMakeCheck: PUBLIC SIGNAL = CODE;
NoRoomInCheckMap: PUBLIC SIGNAL = CODE;

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

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

-- File Segment Transfer Routines

LockCodeSegment: PROCEDURE [p: ProcDesc] =
  BEGIN
  frame: ControlDefs.GlobalFrameHandle = ControlDefs.GFT[p.gfi].frame;
  FrameDefs.MakeCodeResident[frame];
  FrameDefs.SwapInCode[frame];
  SegmentDefs.Unlock[frame.codesegment];
  END;

UnlockCodeSegment: PROCEDURE [p: ProcDesc] =
  BEGIN
  SegmentDefs.Unlock[ControlDefs.GFT[p.gfi].frame.codesegment];
  END;

DAofPage: PROCEDURE [file: FileHandle, page: PageNumber] RETURNS [next: vDA] =
  BEGIN
  cfa: CFA;
  buf: POINTER = SystemDefs.AllocatePages[1];
  cfa.fp _ file.fp;
  cfa.fa _ AltoFileDefs.FA[file.fp.leaderDA,0,0];
  next _ SegmentDefs.JumpToPage[@cfa,page-1,buf].next;
  SystemDefs.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;

EnumerateNeededModules: PROCEDURE [proc: PROCEDURE [ProcDesc]] =
  BEGIN
  proc[LOOPHOLE[EnumerateNeededModules]];
  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]];
  END;

InstallCheck: PROCEDURE [name: STRING] =
  BEGIN OPEN DiskDefs, AltoFileDefs;
  wdc: CARDINAL;
  diskrequest: DiskRequest;
  savealloctrap, saveswaptrap: ControlLink;
  auxtrapFrame: FrameHandle;
  saveAllocationVector: AllocationVector;
  saveXferTrap, saveXferTrapStatus: UNSPECIFIED;
  savePuntData: POINTER;
  datapages: PageCount _ 0;
  SwapOutErrorStrategy: AllocDefs.SwapStrategy _
    AllocDefs.SwapStrategy[link:,proc:SwapOutError];
  mapindex: CARDINAL _ 0;
  maxFileSegPages: CARDINAL _ 0;
  endofdatamapindex: CARDINAL;
  HeaderSeg: DataSegmentHandle;
  Image: POINTER TO ImageHeader;
  HeaderDA: vDA;
  checkFile: FileHandle;
  saveDIW: WORD;
  savePV: ARRAY [0..15] OF UNSPECIFIED;
  saveSDC: WORD;
  saveReadyList: ProcessDefs.Queue;
  saveCurrentPSB: ProcessDefs.ProcessHandle;
  saveCurrentState: ControlDefs.SVPointer;
  time: AltoFileDefs.TIME _ MiscDefs.DAYTIME[];
  initstateseg: FileSegmentHandle _ LoadStateDefs.GetInitialLoadState[];
  stateseg: FileSegmentHandle _ LoadStateDefs.GetLoadState[];
  net: CARDINAL _ MiscDefs.GetNetworkNumber[];
  segs: DESCRIPTOR FOR ARRAY OF FileSegmentHandle;
  maxnumbersegments: CARDINAL _ 0;
  nextpage: PageNumber;
  level: CARDINAL _ 0;
  restart: BOOLEAN;

  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;
  EnterNormalMapItem: PROCEDURE [vmpage: PageNumber, pages: PageCount] =
    BEGIN
    map: POINTER TO normal MapItem = LOOPHOLE[@Image.map];
    IF pages > 127 THEN SIGNAL SwapErrorDuringMakeCheck;
    IF mapindex >= PageSize*HeaderPages-SIZE[ImagePrefix]-SIZE[normal MapItem] THEN
      SIGNAL NoRoomInCheckMap;
    (map+mapindex)^ _ MapItem[vmpage, pages, normal[]];
    mapindex _ mapindex + SIZE[normal MapItem];
    END;
  CountDataSegments: PROCEDURE [s: DataSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    datapages _ datapages + s.pages;
    RETURN[FALSE];
    END;
  MapDataSegments: PROCEDURE [s: DataSegmentHandle] RETURNS [BOOLEAN] =
    BEGIN
    IF s # HeaderSeg THEN
      BEGIN
      EnterNormalMapItem[s.VMpage, s.pages];
      nextpage _ nextpage + s.pages;
      END;
    RETURN[FALSE];
    END;
  CountMaxSegmentsPerFile: PROCEDURE [f: FileHandle] RETURNS [BOOLEAN] =
    BEGIN
    maxnumbersegments _ MAX[maxnumbersegments, f.swapcount];
    RETURN[FALSE];
    END;
  EnterSwappedInPerFile: PROCEDURE [f: FileHandle] RETURNS [BOOLEAN] =
    BEGIN
    nsegs: CARDINAL _ 0;
    next: PageNumber _ DefaultBase;
    i: CARDINAL;
    OrganizeSegments: PROCEDURE [s: FileSegmentHandle] RETURNS [BOOLEAN] =
      BEGIN
      i, j: CARDINAL;
      IF ~s.swappedin OR s.file # f THEN RETURN[FALSE];
      FOR i IN [0..nsegs) DO
	IF segs[i].base > s.base THEN GOTO insert;
	REPEAT
	  insert =>
	    BEGIN
	    FOR j DECREASING IN [i..nsegs) DO segs[j+1] _ segs[j]; ENDLOOP;
	    segs[i] _ s;
	    END;
	  FINISHED => segs[nsegs] _ s;
	ENDLOOP;
      RETURN[(nsegs _ nsegs+1) = f.swapcount];
      END;
    IF f = checkFile OR f.swapcount = 0 THEN RETURN[FALSE];
    [] _ EnumerateFileSegments[OrganizeSegments];
    FOR i IN [0..nsegs) DO
      IF segs[i].base # next THEN EnterChangeMapItem[segs[i]]
      ELSE EnterNormalMapItem[segs[i].VMpage, segs[i].pages];
      next _ segs[i].base + segs[i].pages;
      ENDLOOP;
    RETURN[FALSE];
    END;
  EnterChangeMapItem: PROCEDURE [s: FileSegmentHandle] =
    BEGIN
    map: POINTER TO change MapItem = LOOPHOLE[@Image.map];
    da: DiskDefs.DA _ DiskDefs.RealDA[GetFileSegmentDA[s]];
    IF s.pages > 127 THEN SIGNAL SwapErrorDuringMakeCheck;
    IF mapindex >= PageSize*HeaderPages-SIZE[ImagePrefix]-SIZE[change MapItem] THEN
      SIGNAL NoRoomInCheckMap;
    (map+mapindex)^ _ MapItem[s.VMpage, s.pages, change[da, s.base]];
    mapindex _ mapindex + SIZE[change MapItem];
    END;

  checkFile _ NewFile[name, Read+Write+Append, DefaultVersion];
  ProcessDefs.DisableInterrupts[];
  wdc _ REGISTER[WDCreg];
  level _ CoreSwapDefs.GetLevel[];
  CoreSwapDefs.SetLevel[-1];
  SaveProcesses[];
  ImageDefs.UserCleanupProc[Checkpoint];

-- 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;


  SwapIn[initstateseg];
  [] _ LoadStateDefs.InputLoadState[];  -- bring it in for first time
  [] _ SystemDefs.PruneHeap[];

  SetupAuxStorage[];
  EnumerateNeededModules[LockCodeSegment];
  HeaderDA _ DAofPage[checkFile, 1];

  -- 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]^;

  [] _ EnumerateDataSegments[CountDataSegments];
  SetEndOfFile[checkFile, datapages+stateseg.pages*2+FirstImageDataPage-1,
    AltoDefs.BytesPerPage];
  [] _ DiskKDDefs.CloseDiskKD[];

  HeaderSeg _ NewDataSegment[DefaultBase, 1];
  Image _ DataSegmentAddress[HeaderSeg];
  MiscDefs.Zero[Image, AltoDefs.PageSize*HeaderPages];
  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 _ checkfile;
  Image.prefix.leaderDA _ checkFile.fp.leaderDA;
  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;
  [] _ EnumerateDataSegments[MapDataSegments];
  IF nextpage # FirstImageDataPage+datapages THEN ERROR;
  endofdatamapindex _ mapindex;

  -- Move LoadStates
  InlineDefs.COPY[
    from: FileSegmentAddress[stateseg],
    to: FileSegmentAddress[initstateseg],
    nwords: initstateseg.pages*PageSize];
  MapFileSegment[stateseg, checkFile, datapages+FirstImageDataPage];
  EnterNormalMapItem[stateseg.VMpage, stateseg.pages];
  MapFileSegment[
    initstateseg, checkFile, datapages+FirstImageDataPage+stateseg.pages];
  EnterNormalMapItem[initstateseg.VMpage, stateseg.pages];
  Image.prefix.loadStateBase _ stateseg.base;
  Image.prefix.initialLoadStateBase _ initstateseg.base;
  Image.prefix.loadStatePages _ initstateseg.pages;

  -- now disable swapping
  savePuntData _ CoreSwapDefs.PuntInfo^;
  saveswaptrap _ SD[SDDefs.sSwapTrap];
  SD[SDDefs.sSwapTrap] _ SwapTrapError;
  AllocDefs.AddSwapStrategy[@SwapOutErrorStrategy];
  [] _ EnumerateFiles[CountMaxSegmentsPerFile];
  segs _ DESCRIPTOR[auxalloc[maxnumbersegments], maxnumbersegments];
  [] _ EnumerateFiles[EnterSwappedInPerFile];

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

  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^ _ checkFile.fp;
  (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];

  restart _ BFSDefs.ActOnPages[LOOPHOLE[@diskrequest]].page = 0;
  REGISTER[WDCreg] _ wdc;
  AV^ _ saveAllocationVector;
  SD[SDDefs.sAllocTrap] _ savealloctrap;
  SD[SDDefs.sXferTrap] _ saveXferTrap;
  REGISTER[XTSreg] _ saveXferTrapStatus;
  Free[auxtrapFrame];
  XMESA.InitMemoryConfig[];									--XM
  DeleteDataSegment[HeaderSeg];

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

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

  RestoreProcesses[];
  CoreSwapDefs.PuntInfo^ _ savePuntData;
  IF ~restart THEN CoreSwapDefs.SetLevel[level];
  ProcessDefs.EnableInterrupts[];

  InlineDefs.COPY[
    to: FileSegmentAddress[stateseg],
    from: FileSegmentAddress[initstateseg],
    nwords: initstateseg.pages*PageSize];
  LoadStateDefs.ReleaseLoadState[];
  Unlock[initstateseg];
  SwapOut[initstateseg];
  DeleteDataSegment[AuxSeg];

  EnumerateNeededModules[UnlockCodeSegment];
  XMESA.MoveLockedCode[direction: up];								--XM
  ImageDefs.UserCleanupProc[IF restart THEN Restart ELSE Continue];
  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,5];
  av _ freepointer _ DataSegmentAddress[AuxSeg];
  wordsleft _ 10*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;

-- The driver

  MakeCheckPoint: PUBLIC PROCEDURE [name: STRING] =
    BEGIN
    s: StateVector;
    s _ STATE;
    s.stk[0] _ REGISTER[Greg];
    s.stkptr _ 1;
    s.dest _ FrameDefs.SwapOutCode;
    s.source _ GetReturnLink[];
    InstallCheck[name];
    RETURN WITH s;
    END;

  END.