[Indigo]<Spruce>13>SpruceCheck.Bcpl!3

// SpruceCheck.Bcpl -- Read and Write Checkpoints; manage checkpoint levels
// errors 2400

// get spruce.d pulled because compiler can’t handle the whole thing
// get "spruceMisc.d"
get "Sprucedoc.d"
get "SprucePrinters.d"
get "SpruceFiles.d"; // ~~ get "isf.d"
get "altofilesys.d" // ~~ normally requested by isf.d
get "disks.d" // ~~ normally requested by isf.d
// ~~ FM structure from isf.d, since compiler couldn’t handle the whole thing
structure FM: // ~~ paraphrase of isf’s FM structure
[
fp: @FP
blank word 3
blank word 3
blank word// index of last word (a da)
end word// index of end of available space
] // ...
structure SV: [ H [ blank word 4; blank↑2, 11 word ]]

structure STR: [ length byte; char↑1,255 byte ]

compileif newname SpruceSw then [ manifest [ SpruceSw = true ] ] // ~~
manifest SprintSw = not SpruceSw
manifest maxPrinterDevice = 4

external // Defined here
[
CheckPoint// write checkpoints between two specified levels
OpenCheckPointFile
RestoreFromCheckPoint // read checkpoints between two levels
ReleaseCheckLevel
InitCheckZone
LevelPos

ActOnEntry

checkZoneVec
]

external // external
[
//SPRUCE Utils
SpruceError
FSGetX; FSInit; FSPut

// SpruceInUtil (Open only)
MakeValidSpruceFile
SetupDrive

//Spruce Files
CreateSpruceFile
WindowCreateStream
InitSpruceFile; InitSpruceSubfile; ResetSpruceFile
WindowSetBounds; WindowSetPosition
WindowReadBlock; WindowWriteBlock
WindowGetPosition; WindowNextPage

//OS
Gets; Closes
MoveBlock; Noop
OpenFileFromFp
CallSwat
Puts
ReadCalendar
SetFilePos
WriteBlock
InitializeZone
Zero
// other
Min; Ugt; DoubleAdd
Enqueue
VpageToRpage

// incoming statics
// Options
Debug; DebugSystem
DoEtherReport; DoMeter; DoFileMeter
xmFonts
PressServer
tridentUsed; statusOf31s
UseMicroCode; Verbose

// Files, etc.
BandFile; MeterFile; FontFile; QueueFile
CheckPointFile
SpoolFile
freeFile// free area of SpoolFile
RunFile; ErrorFile
//LogFile
tridentDrive; tridentDisk; drive1Disk
sysFont; sysDisk
seed; SpoolVec; LocalDocsVec

// Version stuff
Version; MinorVersion
SpruceVersion; SpruceMinorVersion
SprintVersion; SprintMinorVersion

// Trans-system Parameters
numFilesSpooled
BinCounters; NumBins
Capabilities
DutyCycle
Facets
PolygonRatio
LandscapeDevice
breakPage
PaperDimensionB; PaperDimensionS
printerDevice
ResolutionB; ResolutionS
XOffset; YOffset
printerForward
PaperSpeedInches
ScanLengthInches
ScanMarginAdjust; BitMarginAdjust
FA
nVisibleBands
numMustPrint
LogoFont
LogoText

// Temps used during checkpointing
printDoc; mapTemp; PressFile; CheckPrAttr
CheckFp// globally available cfa for checkpoint file

// Separate, but not equal (e.g., unshared) statics
defaultVec
OverlayTop; PermanentBottom
SpruceZone
checkTime
CpZone

// Spruce only
spooling; printing
printerName
SproullerQ
spruceFPRD; sprintFPRD
pressFileIndex
maxQueued
timeRestart
]
static [ checkZoneVec; dumChk ]

manifest [ lenSysDisk = (size DSK/16)+lKDHeader; lTFSDSK = 100 ]// That should cover it
manifest [ nbfCheck = 2; ncbCheck = 3; nahCheck = 2 ]
// Object types.
// saved with the objects, used during restore as codes to guide RestoreLevel().
manifest
[ // 1 decommissioned earlier -- available for reuse...
CHScalars = 2
CHVector = 3
CHSpruceFile = 4 ; // CHDisk = 5
CHFont = 6
CHSubfile = 7
CHDoc = 8 ; // CHTrident = 9
CHSubfileLocation = 10 // for saving freeFile position
]

// ------------------------------------------------------
// Checkpoint Philosophy:
//There are many occasions during normal Spruce operation when major changes take place in the
// operating environment: Juntas, the elimination of initialization code, overlays, and even the complete
// exchange of memory contents when switching from Spruce, the spooler program, to Sprint, the printer.
// In addition, it is often necessary to reorganize memory, retaining some important global objects while
// eliminating others, and placing the global objects compactly at one end of available memory. Finally,
// although Spruce does not yet exploit it, it should be possible to recover, with minimal loss, from
// crashes or manual program termination (advertent or not.) All this requires that important values and
// objects be saved in some relatively permanent place, and be restored, compactly, to perhaps different
// locations in perhaps (almost) entirely different environments.
//This module accomplishes these functions by means of a multiple-level checkpoint structure in the
// file Spruce.CheckPoints, built around the notion of saving and restoring values named by BCPL statics.

