// Install.Bcpl -- OS install sequence 
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified June 9, 1982  1:25 AM by Boggs

get "AltoFileSys.d"
get "Disks.d"
get "Bfs.d"
get "Streams.d"
get "SysDefs.d"
get "AltoDefs.d"
get "SysInternals.d"
get "BcplFiles.d"

external
[
// outgoing procedures
Install; VerifyInstalled

// incoming procedures
Password; EraseDisk; ExtendDisk
YesNo; GetString; ReadNumber; GetNthLevel
JuntaReturn; CreateSysDisk; CloseDisk

OpenFile; ReadBlock
GetCompleteFa; PositionPage
FileLength; FilePos
Gets; Puts; Resets; Closes
Ws; Wns; BFSWriteDiskDescriptor

CharWidth; EraseBits

RealDiskDA
Zero; MoveBlock; BitBlt
Usc; DoubleAdd; StartIO; MyFrame
DisableInterrupts; EnableInterrupts
Timer; ReadCalendar

CallSwat; OutLd; OsFinish

// incoming statics
OsFinishSafeAdr; OsFinishCode
ErrorLogAddress; EventVector
UserName; UserPassword; OsBuffer
lvParitySweepCount; lvParityPhantomEnable
juntaTable; sysDisk; lvAbortFlag
dsp; keys; sysMECR; dirVersions
]

manifest
[
logWordsPerPage = 8
wordsPerPage = 1 lshift logWordsPerPage
]

structure PORT:		// Must match Pup package definition
[
net byte; host byte
soc^1,2 word
]

//Layout of memory when OutLd'ed on the disk (e.g., the way it will
// look when InLd'ed again - these are not file addresses):
//	page 0 -- has pointers to Bcpl runtime routines
//	page 1 -- I/O stuff + mask tables initialized
//	1000b -- User Name and Disk name (see AskUser in this file)
//		(Note: this position is "published" to the Executive,
//		which reads the boot file to find the disk name.)
//	1200b -- Password information (see AskUser, TellUser in this file)
//	1375b-1376b -- local time conversion parameters
//	1377b -- the length of HiddenFTP.Run file saved in core
//	1400b to xxxx -- HiddenFTP.Run file saved during install
//		so it can initialize a virgin disk.
//	StartOS -- a piece of machine language code just for starting
//		up the first (once-only) time -- thereafter not needed.
//	JuntaReturn -- the lowest piece of the "OS".
//	JuntaReturn to initStackLimit -- the "initialization" code
//		for the OS, including bootinit, install, etc.
//	initStackLimit to stackRoot -- the initial system stack.
//	stackRoot to 176777b -- the REAL OS: the part that is around
//		when the Executive gets control.

