// LocalVMemInit.bcpl - does VMem setup for MainInit
// Last change January 14, 1985  5:04 PM by Bill van Melle
// Last change May 21, 1984  4:25 PM by Bill van Melle
// Last change October 6, 1982  6:44 PM by Bill van Melle
// Last change July 20, 1982  10:33 PM by Bill van Melle

// everything from here on gets flushed after /I is finished

	get "LispBcpl.decl"
	get "Stats.decl"
	get "VMem.decl"
	get "AltoDefs.d"
	get "AltoFileSys.d"
	get "Streams.d"

external [	// procedures defined here
	LocalInitVmem; CheckIPage; RemoteDskInitVmem; RetrieveVmem
	SysinFailure; ShowSysoutName; AppendString

	GiveUp; ShortStack

		// O.S. procedures
	Closes; Endofs; ReadBlock; OpenFile; PositionPage; SetFilePos
	CallSwat; WriteBlock; BFSInit; InitializeZone; Ws; MoveBlock
	UNPACKDT; WRITEUDT
		// misc
	UCase; Password; ReadStrng; MachineType

		// statics
	VmemStream; MinLispForRam; RamVersion; haveUcode
	SysinName; SysinHostName; dsp; UserName; UserPassword
	]

manifest [	// same as in RemoteVmemInit.bcpl
	firstMouseX = 260
	firstMouseY = 50
	lastMouseY = 800
	spaceForDisk = 2*WordsPerPage
	offsetDiskName = #1000		// byte locations in Sys.boot
	offsetDiskPass = #1400
	nWordsPassword = 9
	]

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

let LocalInitVmem (SysinStream) be
 [
 unless SysinStream do SysinErr(0,0)

 @mouseX, @mouseY = firstMouseX, firstMouseY

//   We can use the rest of the space between the end of the code and the
//   current end of stack for buffers.  This space will eventually go to
//   the assorted allocations, but for now it is empty.

 let buffers = (@StackEnd+WordsPerPage-1) & not (WordsPerPage-1)
					// first buf page, page-aligned
 let LowStackPage = ShortStack(1000)	// allow 1000 words of stack
 let bufferLength = ((LowStackPage - buffers) & not (WordsPerPage-1)) - WordsPerPage
					// size of buffer region
 if bufferLength ls WordsPerPage
    then CallSwat("No buffers for SYSIN")
 let OldLowStack = @StackEnd		// save old low stack
 @StackEnd = LowStackPage		// enforce stack end in read

 PositionPage(SysinStream, 0)
 ReadBlock(SysinStream, buffers, WordsPerPage)	// read leader page
 MoveBlock(SysinName, lv buffers>>LD.name, maxLengthFnInWords)
						// now we know the real name
 ShowSysoutName (lv buffers>>LD.created)
 PositionPage(SysinStream, FirstVmemBlock)	// prepare to read ifpage
 RetrieveVmem (SysinStream, buffers, bufferLength, ReadBlock, Closes) 
 @StackEnd = OldLowStack			// restore previous stack end
 ]

and RetrieveVmem (SysinStream, buffers, bufferLength, ReadFn, FinishFn) be
[
// Main routine that copies a sysout into Lisp.virtualmem.  Assumes that
// VmemStream is already open, and that SysinStream is positioned ready to
// read the InterfacePage.  buffers & bufferLength specify a chunk of buffer
// space that is page-aligned and a multiple of the page size long.
// Supplied procedures: ReadFn copies from SysinStream, FinishFn is called
// after "enough" has been retrieved.
// ReadFn(stream, buffers, nWords) reads nWords from stream into buffers.
// FinishFn(stream, buffers) does whatever is needed to clean up stream after.

 let IFBuf = buffers
 buffers = buffers + WordsPerPage
 bufferLength = bufferLength - WordsPerPage
 PositionPage(VmemStream, FirstVmemBlock)
 ReadFn(SysinStream, IFBuf, WordsPerPage)	// read InterfacePage
 CheckIPage(IFBuf)				// Is it ok?
 @(IFBuf+IFPKey) = not IFPValidKey		// invalidate vmem for now
 WriteBlock(VmemStream, IFBuf, WordsPerPage)

// figure out how big the sysout is so we can move cursor appropriately

 let nPages = @(IFBuf + IFPNActivePages) - FirstVmemBlock
					// number of pages left to go
 let bufSize = bufferLength / WordsPerPage
 let nbufs = nPages / bufSize
		// number of buffers full it will take to retrieve this
 let mouseInc = ((lastMouseY-firstMouseY) lshift 4) / nbufs
 let mouseOff = mouseInc
		// thus the mouse crawls down screen as we read.
		// mouseInc is 2↑4 times amount to move per buffer full
		// mouseOff = mouseInc*pgno


//   now read the pages off the file and into vmem
 [ let wordsRead = ReadFn(SysinStream, buffers, bufferLength)
   WriteBlock(VmemStream, buffers, wordsRead)
   if wordsRead ls bufferLength
     then if wordsRead rshift 8 ls nPages
	     then SysinFailure ("Sysout too short")
   @mouseY = firstMouseY + (mouseOff rshift 4)
   mouseOff = mouseOff + mouseInc
   nPages = nPages - bufSize
   ] repeatuntil nPages le 0
 @(IFBuf+IFPKey) = IFPValidKey		// make valid again
 PositionPage(VmemStream, FirstVmemBlock)
 WriteBlock(VmemStream, IFBuf, WordsPerPage)
 FinishFn(SysinStream, buffers)
 Closes(VmemStream); VmemStream = 0
]