// Major points:
//The numerical checkpoint levels are named in SpruceFiles.d. Lower numbers refer to relatively
// permanent values, created perhaps at installation or initialization time. Higher levels contain dynamic
// objects representing running values (e.g., spooled files) that are created and destroyed more
// frequently. The meanings and uses of the levels are described with the corresponding save functions.
//Restored values are usually stored at the top end of memory, just below the OS kernal and the
// stack, in an area previously belonging to the SpruceZone free storage zone. The free storage zone is
// recreated, diminished in size, after each such call (see FSInit() in SpruceUtils). No objects previously
// allocated from SpruceZone may be trusted. Objects from lower levels are restored first, occupying
// higher memory locations. The client must assist in maintaining this behavior.
//Not all levels must be represented at a given time. The lowest levels are not present during
// normal operation; the most ephemeral levels exist only at the innermost levels of the main spooling
// and printing control loops.
//Client-called functions are available for releasing checkpoint storage above a given level (below a
// corresponding location), and for assigning values to checkpoint storage directly, via a special kind of
// zone. Extreme care is required to use these facilities properly.
//Each level’s objects are stored in a corresponding FIXED-length section of the file. Errors,
// requiring recompilation, occur when these areas overflow. There are two kinds of levels: shared and
// unshared. For unshared levels, Spruce and Sprint have separate, perhaps unequal sized allocations.
//Shared levels are used to communicate between programs.
// Both systems restore objects from them. Such objects are identified by statics that have
// the same names and locations in both systems. This is accomplished using BLDR features for explicit
// static assignment.
// CALLING ORDER:
//RestoreFromCheckPoint(LowLev, HiLev, param, useSpruceZone)
// sets up SpruceZone, and calls CheckPoint with restore = true
//CheckPoint(LowLev, HiLev, restore, param)
// inits checkpointfile, and controls init/restore/save of specified levels.
// The target levels’ bounds are verified, and CheckPointLevel is called to
// get the appropriate routine.
//CheckPointLevel(level, restore)
// Now select and call the appropriate action-routine.

// NOTE: See Version management descriptions in SharedStatics.bcpl.

// Important values:
//PermanentBottom: static controlling allocation of next level. Top of SpruceZone. Client initializes to
// a location just below the stack.
//SharedStatics.bj: the file assigning shared static locations. Changes MUST force new major version.
//SharedStatics.bcpl: the corresp. static decls, and others with common names but unsynched locns.
// ------------------------------------------------------

// ------------------------------------------------------
let CheckPoint(lowLevel, highLevel, restore, param; numargs na) be
// ------------------------------------------------------

//Controls initialization (restore=1), restoration (restore=-1), and saving (restore=0) of a range of
// levels. Will discuss only saving and initialization here. CheckPointFile is initialized and invalidated
// each time due to likelihood that SpruceZone is not the same one as last time.
// Any range of levels may be safely stored (restore=0) without changing SpruceZone. The objects
// may reside anywhere in memory. The utility routines used here are located at the end of the module.
// See the individual Save... routines for details of how the objects are stored.
// For initialialization (restore=1) a different routine is called for each level. In most cases, this
// routine simply empties the level. See CheckVersions() for a special exception.
[
if na<3 then restore = false
if na<4 then param = 0
InitSpruceFile(CheckPointFile, nbfCheck, ncbCheck)
let v = vec 1; checkTime = v; ReadCalendar(checkTime)
let typ = restore < 0? ksTypeReadOnly, ksTypeWriteBeforeRead
let s = WindowCreateStream(CheckPointFile, typ, wordItem, nahCheck)
for level = lowLevel to highLevel do
// Get stream open to right place, then read or write checkpoints
if SetCheckLimits(s, level) then
[
(CheckPointLevel(level, restore)) (s, level, param)
unless restore do ChecordTerminate(s)
]
Closes(s)
ResetSpruceFile(CheckPointFile) // free disk buffers, invalidate file
]

// ------------------------------------------------------
and RestoreFromCheckPoint(lowLevel, highLevel, param, useSpruceZone; numargs na) be
// ------------------------------------------------------

//if useSpruceZone, simply restores the range of levels, allocating multi-word entities from
// SpruceZone. Otherwise, allocates them by diminishing PermanentBottom, then rebuilds SpruceZone,
// invalidating any previous objects in it.
//Client must verify the assertion that lowLevel > (highest currently represented level), by calling
// ReleaseCheckZone() if necessary.
[
// param is passed on to restore routine at each level
// if useSpruceZone is present and true, use SpruceZone for everything
if na<3 then param = 0
if na < 4 then useSpruceZone = false
CpZone = SpruceZone
unless useSpruceZone do
[
if Ugt(OverlayTop+3000, PermanentBottom) then SpruceError(2460)
SpruceZone = OverlayTop+1
InitializeZone(SpruceZone, 1000) // get some working storage for use during restoration
CpZone = InitCheckZone() // linear allocation -- "permanent" zone
]
unless CheckPointFile do SpruceError(2404)
CheckPoint(lowLevel, highLevel, true, param)
unless useSpruceZone do FSInit() // SpruceZone ← scratch zone
]