//----------------------------------------------------------------------------
let Install(onceFlag) be
//----------------------------------------------------------------------------
[
test onceFlag
   ifso	//Set some default names
      [
      MoveBlock(UserName, "NoName", 4)
      MoveBlock(userDiskName, "NoName", 4)
      MoveBlock(1004b, "New Os Disk", 6)
      diskPassword!0 = 0  //no password
      Zero(1375b, 2)  //no time conversion params in an uninstalled OS
      ]
   ifnot
      [
      MoveBlock(1375b, timeParams, 2)  //Sys.boot _ current time params
      AskUser()  //Find out his ambitions
      ]

// Almost anything may have happened to the disk by here.
// It may have been erased, a new disk may have been slipped in...
CreateSysDisk()

if onceFlag then
   [
   // There is this special, small version of Ftp that the OS keeps
   // inside of itself for use by EraseDisk, called FtpOs.run.
   let s = OpenFile("FtpOs.Run.", ksTypeReadOnly)
   let gotit = false
   if s then
      [
      // Read FtpOs from the disk into spare memory area.
      FileLength(s)  //move quickly to the end
      let p = vec 1; FilePos(s, p)  //and remember where it is
      let FTPLen = (p!0 lshift 15) + (p!1 rshift 1)
      // make sure it will fit:
      if Usc(JuntaReturn-ftpOs, FTPLen) gr 0 then
         [
         Resets(s)
         ReadBlock(s, ftpOs, FTPLen)
         ftpOs!-1 = FTPLen
         // Following patch is to fool CallSubsys when it is called on this
         // file.  It is important that FTP's CFA be returned properly.
         // Note that the patch is "undone" in EraseDisk when writing the
         // file out during a full disk init operation.
         ftpOs>>SV.H.length = ftpOs>>SV.H.length+2
         gotit = true
         ]
      Closes(s)
      ]
   unless gotit do CallSwat("Failed to install FtpOs.Run")
   // this is of course, nonfatal, you can proceed;
   // you just can't erase a disk without it.
   ]

// Install (cont'd)

// Build junta entries
OsFinishSafeAdr = JuntaReturn-wordsPerPage  //1 page used for buffer
juntaTable>>JT.jReturn = JuntaReturn
if (JuntaReturn & 377B) ne 0 then CallSwat("OS loaded wrong")
let i = 0
while GetNthLevel(i, (lv juntaTable>>JT.jTable)+2*i) do i = i +1
juntaTable>>JT.jLevels = i

// Create the S0-boot file and then OutLd on it.
// An OutLd file is 257 pages long:
// File page:   0       1       2      3  ...  253      254     255     256
// Contents:  leader  loader  page2  page3...page 253  page 1  page 0  empty
let s = OpenFile("Sys.Boot", 0, 0, verLatestCreate)
let bootFp = vec lCFA; GetCompleteFa(s, bootFp)
RealDiskDA(sysDisk, bootFp>>CFA.fa.da, lv bootFp>>CFA.fp.leaderVirtualDa)
PositionPage(s, JuntaReturn rshift logWordsPerPage)  //Write the first part
let jrCFA = vec lCFA; GetCompleteFa(s, jrCFA)  //Find out where we are
PositionPage(s, 255+1)	//Write the last part
Closes(s)	//And done

// In case it was changed by any file creations so far...
BFSWriteDiskDescriptor(sysDisk)

// Now make the boot label for CounterJunta.
// Don't do it if this is the very first install -- that way
//  this file will never appear "installed" on any disk.
let p = lv juntaTable>>JT.BootLabel
Zero(p, lDL)
unless onceFlag do
   [
   MoveBlock(lv p>>DL.fileId.serialNumber, lv jrCFA>>CFA.fp.serialNumber, lSN)
   p>>DL.fileId.version = jrCFA>>CFA.fp.version
   // Page containing JuntaReturn
   RealDiskDA(sysDisk, jrCFA>>CFA.fa.da, lv p>>DL.next)
   // So Exec knows where booted from
   p>>DL.previous = jrCFA>>CFA.fp.leaderVirtualDa
   ]

onceFlag = false  //If loop, be sure to make Junta BootLabel

// Try to keep user from saving password on disk in any way
Zero(UserPassword, UserPassword!-1)
Zero(OsBuffer+4, OsBuffer!-1)
Resets(keys)

// Install (cont'd)

// 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)  //used in two places

// If we are started by InLd or BootFrom, we will "return" from OutLd with:
//	flag = 0 if we OutLded ourself onto the disk
//	flag = 1 if we InLded from the disk (normal case)
//	flag = 2 if we booted from the disk (BootFrom)
// If we are started cold, we will "materialize" at ColdStart with:
//	flag = 3 if we cold started (EtherBoot)
let flag = 0
let mess = vec 25  //This will contain a message when OutLd returns

// Now set up a way to return
@0 = 3			// jmp @0 to cold start
@1 = MyFrame()		// stack frame for cold starting
@2 = ColdStart		// -> cold start OS initialization
@3 = 030001b		// lda 2 1
@4 = 002002b		// jmp @2

ColdStart:
test flag eq 3
   ifso for p = 0 to 6 by 2 do  //Restore page 1 selectively
      [  //save and 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
      [
      // OutLd must be done with interrupts off.  Otherwise, it might
      //  write out some state (e.g., active) which only pertains inside
      //  an interrupt.
      DisableInterrupts()
      flag = 3  //this is the value saved in the file
      // Now actually save the state of the machine on the bloody boot file.
      flag = OutLd(bootFp, mess)
      ]

// Try to keep user from saving his password on disk in any way
Zero(UserPassword, UserPassword!-1); Resets(keys)

// Install (cont'd)

// Initialize the other memory banks if they are present
if (table [ 61014B; 1401B ])()<<VERS.eng eq 3 then
   [
   @MECR = -1  //correction on, don't report any errors
   for bank = 1 to 3 do
      [
      bankRegs!0 = 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)
      ]
   ]

@MESR = 0
@MECR = sysMECR

// Flush any interrupts that happened during boot
let temp = @activeInterrupts
@activeInterrupts = 0
EnableInterrupts()
@wakeupsWaiting = 0
@activeInterrupts = temp

@diskAddress = -1  //invalidate the disk arm position.

// Install (cont'd)

if flag eq 0 then  //Just installed
   [
   // Move page 1 of the boot file to real disk address 0.
   // In spite of the name, bootFp contains a real DA for page 1.
   let label = vec lDL  //reuse the page1 vector above
   DoDiskCmd(readLD, bootFp>>CFA.fp.leaderVirtualDa, page1, label)
   ReadCalendar(page1+3)  //install creation date in the boot loader
   DoDiskCmd(writeHLD, 0, page1, label)
   DoDiskCmd(writeD, bootFp>>CFA.fp.leaderVirtualDa, page1, label)
   flag = 2  //behave as if we were just booted
   ]

if flag ne 1 then  //booted from the disk or the net (rather than InLded)
   [
   // Create the default boot message.
   let defaultbootmess = vec 25; Zero(defaultbootmess, 25)
   defaultbootmess>>EVM.type = eventBooted
   defaultbootmess>>EVM.length = 1
   MoveBlock(mess, defaultbootmess, 25)

   //if the local time parameters in core look unreasonable then
   //   if the local time parameters in the boot image are ok then
   //      install them otherwise
   //      zero the time to force the Exec to do a SetTime
   let LTPOK(ltp) = ltp>>LTP.beginDST ge 1 & ltp>>LTP.beginDST le 366 &
      ltp>>LTP.endDST ge 1 & ltp>>LTP.endDST le 366 &
      ltp>>LTP.beginDST le ltp>>LTP.endDST & ltp>>LTP.zoneH le 13

   unless LTPOK(timeParams) test LTPOK(1375b)
      ifso MoveBlock(timeParams, 1375b, 2)
      ifnot Zero(timeParams, 10b)
   ]

if flag eq 3 then  //started cold by Jmp @0
   [
   Ws("*n*n*n*n*n   Do you want to install this Operating System? ")
   // If we come here, need to try do read password sector from
   //  disk that is spinning in the machine:
   if YesNo() loop
   let la = vec lDL; DoDiskCmd(readLD, 0, 1000b, la, 2)
   ]

// Install (cont'd)

// Copy events from mess (returned by InLd) into EventVector,
//  where OsMain will process them.  Some are processed here.
OsFinishCode = fcOK
let p = 0
let act = mess
let install = false
for i = 1 to EventVector!-1 do  // loop is guaranteed to terminate
   [
   if @act eq 0 break
   let l = act>>EVM.length
   switchon act>>EVM.type into
      [
      case eventBooted:
         [ TellUser(); endcase ]
      case eventExecuteCode:
         [
         (act+1)()	//call message as a Bcpl procedure
         act = act+l
         loop
         ]
      case eventInstall: 
         [
         install = true
         act = act+l	//Bypass this event
         loop
         ]
      ]
   if p+l+1 gr EventVector!-1 break
   MoveBlock(EventVector+p, act, l)
   p = p+l; act = act+l
   ]
EventVector!p = 0
unless install break	//Go run the OS!
] repeat