and CheckIPage(buffer) be
[	// checks the critical items in buffer, a copy of the Interface
	// page before it gets written into the vmem
  // Key check - verify file is valid and complete
  if @(buffer+IFPKey) ne IFPValidKey
     then SysinFailure(@(buffer+IFPKey) eq (not IFPValidKey) ?
                      "Can't resume: Inconsistent VMem file " ,
                      "File not in sysout format", SysinName)

  // unless haveUcode do return
  let LispV = @(buffer+IFPLVersion)
  unless LispV ge MinLispForRam
      do SysinFailure("Sysout too old for this microcode")
  unless LispV ge MinLispForBcpl
      do SysinFailure("Sysout too old for this Lisp.Run")
  unless RamVersion ge @(buffer+IFPMinRVersion)
      do SysinFailure("Microcode too old for this sysout")
  unless BcplVersion ge @(buffer+IFPMinBVersion)
      do SysinFailure("Lisp.Run too old for this sysout")
  if (MachineType() eq Dolphin) & (@(buffer+IFPFullSpaceUsed) ne 0)
    then SysinFailure("Sysout has larger virtual address space than this machine can read")
]

and AppendString(str, newstr) = valof
[
let i = str>>String.length
for j = 1 to newstr>>String.length
   do [ i = i+1; str>>String.char↑i = newstr>>String.char↑j ]
str>>String.length = i
resultis str
]

and SysinFailure(reason) be
[	// inline concat here
let errstring = vec 50
test SysinName!0
  ifso	[
	errstring!0 = 0
	AppendString(errstring, "Retrieve of sysout ")
	if SysinHostName
	   then [
		AppendString(errstring, "{")
		AppendString(errstring, SysinHostName)
		AppendString(errstring, "}")
		]
	AppendString(errstring, SysinName)
	AppendString(errstring, " failed*N// ")
	]
 ifnot	errstring = "Could not start Lisp*N// "
GiveUp (errstring, reason)
]

and SysinErr(a, code) be SysinFailure("Can't open file")

and RemoteDskInitVmem() be
[	// do Sysin from another partition
	// need to open a new disk device
  let zone = vec spaceForDisk
  InitializeZone(zone, spaceForDisk)
  let part = SysinHostName>>String.char↑4 - $0
  let otherDisk = 0
  if part le 7 then otherDisk = BFSInit(zone, false, part lshift 1)
  unless otherDisk & CheckPartPassword(otherDisk, zone)
     do SysinFailure("Can't access partition")
  let st = OpenFile(SysinName, ksTypeReadOnly, wordItem, 0, 0, SysinErr, zone, 0, otherDisk)
  unless st do SysinFailure("File not found")
  LocalInitVmem(st)
]

and CheckPartPassword (otherDisk, zone) = valof
[	// if otherDisk is password-protected, check password
 let bootStream = OpenFile("Sys.boot", ksTypeReadOnly, charItem, 0, 0, SysinErr, zone, 0, otherDisk)
 let diskName = vec #200
 let passVector = vec nWordsPassword
 SetFilePos(bootStream, 0, offsetDiskName)
 ReadBlock(bootStream, diskName, #200)
 SetFilePos(bootStream, 0, offsetDiskPass)
 ReadBlock(bootStream, passVector, nWordsPassword)
 Closes(bootStream)
 if passVector!0 eq 0
   then resultis true		// not password-protected
 let nameLength = UserName>>String.length	// name logged in now
 let diskLength = diskName>>String.length	// name on partition
 let trialPass = vec 20		// vector to mimic UserPassword
 let newUserP = false
 test UserPassword!0
  ifnot [ newUserP = true; trialPass = UserPassword ]	// not logged in yet
   ifso [
	if nameLength eq diskLength
	   then [
		for i = 1 to nameLength
		   do if UCase(diskName>>String.char↑i) ne UCase(UserName>>String.char↑i)
			 then goto diskPrompt
					// names match, see if password ok
		if Password(UserPassword, passVector, false)
		   then resultis true
		trialPass = UserPassword	// names match, so smash pass
		]
	]
diskPrompt:
 let nameLengthInWords = (diskLength rshift 1) + 1
 [		// need to get password
 Ws ("*n{"); Ws(SysinHostName); Ws ("} (")
 Ws (diskName + nameLengthInWords)	// disk name after username
 Ws (") Login user: ")
 Ws (diskName)
 Ws (" Password: ")
 if not ReadStrng (trialPass,
	 (trialPass eq UserPassword ? (trialPass!-1 lshift 1) - 1, 39),
	 false, true)
   then resultis false			// declined to state
 if Password(trialPass, passVector, false)
   then [
	if newUserP
	   then		// login succeeded, make this the username too
		 MoveBlock(UserName, diskName, nameLengthInWords)
	resultis true
	]
 ] repeat	// prompt again
]

and ShowSysoutName (crDate) be
[	// print sysout name and its crDate to show what we're reading
Ws ("*n{"); Ws (SysinHostName ? SysinHostName, "DSK"); Ws ("}")
Ws (SysinName)
let utv = vec 7
if crDate
   then	[
	Ws (", ")
	UNPACKDT (crDate, utv)
	WRITEUDT (dsp, utv)
	]
Ws ("...")
]