// ------------------------------------------------------
and ActOnEntry(pageNumber, restore, s; numargs na) be
// ------------------------------------------------------
// restore param controls restore/save (true/false)
//printDoc>>DocG
//PressFile>>SPruceFile
//mapTemp>>Fmap
// s, if present, is an existing filestream
[
if pageNumber eq 0 then CallSwat("Illegal page number zero")
pageNumber = pageNumber - 1
//restore objects into SpruceZone
CpZone = SpruceZone
InitSpruceFile(QueueFile, 4, 5)
let typ = restore ? ksTypeReadOnly, ksTypeWriteBeforeRead
if na ls 3 then//Caller did not supply stream, so we make our own
s = WindowCreateStream(QueueFile, typ, wordItem)
// Get stream open to right place, then read or write page
let pos = vec 1
pos!0 = 0; pos!1 = pageNumber*1024
WindowSetPosition(s, pos)
test restore
ifso
RestoreLevel(s, LEVSharedRun, CHDoc)
ifnot
[
SaveDoc(s, lv printDoc)
ChecordTerminate(s)
]
if na ls 3 then//Caller did not supply stream, so we clean up our own
[
Closes(s)
ResetSpruceFile(QueueFile) //free disk buffers, invalidate file
]
CpZone = InitCheckZone()//recreate CpZone
]

// ------- Level-specific CheckPointing (storing) routines -------

// ------------------------------------------------------
and CheckVersions(s) be// LEVSharedVersions
// ------------------------------------------------------
//Saves all known versions for both systems, both at initialization (restore=1) and storing (=0)
// times. See Version discussions in SharedStatics.bcpl.
[
SaveScalars(s, lv SpruceVersion, lv SpruceMinorVersion, lv SprintVersion, lv SprintMinorVersion)
ChecordTerminate(s)
]

// ------------------------------------------------------
and CheckSharedInstStatics(s) be // LEVSharedInstStatics
// ------------------------------------------------------
//These values are the results of system installation (see SpruceInstall(), SprintInstall()). They are
// used to provide defaults for subsequent installation, and as defaults for the initialization process and
// for system operation, if not overriden. See the SharedStatics.bcpl for functional descriptions of the
// statics. See the individual Save... routines for details of how each kind of object is saved.
//At present, only Spruce contributes values to any of the shared levels. Sprint uses the information
// in its operations. Sprint communicates its results mostly through InLd messages only (see SwapSystem in
// SpruceUtils(), corresponding code in Spruce()). See LEVReport for exception.
[ compileif SpruceSw then [ // Sprint only restores
SaveScalars(s,lv DoEtherReport, lv DoMeter, lv DoFileMeter, lv DebugSystem)
SaveScalars(s, lv Capabilities, lv NumBins, lv DutyCycle, lv Facets, lv PolygonRatio)
SaveScalars(s,lv breakPage, lv PaperDimensionB, lv PaperDimensionS, lv LandscapeDevice)
SaveScalars(s,lv printerDevice, lv ResolutionB, lv ResolutionS,
lv XOffset, lv YOffset,
lv printerForward, lv PaperSpeedInches, lv ScanMarginAdjust,
lv BitMarginAdjust, lv ScanLengthInches)
SaveScalars(s,lv tridentUsed, lv tridentDrive, lv statusOf31s)
SaveVector(s, lv printerName, printerName>>STR.length/2+1)
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Save the map/file pairs
SaveFile(s,lv BandFile)
SaveFile(s,lv MeterFile)
SaveFile(s,lv FontFile)
SaveFile(s,lv SpoolFile)
SaveFile(s,lv ErrorFile)
//SaveFile(s,lv LogFile)
SaveFile(s, lv QueueFile)
] ]

// ---------------------------------------------------
and CheckEternalStatics(s) be //LEVEternalStatics
// ----------------------------------------------------
[
compileif SpruceSw then [
SaveScalars(s, lv pressFileIndex)
SaveVector(s, lv seed, 2)
SaveVector(s, lv SpoolVec, maxSpooled+1)
SaveVector(s, lv LocalDocsVec, (LocalDocsVec!0) + 1)
] ]

// ---------------------------------------------------
and CheckSharedPrinterAttr(s) be //need CheckPrAttr in sharedStatics~~~~~~~~~~
// ----------------------------------------------------
[
SaveVector(s, lv CheckPrAttr, lenPrAttr*(maxPrinterDevice+1))
]

// ------------------------------------------------------
and CheckInstallationStatics(s) be// LEVInstallationStatics
// ------------------------------------------------------
//Some non-shared values specific to each system, to be transmitted from installation to
// initialization. RunFile, if present, participates in overlays. The FPRDs are specially mangled file
// pointers used in InLd and OutLd.
[
compiletest SpruceSw then [ SaveScalars(s, lv maxQueued) ]
or [ SaveVector (s, lv sprintFPRD, lFP) ]
SaveVector(s,lv spruceFPRD, lFP)
SaveFile(s,lv RunFile)
]

// ------- Level-specific CheckPointing (storing) routines . . .