//----------------------------------------------------------------------------
and VerifyInstalled() be
//----------------------------------------------------------------------------
// Check to see if system is installed. If not, zero junta label.
[
let p = lv juntaTable>>JT.BootLabel
// If the label is zero, then this OS has not ever been installed
// and there is no point in making needless references to the disk.
if p>>DL.next ne 0 then
   [
   // Read the page that CounterJunta would read first.
   // Manually check that its label is correct for this disk.
   let data, label = vec 256, vec lDL
   DoDiskCmd(readLD, p>>DL.next, data, label)
   let laid = lv label>>DL.fileId
   let jtid = lv p>>DL.fileId
   let match = true
   for i = 0 to lFID-1 if laid!i ne jtid!i then match = false
   if match return
   ]
Zero(p, lDL)
]

//----------------------------------------------------------------------------
and DoDiskCmd(cmd, realDA, data, label, numPages; numargs na) be
//----------------------------------------------------------------------------
// We may not have a DSK object for DP0 yet
[
if na ls 5 then numPages = 1
for page = 1 to numPages do
   [
   for tries = 1 to 10 do
      [
      let kcb = vec lKCB; Zero(kcb, lKCB)
      kcb>>KCB.command = cmd
      kcb>>KCB.headerAddress = lv kcb>>KCB.header
      kcb>>KCB.labelAddress = label
      kcb>>KCB.dataAddress = data
      kcb>>KCB.diskAddress = realDA
      @diskCommand = kcb	//Spin the disk
      while (kcb>>KCB.status & DSTdoneBits) eq 0 loop
      if (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus break
      if tries eq 10 then
         [
         Ws("*N   The disk doesn't work.  ")
         Ws("Type any character and I will try again.")
         Gets(keys)
         tries = 1
         ]
      ]
   realDA = label>>DL.next      //Prepare to go ahead
   ]
]

//----------------------------------------------------------------------------
and AskUser() be
//----------------------------------------------------------------------------
// Ask the user for all his installation options and
//  squirrel them away appropriately.
[
// Be sure to dump the input buffer, in case by mistake the
//  system was installed previously with typeahead pending.
Resets(keys)
Ws("*N*N*N*N*N   Do you want the long installation dialog?")
let longDialogue = YesNo()

if longDialogue then
   [
   if (table [ 61014b; 1401b ])()<<VERS.eng gr 3 then
      [
      // See if he wants to change partitions.
      Ws("   The current disk partition is ")
      Wns(dsp, (table [ 61037b; 1401b ])(0))
      Ws(".*N   Do you want to install onto another partition?")
      unless YesNo() break
      Ws("   Type the new disk partition number: ")
      (table [ 61037b; 1401b ])(ReadNumber())
      ] repeat

   // See if he wants disk wiped first!!!
   Ws("   Do you want to ERASE a disk before installing?")
   test YesNo()
      ifso EraseDisk()
      ifnot
         [
         Ws("   Do you want to extend this file system?")
         if YesNo() then ExtendDisk()
         ]
   ]

// Fiddle with file versions if this OS has the versioned directory module.
// As of OS17, file versions are only supported in a little known version
//  of the OS called 'NewOsV.boot".
CreateSysDisk()
let dvKept = 0
if dirVersions then
   [
   dvKept = sysDisk>>BFSDSK.defaultVersionsKept
   if longDialogue then
      [
      Ws("   The disk is configured ")
      test dvKept eq 0
         ifso Ws("with the multiple-version feature disabled.")
         ifnot [ Ws("to keep "); Wns(dsp, dvKept); Ws(" versions of files.") ]
      Ws("*N   Do you want to change this setting? ")
      if YesNo() then
         [
         Ws("   How many versions of files do you normally wish to keep? ")
         dvKept = (ReadNumber()) & 7b
         if dvKept eq 1 then dvKept = 0	   //User is confused!!
         ]
      ]
   ]
if dvKept ne sysDisk>>BFSDSK.defaultVersionsKept then
   sysDisk>>BFSDSK.defaultVersionsKept = dvKept
CloseDisk(sysDisk)

if longDialogue then
   [
   // See if he wants to change the error reporting address:
   Ws("   Do you want to disable error logging through the net?")
   test YesNo()
      ifnot
         [
         Ws("   Do you want to change the error logging address (currently [")
         Wns(dsp, ErrorLogAddress>>PORT.net, 1, 8); Ws("#")
         Wns(dsp, ErrorLogAddress>>PORT.host, 1, 8); Ws("#")
         Wns(dsp, ErrorLogAddress>>PORT.soc^2, 1, 8); Ws("])?")
         unless YesNo() break
         Ws("      Network number: ")
         ErrorLogAddress>>PORT.net = ReadNumber(8)
         Ws("      Host number: ")
         ErrorLogAddress>>PORT.host = ReadNumber(8)
         Ws("      Socket number: ")
         ErrorLogAddress>>PORT.soc^2 = ReadNumber(8)
         ] repeat
      ifso Zero(ErrorLogAddress, 3)

// AskUser (cont'd)

   // Memory Error parameters
   @lvParityPhantomEnable = true
   @lvParitySweepCount = 176777b
   sysMECR = defaultMECR
   Ws("   Do you want to change memory error parameters? ")
   if YesNo() then
      [
      Ws("   Do you want to disable phantom parity error reporting? ")
      if YesNo() then @lvParityPhantomEnable = false
      Ws("   Do you want to disable error correction? ")
      sysMECR = YesNo()? 177775b, 177777b
      Ws("   Do you want to disable error reporting? ")
      test YesNo()
         ifso @lvParitySweepCount = 0
         ifnot
            [
            Ws("   Do you want to report single-bit errors? ")
            if YesNo() then sysMECR = sysMECR & 177767b
            Ws("   Do you want to report double-bit errors? ")
            if YesNo() then sysMECR = sysMECR & 177773b
            ]
      ]
   ]		

// DiskName string starts in the word after UserName string.
// They are left at advertised places in the Sys.boot file.
let p = userDiskName
let oldVal = vec 60; MoveBlock(oldVal, p, 60)
Ws("   What is your name: ")
let l = GetString(p, oldVal)
if l gr UserName!-1 then  //also kept up in Level 0
   [ l = UserName!-1; p>>STRING.length = l*2-1 ]
MoveBlock(UserName, p, l)
p = p+l
MoveBlock(oldVal, oldVal+oldVal>>STRING.length/2+1, 60)
Ws("   Please give your disk a name: ")
l = GetString(p, oldVal)
p = p+l
@p = 0

// DiskPassword is kept in encryped form at an advertised place
// in Sys.boot, but it is NOT kept in clear text ANYWHERE.
diskPassword!0 = false
Ws("   Do you wish to give the disk a password?")
if YesNo() then
   [
   Ws("   What is the password: ")
   let ps = vec 20; GetString(ps)
   Password(ps, diskPassword, true)
   Zero(ps, 20)	//In case stack stays around and is OutLd'ed intact!
   ]

Resets(dsp)
]

//----------------------------------------------------------------------------
and TellUser() be		// Dialog when booting
//----------------------------------------------------------------------------
// If the disk has a password, identify the disk and check the password.
[
if diskPassword!0 eq 0 return   //no password
@activeInterrupts = @activeInterrupts & not swatInterruptBit  //no aborts
Ws("*N*N*N   User name: "); Ws(userDiskName)
Ws(".  Disk name: "); Ws(userDiskName + (@userDiskName rshift 9) +1)
Ws(".  Password: "); let ps = vec 20
Resets(keys)  //no type-ahead allowed!
   [
   let i = 1
      [
      let c = Gets(keys)
      if c eq $*N % c eq $*S break
      ps>>STRING.char^i = c
      ps>>STRING.length = i
      test c eq 10b % c eq 1  //BS or Ctrl-A
         ifso [ if i ne 1 then i = i-1; Ws("\") ]
         ifnot i = i+1
      ] repeat
   if Password(ps, diskPassword, false) break
   Ws("*N   Incorrect, try again: ")
   ] repeat
let maxLen = (UserPassword!-1) lshift 1 -1
if ps>>STRING.length gr maxLen then ps>>STRING.length = maxLen
MoveBlock(UserPassword, ps, UserPassword!-1)  //so we move a little extra...
@activeInterrupts = @activeInterrupts % swatInterruptBit  //aborts ok again
]