// SaveState.bcpl
// Copyright Xerox Corporation 1979
// Last modified March 5, 1979  1:50 PM by Boggs

get "Streams.d"
get "AltoFileSys.d"
get "AltoDefs.d"
get "Disks.d"

external
[
// outgoing procedures
SaveState

// incoming procedures
OpenFile; Closes; CreateDiskStream
WriteBlock; PositionPage; SetFilePos; GetCompleteFa
OutLd; RealDiskDA; EnumerateFp
ReadDiskDescriptor; WriteDiskDescriptor
MoveBlock; Zero; BitBlt; SetBlock; InitializeZone
MyFrame; ReadCalendar; CallSwat; StartIO
DisableInterrupts; EnableInterrupts

// incoming statics
sysDisk; sysZone; UserName; UserPassword; OsVersion
AltoVersion; SerialNumber; fpSysDir; fpDiskDescriptor
]

//----------------------------------------------------------------------------
let SaveState(filename, flags; numargs na) = valof
//----------------------------------------------------------------------------
// Saves the present core image on an S0 boot file.
// See the BuildBoot documentation for more on boot files.
// This code is is mostly pieces of BootInit.bcpl -- OS initialzation.
// If (flags & 1) ne 0 then flush disk state after creating file.
// If (flags & 2) ne 0 then read disk state after booting.
// Returns:
//	0 if we OutLded
//	1 if we InLded
//	2 if we DiskBooted
//	3 if we EtherBooted
[
if OsVersion ls 16 then CallSwat("OsVersion must be ge 16")
if na eq 1 then flags = 0

Zero(UserName, UserName!-1)
Zero(UserPassword, UserPassword!-1)

let fp, fprd = vec lFP, vec lFP
GetFP(filename, ksTypeWriteOnly, fp, fprd)
if (flags & 1) ne 0 then WriteDiskDescriptor()

// Save page 1 in a vector in our stack.
// Cold starting does not restore it, so we must.
let page1 = vec 256; MoveBlock(page1, 400b, 256)

// If we are started by InLd or BootFrom, we will 'return' from OutLd with:
//	outLdResult = 0 if we OutLded ourself onto the disk
//	outLdResult = 1 if we InLded fro the disk (InLd)
//	outLdResult = 2 if we booted from the disk (hardware Boot or BootFrom)
// If we are started cold, we will 'materialize' at ColdStart with:
//	outLdResult = 3 if we cold started (EtherBoot)
let outLdResult = 0

@0 = 3		// jmp @0 to cold start
@1 = MyFrame()	// stack frame for cold starting
@2 = ColdStart	// -> cold start initialization
@3 = 030001b	// lda 2 1
@4 = 002002b	// jmp @2

ColdStart:
test outLdResult eq 3
   ifso for p = 0 to 6 by 2 do
      [  //restore locations 400b-427b, etc
      let ta =  table [ 400b; 427b; 431b; 520b; 524b; 567b; 600b; 777b ]
      for i = ta!p to ta!(p+1) do @i = page1!(i-400b)
      ]
   ifnot
      [
      outLdResult = 3  //this is the value saved on the file
      DisableInterrupts()
      outLdResult = OutLd(fprd, 0)
      ]

if outLdResult ne 0 then
   [
   SerialNumber = StartIO(0) & 377b
   AltoVersion = (table [ 61014b; 1401b ])()
   @613b = AltoVersion<<VERS.eng gr 1? -1, 0

   if AltoVersion<<VERS.eng eq 3 then
      [
      @MECR = -1  //don't report any errors
      for bank = 1 to 3 do
         [
         bankRegs!0 = bank  //set emulator's alternate bank
         let bbt = vec 16; bbt = (bbt+1) & -2; Zero(bbt, 16)
         bbt>>BBT.dBank = 1
         bbt>>BBT.sBank = 1
         //127 "scan lines" of 512 words each.
         //skip I/O area in high memory.
         bbt>>BBT.dbmr = 512
         bbt>>BBT.sbmr = 512
         bbt>>BBT.dw = 512 * 16
         bbt>>BBT.dh = 127
         BitBlt(bbt)
         ]
      ]
   ]

let temp = @activeInterrupts
@activeInterrupts = 0
EnableInterrupts()
@wakeupsWaiting = 0
@activeInterrupts = temp

@diskAddress = -1  //invalidate disk arm position.
@MESR = 0
@MECR = 177773b	 //correction on, report double errors
SetBlock(0, 77400b, 16)

if (flags & 2) ne 0 then
   [
   ReadDiskDescriptor()
   EnumerateFp(ZapFP)
   MoveBlock(fpSysDir, sysDisk>>DSK.fpSysDir, lFP)
   MoveBlock(fpDiskDescriptor, sysDisk>>DSK.fpDiskDescriptor, lFP)
   GetFP("Swatee", ksTypeReadOnly, 0, trapVector!37b+4)
   GetFP("Swat", ksTypeReadOnly, 0, trapVector!37b+9)
   ]

if outLdResult eq 0 then
   [
   let stream = CreateDiskStream(fp)
   SetFilePos(stream, 0, 6)
   let dv = vec 1; ReadCalendar(dv)
   WriteBlock(stream, dv, 2)
   Closes(stream)
   ]

resultis outLdResult
]

//----------------------------------------------------------------------------
and ZapFP(fp) be Zero(fp, lFP)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and GetFP(filename, type, fp, fprd) be
//----------------------------------------------------------------------------
[
let stream = OpenFile(filename, type, 0, 0, fp)
test stream
   ifso
      [
      if fprd ne 0 then
         [
         let cfa = vec lCFA; GetCompleteFa(stream, cfa)
         MoveBlock(fprd, lv cfa>>CFA.fp, lFP)
         RealDiskDA(sysDisk, cfa>>CFA.fa.da, lv fprd>>FP.leaderVirtualDa)
         ]
      if type eq ksTypeWriteOnly then PositionPage(stream, 256)
      Closes(stream)
      ]
   ifnot SetBlock(fp, -1, lFP)
]