// ------------------------------------------------------
and CheckSharedInitStatics(s) be// LEVSharedInitStatics
// ------------------------------------------------------
//Includes all shared installation values. Restoration for actual system operation begins at this
// level, leaving the original defaults for the next system startup or installation. Includes objects (e.g.,
// disk structures) that are recreated between install. and init., but are too costly to recreate during
// subsequent normal operation. Includes other objects that do not have installation defaults.
[ compileif SpruceSw then [ // Sprint only restores
CheckSharedInstStatics(s)
SaveScalars(s,lv Debug, lv DebugSystem, lv UseMicroCode, lv Verbose)
SaveScalars(s, lv FA, lv nVisibleBands, lv xmFonts)
SaveVector(s, lv LogoFont, @LogoFont)
SaveVector(s, lv LogoText, (LogoText>>STR.length + 1)/2)
] ]
// ------------------------------------------------------
and CheckInitialStatics(s) be// LEVInitialStatics
// ------------------------------------------------------
//sysFont must be saved because Junta back to levBFSBase destroys it. The computation of sysFont
// length, without referring to its source file, is done by knowing the structure of blocks allocated from
// standard Alloc package zones, and that the sysFont pointer is displaced +2 from the beginning of its
// block. ~~ Consider a change.
[ compileif SpruceSw then [
CheckInstallationStatics(s)
SaveVector(s, lv BinCounters, NumBins)
SaveVector(s,lv sprintFPRD, lFP) // if it exists
sysFont = sysFont-2
SaveVector(s,lv sysFont, -(sysFont!-1)-1, CHFont)
sysFont = sysFont+2 // Restore code will readjust
SaveScalars(s, lv PressServer, lv spooling)
//SaveDoc(s, lv printDoc) // Save over Junta
] ]

// ------------------------------------------------------
and CheckSharedRun(s) be// LEVSharedRun
// ------------------------------------------------------
//A few global values describing the spooling state and the debugging state
[ compileif SpruceSw then [
SaveScalars(s, lv numFilesSpooled, lv Capabilities, lv numMustPrint, lv DebugSystem)
] ]

// ------------------------------------------------------
and CheckRun(s) be// LEVRun
// ------------------------------------------------------
//A few values saved for the spooler (Spruce) while running the printer (Sprint)
[ compileif SpruceSw then [
SaveScalars(s, lv spooling, lv printing, lv pressFileIndex, lv PressServer)
SaveVector(s, lv timeRestart, 2)
SaveSubfileLoc(s, lv freeFile)
] ]

// ------------------------------------------------------
and CheckRequests(s) be// LEVRunDocs
// ------------------------------------------------------
//The spool queue documents, sorted in print-priority order, saved here by Spruce. See
// RestorePrintRequests() for the special method used by Sprint to retrieve them.
// This will probably go away
[ compileif SpruceSw then [
let doc = @SproullerQ
while doc do
[
printDoc = doc
SaveDoc(s, lv printDoc)
doc = @doc
]
] ]

// ------------------------------------------------------
and CheckReport(s) be // LEVReport
// ------------------------------------------------------
//Intended for use by Sprint in reporting results. Currently used to share BinCounters.
[ SaveVector(s, lv BinCounters, NumBins) ]

// ------- Routines for storing the various object types -------
// ------------------------------------------------------
and SaveScalars(s,statics,nil, nil,nil,nil,nil,nil,nil,nil,nil; numargs na) be
// ------------------------------------------------------
//See ChecordHeader() in utility routines. All arguments beyond the destination stream are pointers
// to static locations. Scalars are stored by storing merely the static adresses and current static values.
// Restoration is equally simple. Limit 10 scalars per call.
[
if na > 11 then SpruceError(2410, na-1)
let pStatic = lv statics
ChecordHeader(s,CHScalars,(na-1)*2)
for i = 0 to na-2 do [ Puts(s, pStatic!0); Puts(s, @(pStatic!0)); pStatic = pStatic+1 ]
]

// ------------------------------------------------------
and SaveVector(s, pStatic, length, type; numargs na) be
// ------------------------------------------------------
//The primary worker for non-scalar objects. Any object that does not have embedded pointers and
// does not require special processing when restored may be saved as a type CHVector, by calling this
// routine directly and omitting the type argument. Otherwise, the Check...() routine should call one of
// the specific Save...() routines below, which will supply the type.
//pStatic, here and in the routines that follow, is the address of the static containing the object.
[
unless @pStatic return
ChecordHeader(s,(na < 4? CHVector, type),length+1)
Puts(s,pStatic); unless WindowWriteBlock(s,@pStatic,length) eq length do SpruceError(2470)
]

// ------------------------------------------------------
and SaveFile(s, pStatic) be
// ------------------------------------------------------
//A SPruceFile, whether primary or a subfile, has a map denoted by an embedded pointer. For
// primary files, save both, saving the map as (by copying its pointer to) the static mapTemp, then the
// file structure. Restoration code will reverse the operation, knowing the store sequence.
[
let sFile = @pStatic; unless sFile return; ResetSpruceFile(sFile)
mapTemp = sFile>>SPruceFile.map
SaveVector(s, lv mapTemp, mapTemp>>FM.end); SaveVector(s, pStatic, lenSPruceFile, CHSpruceFile)
]

// ------------------------------------------------------
and SaveSubfile(s, pStatic) be
// ------------------------------------------------------
//A subfile’s superFile is denoted by a pointer to the superFile’s static (relatively restrictive!) The
// superFile must be restored first. The restore code updates the subfile’s map from that of its parent.
[ ResetSpruceFile(@pStatic); SaveVector(s, pStatic, lenSPruceFile, CHSubfile) ]

// ------------------------------------------------------
and SaveSubfileLoc(s, pStatic) be // save current position, size of subfile within its parent
// ------------------------------------------------------
//Used for saving freeFile location for Spruce. Saves static address of superfile, and information
// needed to relocate the subfile within the superFile. ~~ Consider standardizing on one method.
[
let sFile = @pStatic; unless sFile>>SPruceFile.isSubFile do SpruceError(2480)
let v = vec 4; dumChk = v // some static to refill
v!0 = pStatic; v!1 = VpageToRpage(sFile, 1)
v!2 = sFile>>SPruceFile.numPages; v!3 = sFile>>SPruceFile.numChars
SaveVector(s, lv dumChk, 4, CHSubfileLocation)
]

// ------------------------------------------------------
and SaveDoc(s, pStatic) be
// ------------------------------------------------------
//Saves file or subfile representing spooled document (as PressFile), then DocG structure itself.
[
PressFile = pStatic=>DocG.PressFile
if PressFile ne -1 then (PressFile>>SPruceFile.isSubFile? SaveSubfile, SaveFile)(s, lv PressFile)
SaveVector(s, pStatic, lenDocG, CHDoc)
]

// ------------------------------------------------------
and RestoreLevel(s, level, breakType; numargs na) be
// ------------------------------------------------------
//Called directly by CheckPoint control to restore all levels except RunDocs in Sprint. All vector
// objects dispatch to the vector-restoring case first, then to 100+CHtype for special handing.
//If breakType is supplied, an entry of that type terminates restoration -- used to obtain single
// entries from LEVRunDocs via the RestorePrintRequest() routine, below.
//Remembers the max address for each level, for use by ReleaseCheckLevel.
[
if na < 3 then breakType = 0
// Save the position of PermanentBottom before restoring objects in a given level.
// The saved value helps to compute the area of core we throw away when it’s
// time to reclaim core occupied by some level(s).
unless CpZone eq SpruceZone do checkZoneVec!level = PermanentBottom
[
let type, v, pStatic = Gets(s), nil, nil
if type eq 0 return // end of level
let length = (lv type)>>CHecord.length-LenCHecord
type = (lv type)>>CHecord.type
// Time no longer exists in CHecord struct
//Gets(s); Gets(s) // Time, ignore for now
switchon type into
[
case CHScalars:
for i = 1 to length/2 do
[ pStatic = Gets(s); @pStatic = Gets(s) ]
endcase
case CHVector: case CHSpruceFile: case CHFont:
case CHSubfile: case CHDoc: case CHSubfileLocation:
[
length = length-1 // account for static address
v = FSGetX(length, CpZone, 0)
pStatic = Gets(s); @pStatic = v
WindowReadBlock(s, v, length)
docase 100+type // further descriminate
]
case 100+CHSpruceFile:
v>>SPruceFile.map = mapTemp // set up just previously
// v>>SPruceFile.valid = false // always saved in invalid state
endcase
case 100+CHFont:
@pStatic = @pStatic+2
endcase
case 100+CHSubfile: [
let superFile = @(v>>SPruceFile.lvSuperFile)
unless superFile do SpruceError(2480)
v>>SPruceFile.map = superFile>>SPruceFile.map
// v>>SPruceFile.valid = false // always saved in invalid state
endcase ]
case 100+CHSubfileLocation: [
let f = @(v!0) // file to be updated, see SaveSubfileLoc
unless f do SpruceError(2480)
InitSpruceSubfile(f, v!1, v!2, v!3)
endcase ]
case 100+CHDoc:
if PressFile then v>>DocG.PressFile = PressFile // see CheckRequests
compileif SpruceSw then
[ if SproullerQ & level eq LEVRunDocs then Enqueue(SproullerQ, v) ]
// endcase
case 100+CHVector:
endcase
default: SpruceError(2430, level)
]
if type eq breakType return
] repeat
]

// ------------------------------------------------------
and RestorePrintRequest(s, level, fileIndex) be
// ------------------------------------------------------
//Using the breakType feature of RestoreLevel, retrieve the pDoc structure for the fileIndex’th
// spooled file (fileIndex = 1, 2, 3, . . . )
// Eventually remove this routine, (only used by Sprint)
[
PressFile = 0; let lenEntry = lenDocG+lenSPruceFile+2*LenCHecord+2
let v = vec 1; v!0 = 0; v!1 = WindowGetPosition(s) + (fileIndex-1)*lenEntry
WindowSetPosition(s, v)
RestoreLevel(s, level, CHDoc) // restore subfile, document
]

// ------- Checkpoint utilities -- selecting checkpoint file regions, store/restore routines -------
// ------------------------------------------------------
and SetCheckLimits(s, level) = valof
// ------------------------------------------------------
//Bound the checkpoint file region corresponding to level (to catch errors and overflows), and
// position stream at the region’s origin. Return false if there is no space assigned to this level (used
// when Spruce has something to store and Sprint doesn’t).
[
let v, i = nil, nil
let lP, lP2 = 0, LevelPos(s, level, false, lv v) // file is relatively short
let hP, hP2 = 0, LevelPos(s, level, true, lv i)
WindowSetBounds(s, lv lP, lv hP)
WindowSetPosition(s, lv lP)
resultis v ne i
]

// ------------------------------------------------------
and LevelPos(s, level, topLim, pPage; numargs na) = valof
// ------------------------------------------------------
//Returns the file position of the origin or end (depending on topLim) of the specified region. Stores
// the corresponding file page number in @pPages, if supplied. Responds to an out of range request by
// storing the required checkpoint file size, in pages, into @pPage.
//Distinguishes between Spruce and Sprint and chooses the appropriate file area.
[
manifest serviceOffset = SprintSw? 1, 0
if na<3 then topLim = false
//let sink = nil
//if na<4 then pPage = lv sink
let pageTable = table [
0 lshift 8 + 36 // pages needed, request by exceeding maxLEV
// left byte: number of pages in level -- right byte: first page in level
1 lshift 8 + 1// LEVSharedVersions (1st entry for Spruce, 2d is Sprint) -- 0
1 lshift 8 + 1
3 lshift 8 + 2// LEVSharedInstStatics -- 1
3 lshift 8 + 2
1 lshift 8 + 5//LEVSharedPrinterAttr -- 2
1 lshift 8 + 5
2 lshift 8 + 6// LEVEternalStatics -- 3
2 lshift 8 + 6
1 lshift 8 + 8// LEVInstallationStatics, Spruce -- 4
0 lshift 8 + 9// Sprint
5 lshift 8 + 9// LEVSharedInitStatics -- 5
5 lshift 8 + 9
8 lshift 8 + 14// LEVInitialStatics, Spruce -- 6
0 lshift 8 + 22// Sprint
1 lshift 8 + 22// LEVSharedRun -- 7
1 lshift 8 + 22
1 lshift 8 + 23// LEVRun, Spruce -- 8
0 lshift 8 + 24// Sprint
12 lshift 8 + 24// LEVRunDocs -- 9
12 lshift 8 + 24
1 lshift 8 + 36// LEVReport -- 10
1 lshift 8 + 36
0 lshift 8 + 36// level 11 currently unoccupied
0 lshift 8 + 36
]
level = level>maxLEV? 0, (level+1)*2-(SprintSw? 0, 1)
let levelPage = pageTable!level
levelPage = (levelPageŹ) + (topLim? levelPage rshift 8, 0)
if na eq 4 then @pPage = levelPage
let ln = s? s>>SS.spruceFile>>SPruceFile.lnPageSize, sysDisk>>DSK.lnPageSize
resultis (levelPage-1) lshift ln // must be relatively small file
]

// ------- Checkpoint utilities -- selecting checkpoint file regions, store/restore routines . . .
// ------------------------------------------------------
and CheckPointLevel(level, restore) = selecton restore into
// ------------------------------------------------------
//Returns a routine to execute corresponding to the level and the nature of the activity
// (initialization, saving, restoring)
[
case -1: selecton level into
[
default: RestoreLevel
case LEVRunDocs: (SpruceSw? RestoreLevel, RestorePrintRequest)
]
case 0: selecton level into
[
case LEVSharedVersions: CheckVersions
case LEVSharedInstStatics: CheckSharedInstStatics
case LEVSharedPrinterAttr: CheckSharedPrinterAttr
case LEVEternalStatics: CheckEternalStatics
case LEVInstallationStatics: CheckInstallationStatics
case LEVSharedInitStatics: CheckSharedInitStatics
case LEVInitialStatics: CheckInitialStatics
case LEVSharedRun: CheckSharedRun
case LEVRun: CheckRun
case LEVRunDocs: CheckRequests
case LEVReport: CheckReport
default: CheckError
]
case 1: selecton level into
[
case LEVSharedVersions: CheckVersions
case LEVSharedInstStatics: case LEVSharedInitStatics: case LEVSharedPrinterAttr:
case LEVSharedRun: case LEVRunDocs: SpruceSw? ChecordTerminate, Noop
default: ChecordTerminate
]
default: CheckError
]

// ------------------------------------------------------
and CheckError() be SpruceError(2450)// invalid routine request
// ------------------------------------------------------

// ------- Checkpoint utilities -- CheckZone management -------
// ------------------------------------------------------
and InitCheckZone() = valof
// ------------------------------------------------------
//Zone with trivial allocator, Free() disallowed. Allocates checkZoneVec if doesn’t exist.
[
unless PermanentBottom do SpruceError(2440)
let v = table [ 0; 0 ]
v>>ZN.Allocate = PermanentAllocate; v>>ZN.Free = CzvTrap
unless checkZoneVec do checkZoneVec = FSGetX(maxLEV+1, v, 0)
resultis v
]; and CzvTrap() be SpruceError(112)

// ------------------------------------------------------
and PermanentAllocate(v, Size) = valof// the trivial allocator
// ------------------------------------------------------
[
PermanentBottom = PermanentBottom-Size
// if Free routine is NOT CzvTrap and maxAdr is greater than permanentBottom
if SpruceZone!1 ne CzvTrap & Ugt(SpruceZone!9, PermanentBottom) &
((DebugSystem & #40000) eq 0) then
CallSwat("[DebugSystem&40000] CpZone has clobbered SpruceZone")
resultis PermanentBottom
]

// ------------------------------------------------------
and ReleaseCheckLevel(level) be
// ------------------------------------------------------
//Restores PermanentBottom to the max location used by the first currently resident level greater
// than the one requested. (Tosses out all levels >= the one specified.)
[
let permBot = 0
for i = level to maxLEV do if checkZoneVec!level then
[ permBot = checkZoneVec!level; level = i; break ]
unless permBot return
PermanentBottom = permBot
Zero(lv checkZoneVec!level, maxLEV-level+1) // ~~ Consider FSInit() here
]

// ------- Utilities for Storing objects -- Checkpoint file init. -------
// ------------------------------------------------------
and ChecordHeader(s, type, length) be
// ------------------------------------------------------
//Writes header. See CHecord structure in SpruceFiles.d. Current time not now exploited.
// removed time from CHecord structure
[
let v = length+LenCHecord
if v ge (1 lshift 12) then SpruceError(2400, type, length)
let typeWord = nil
(lv typeWord)>>CHecord.type = type
(lv typeWord)>>CHecord.length = v
Puts(s,typeWord)
//Puts(s,checkTime!0)
//Puts(s,checkTime!1)
]

// ------------------------------------------------------
and ChecordTerminate(s) be Puts(s,0) // Type 0 terminates level
// ------------------------------------------------------
// ------------------------------------------------------
and OpenCheckPointFile(runCfa) = valof // returns true if there were previous contents
// ------------------------------------------------------

// runCfa, if non-zero grants permission to create file -- provided by OS at system startup.
// ACTIVITIES:
//Clear out all knowledge of checkpoint file, or checkpoint storage -- Called when system just
// started or post-junta, when all is invalid.
//CheckFp may contain an fp hint for the checkpoint file. If it’s wrong or unintialized, create the
// file or complain, depending on value of runCfa. Store new fp in CheckFp and run file layout vector
// (see Spruce() and Sprint() for CheckFp initialization.)
//If the correct-length file existed, perform version checks as described in SharedStatics.bcpl.
//Returns true only if previous contents existed, and major and minor versions checked.
[
// neither SpruceZone, checkZone, nor CheckPointFile should contain anything valuable
// if runCfa, can create new CheckpointFile, store its cfa in layout vector area
// otherwise, CheckFp must already be valid cfa for checkpoint file.
// SpruceZone is reinitialized on exit -- CheckPointFile is allocated in CpZone
checkZoneVec, CheckPointFile = 0, 0
// CheckPoint file creation requires more space (Allocate more for Sprint)
SpruceZone = InitializeZone(OverlayTop+1, 1100 + (SpruceSw ? 0, 2000) )
CpZone = InitCheckZone()
unless sysDisk do SetupDrive(DISK31, CpZone)
let nP = nil; LevelPos(0, maxLEV+1, false, lv nP)
let contentsOK = false
if CheckFp>>FP.leaderVirtualDa ne -1 then [ // returns 0 if check error
CheckPointFile = CreateSpruceFile(CheckFp, nP, SpruceZone, DISK31, CpZone)
contentsOK = CheckPointFile ne 0
]
unless CheckPointFile do [
// CheckPoint file does not exist, and we are not supposed to create one.
unless runCfa do SpruceError(2406)
contentsOK =
MakeValidSpruceFile(lv CheckPointFile, "Spruce.CheckPoints", nP,DISK31, CpZone)
MoveBlock(CheckFp, lv (CheckPointFile>>SPruceFile.map)>>FM.fp, lFP)
let s = OpenFileFromFp(runCfa)
if s then
[ SetFilePos(s, table [ 0; size SV.H/8 ]); WriteBlock(s, CheckFp, lFP); Closes(s) ]
]
if runCfa¬ CheckPointFile then SpruceError(2404)
if not runCfa&(not CheckPointFile % not contentsOK) then SpruceError(2406)
FSInit() // standard state after checkpoint operation
let vPtr = SpruceSw? lv SpruceVersion, lv SprintVersion
if contentsOK then // we’ll see about that
[
RestoreFromCheckPoint(LEVSharedVersions, LEVSharedVersions, 0, true)
unless Version eq vPtr!0 & MinorVersion eq vPtr!1 do contentsOK = false
]
unless contentsOK do
[ vPtr!0 = Version; vPtr!1 = MinorVersion; CheckPoint(LEVSharedVersions, maxLEV, 1) ]
resultis contentsOK
]

// ------- History . . .

// DCS, July 3, 1977 11:56 AM, created
// July 5, 1977 10:49 AM, continue development
// July 5, 1977 1:55 PM, add restore code
// July 5, 1977 10:36 PM, modifications listed in 7-5 hardcopy
// July 8, 1977 9:41 AM, memory management repairs
// July 8, 1977 12:15 PM, voluminous syntax errors
// July 11, 1977 6:22 PM, add drive1Disk to static savings, react to SpruceFile mods
// July 15, 1977 4:27 PM, conditional compilation to distinguish
//Sprouller from Spruce
// July 19, 1977 2:26 PM, save sysFont in LEVInitialStatics
// July 21, 1977 3:08 PM, revise for shared statics system
// July 21, 1977 4:54 PM, add LEVRun level, dummy LEVReport level
// July 22, 1977 2:38 PM, add LEVRunDocs level
// July 25, 1977 9:53 AM, improve LEVRun state saving, LEVRunDocs restoration,
//allow use of SpruceZone for restoration
// July 25, 1977 1:23 PM, modify Run, RunDocs levels
// July 28, 1977 9:15 AM, null CheckInitialStatics level for Spruce
// July 28, 1977 3:21 PM, ship out LevelPos; high-value returns # pgs needed
//LevelPos uses sysDisk page size if stream arg is 0
// July 29, 1977 3:35 PM, Stand alone system works better, Spruce installation improvements
// July 29, 1977 4:30 PM, non-server printer runDocs restore restores whole level
// July 30, 1977 10:14 PM, save ScanLengthInches to reach working spooled printer
// August 2, 1977 12:05 AM, if file is -1, don’t save
// August 26, 1977 10:27 PM, wasn’t nulling InitialStatics area for Spruce
// August 28, 1977 8:20 AM, Spruce->Sprint, Sprouller->Spruce
// September 5, 1977 11:54 AM, save maxQueued, numMustPrint
// September 5, 1977 11:54 AM, add pPage arg to LevelPos for direct page # output
// September 30, 1977 2:27 PM, add DebugSystem to inst, init levels
// October 17, 1977 11:45 AM, save XOffset, YOffset as inst., init., Versions 4.(0,0)
// October 25, 1977 10:16 AM, save DebugSystem at LEVRun
// November 3, 1977 8:10 PM, not PressServer modifications, v4.(2,7)
// December 20, 1977 3:30 PM, make T80 code honest
// January 2, 1978 8:27 AM, tridentDisk obtained from checkpoints again
// January 20, 1978 2:11 PM, accommodate new overlay structures
// January 22, 1978 4:47 PM, do tridentDisk object routine inits in Sprint -- after overlay in
// February 3, 1978 11:07 PM, replace garbage param arg to Res...oint with 0
// March 3, 1978 7:12 AM, V6.0, OS14, new time standard
// March 7, 1978 10:11 AM, don’t share sysFont -- Sprint doesn’t need it -- adjust level sizes
// March 28, 1978 11:30 AM, checkpoint file not big enuf for some peoples’ sysfont files
// September 3, 1978 7:19 PM, change superFile management, add SaveSubfileLoc
// (other changes have been introduced here recently, too (save freeFile info), not recorded)
// September 9, 1978 1:41 PM, OpenCheckPointFile -- new installation facilities
// September 12, 1978 11:27 PM, another new way to Open checkpoint file
// September 14, 1978 11:05 AM, simplify old check file exists test
// September 14, 1978 4:53 PM, refurbish level scheme, add new version stuff
// September 18, 1978 9:38 AM, minor mods to file create stuff
// September 19, 1978 5:16 PM, format, document
// September 22, 1978 2:35 PM, save sprintFPRD for Sprint at InstStatics time
// September 22, 1978 11:01 PM, save spooling in more places, save timeRestart
// October 15, 1978 3:49 PM, modify buffering for fast files
// October 19, 1978 12:15 PM, two31sUsed was being stored in shared space!!
// October 29, 1978 4:08 PM, disk structures not saved and restored -- recreated each time:
//two31sUsed -> statusOf31s
// November 30, 1978 10:27 AM first cut at adding LevSharedPrinterAttributes
// December 3, 1978 5:36 PM use only parts of Spruce.d
// April 25, 1979 4:39 PM, save xmFonts value
// August 9, 1979 8:56 AM, save Capabilities at CheckRun
// August 29, 1979 12:18 PM, save and restore BinCounters and NumBins, begin using LEVReport
// September 26, 1979 3:06 PM, RestoreFromCheckpoint in OpenCheckPointFile uses SpruceZone
// November 16, 1979 1:34 PM, save LogoText and LogoFont in SharedInit
// February 15, 1980 9:50 AM, reduced size of SpruceZone in OpenCheckPointFile
//SpruceZone was overlapping CPZone in Spruce installation
// September 23, 1982 12:24 PM reduced size of SpruceZone in OpenCheckPointFile
// (again!). SpruceZone was still too big!
// September 24, 1982 12:33 PM modified RestoreLevel() to only queue CHDOCs
// from LEVRunDocs
// October 2, 1982 9:09 AM reduced size of SpruceZone in OpenCheckPointFile (again! again! again!)
//October 6, 1982 10:50 AM add check in PermanentAllocate() to catch CpZone
//trashing SpruceZone, reduced size of SpruceZone.