// MainInit.bcpl.  Bulk of the initialization code.
// Last change May 22, 1984  2:52 PM by Bill van Melle
// Last change July 20, 1983  2:23 PM by Bill van Melle
// Last change May 25, 1983  11:22 AM by Bill van Melle
// Last change March 24, 1983  9:06 PM by Bill van Melle
// Last change December 21, 1982  5:18 PM by Bill van Melle
// reorganized dsk init June 8, 1982  9:57 PM by Bill van Melle
// Last change May 24, 1982  12:14 PM by Bill van Melle
// InitLispRegs change May 19, 1982  10:23 PM by Bill van Melle
// command parse change March 19, 1982  1:05 PM by Bill van Melle
// Last change March 18, 1982  1:42 PM by Bill van Melle

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

external [	// defined here
	AllocVec; MainInit; ShortStack; SavedUFP; SavedSCP; GiveUp
	SwapCursors; RestoreCursor

		// O.S. procedures
	Resets; Closes; MoveBlock; ReadBlock; CreateDiskStream; FileLength
	Zero; Usc; Max; Min; CharWidth; SetFilePos
	Allocate; Wss; Endofs; Gets; OpenFile; OpenFileFromFp; PositionPage
	MyFrame; CallSwat; SysErr
	CreateDisplayStream; ShowDisplayStream

		// OS statics 
	dsp; sysZone; fpSysDir; fpComCm; sysDisk; fpRemCm
	UserName; lvSysErr; lvUserFinishProc

		// other library procedures
	LookupEntries; SetupReadParam; ReadParam; EvalParam

		// LIsp procedures
	MachineType; Version; LispFinishProc; InitLispRegs
	Serial; IPutBase; LoadRam; LISPFINISH

		// one init code base
	InitFmap

		// initialization only
	SetupLispMem
	RemoteInitVmem; LocalInitVmem; RemoteDskInitVmem
	ParseHostField; MiscLispInit; ReadUCodeVersions

		// statics exported
	AllocPtr; AllocEnd; AllocInFirstBlock; lastStaticAllocation
	statsFP
	ScreenWords; callRaid
	RamVersion; MinLispForRam; MinBcplForRam
	HostMagic0; HostMagic1; HostMagic2
	VmemStream; SysinName; SysinHostName
	fillMemory; haveUcode; altoUcodeFp; uCodeLoaded; bigMemTable
	extraBuffers; extraBufLength
	
		// statics used
	@dspStartAddr; @dspArea; @dlispDsp; @DLispDCB
	EmulatorSpace
	LispStackLength; StartOfAllocBlock
	PupZoneLength
	LispStackStart
	PupZoneStart
	]

static [
	AllocPtr			// set in InitLisp
	AllocEnd			// end of fixed alloc region
	AllocInFirstBlock		// true when in fixed block
	lastStaticAllocation		// last AllocPtr in fixed region
	SavedUFP = -1
	SavedSCP = -1			// used to save OS procs
	statsFP = 0			// FP for Lisp.stats
	dontGiveUp = false		// if true, call swat instead of
					//  quitting on startup errors
	ScreenWords			// these 3 from InitLispRegs
	RamVersion
	MinLispForRam
	MinBcplForRam
	HostMagic0
	HostMagic1
	HostMagic2
	VmemStream = 0		// nonzero while an OS vmem stream is open
	SysinName = 0		// for error msgs
	SysinHostName = 0
	fillMemory = false		// T -> fill up memory completely
	haveUcode = false	// true if started with Lisp microcode
	uCodeLoaded = false	// true after ucode loaded
	altoUcodeFp = 0		// maybe the Fp for AltoD0Mc.eb
	callRaid = false	// if true, call Raid on startup
	bigMemTable = false	// if true, stick Bpt in high memory
	extraBuffers
	extraBufLength		// for Lisp's use
	fakeCoreSize		// for /c switch
	]

manifest [
	lEDCB = 6			// extended DCB length
	lFileName = 80			// file name length in words
	MinPupZoneLength = 8000		// space for pup zone
	DefaultLispStackLength = 2400	// ~10 pages for bcpl/lisp stack 
	extraBufWanted = 16*WordsPerPage  // how much buffer to give to Lisp
	ExtraZoneSize = 2*WordsPerPage	// how much to allocate on /Z
	lenDSPBlock = lDCB*2 + (380*3)/2	// for temp dsp
	]

structure Vers:
        [					// Microcode Version word
	machType bit 4				// machine type
	emulType bit 4				// emulators supported
	blank byte
	]

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

// The address of AllocVec is used as the base of the initialization code in
// InitLisp (which allocates run time storage starting here). Do not move
// within the file or change order of file load without being careful.

let AllocVec(n, align; numargs nargs) = valof

// AllocPtr is initialized to the first address that can be used to allocate
// permanent data structures (AllocVec). The first two allocations (the
// Pup zone and the Bcpl/Lisp run time stack) are made over the top of the
// initialization code and are not written into until the initialization is
// complete.

   [
// If align is specified, the allocation is align word aligned, for align a power of 2.
   if nargs eq 2 then [ let mask=align-1
                        AllocPtr=(AllocPtr+mask) & (not mask)
                      ]
   let addr=AllocPtr		// Save existing pointer for result
   AllocPtr=AllocPtr+n		// Move to after this allocation
   test AllocInFirstBlock
	ifso if Usc(AllocPtr, AllocEnd) gr 0
		then CallSwat ("Not enough initial allocation space")
	ifnot if Usc (AllocPtr, @StackEnd) gr 0
		then @StackEnd=AllocPtr	// Reset end of stack to after allocation
   resultis addr
   ]

and MainInit(EventualEndOfStack) be
   [
   let makeZone = MachineType() eq Dolphin
   dsp = 0					// turn off any display
   AllocPtr = StartOfAllocBlock
   AllocEnd = AllocVec
   AllocInFirstBlock = true	// do some initial alloc in fixed
				// block reserved by loader

   let RamV, MBFR, MLFR, sw, pnum, ppm, host0, host1, host2
       = 0, nil, nil, nil, nil, nil, 0, 0, 0	// adjacent for InitLispRegs

   let origCursor = vec 16
   SwapCursors (origCursor, table[
				#177777; #100001; #40002; #25544;
				 #17770;   #7760;  #3740;  #1700;
				  #1100;   #2440;  #4220; #10610;
				 #21704; #47742; #177777; #177777 ])
			// set hour-glass cursor
   MiscLispInit()

// don't do this until sysZone exists
   if Version()<<Vers.emulType eq 4		// Lisp emul = 4
     then haveUcode = true	// usually only true when ucode debugging


// Read command line - decides whether sysin or resume

   let foo = vec lFileName
   SysinName = foo
   SysinName!0 = 0			// empty until one is specified
   let hostName = vec lFileName
   hostName!0, hostName!1 = 0, 0	// empty until one is specified
   let statsName = vec lFileName
   statsName!0 = 0			// empty until one is specified
   let LispUcodeName = vec lFileName
   test haveUcode
      ifso LispUcodeName!0 = 0		// don't need to load microcode
     ifnot test MachineType() eq Dolphin
	     ifso MoveBlock(LispUcodeName, "DolphinLispMc.eb", 9)
	    ifnot MoveBlock(LispUcodeName, "DoradoLispMc.eb", 8)
   let lispUcodeFp = 0
   let AltoUcodeName = vec lFileName
   MoveBlock(AltoUcodeName, (MachineType() eq Dolphin? "AltoD0Mc.eb", "AltoD1Mc.eb"), 6)
   let askedForAlto = false
   let quitEarly = false

 [ComParse
   let body = vec lFileName
   let COMstream = CreateDiskStream(fpComCm, ksTypeReadOnly, charItem)
   let switch, bodylen, bodywords = 0, 0, 0
   let firstNameFound = 0
 	[				// begin loop
	let ch = Endofs(COMstream)? $*N, Gets(COMstream)
	switchon ch into
	   [
	   case $*S: case $*N:			// end of token
		if firstNameFound eq 0
		   then endcase
		if bodylen
		   then [
			body>>String.length = bodylen
			bodywords = (bodylen rshift 1) + 1
			]
		switchon switch into
		   [
		   case 0: case -1:		// no switch
			if bodylen eq 0
			   then endcase	// else fall thru for default /I
		   case $I: case $i:		// sysin name
			test bodylen
			   ifso MoveBlock(SysinName, body, bodywords)
			  ifnot MoveBlock(SysinName, "Lisp.sysout", 6)
			endcase
		   case $N: case $n:		// set UserName
			unless bodywords gr UserName!-1
			   do MoveBlock(UserName, body, bodywords)
			endcase
		   case $S: case $s:		// open stats file
			test bodylen
			   ifso MoveBlock(statsName, body, bodywords)
			  ifnot MoveBlock(statsName, "Lisp.stats", 6)
			endcase
		   case $M: case $m:		// load microcode file
			test bodylen
			   ifso MoveBlock(LispUcodeName, body, bodywords)
			  ifnot test MachineType() eq Dolphin
				  ifso MoveBlock(LispUcodeName, "DolphinLispMc.eb", 9)
				 ifnot MoveBlock(LispUcodeName, "DoradoLispMc.eb", 8)
			haveUcode = false	// ignore loaded ucode
			endcase
		   case $A: case $a:		// specify alto ucode file
			test (bodylen ne 0) &
				 ((bodylen gr 1) % body>>String.char^1 ne $-)
			   ifso [		// -/A means none
				MoveBlock(AltoUcodeName, body, bodywords)
			  	askedForAlto = true
				]
			  ifnot AltoUcodeName!0 = 0
			endcase
		   case $F: case $f: fillMemory = true; endcase
		   case $Z: case $z: makeZone = true; endcase
		   case $R: case $r: callRaid = true; endcase
		   case $Q: case $q: quitEarly = true; endcase
		   case $B: case $b: bigMemTable = true; endcase
		   case $C: case $c:		// specify core size
			let num=0
			for i=1 to body>>String.length do
			    num=num*8+(body>>String.char^i)-$0
			fakeCoreSize = num
			endcase
		   ]
		if Endofs(COMstream) then break
		bodylen = 0
		switch = 0
		firstNameFound = -1
		endcase
	   case $/:			// maybe a switch
		if switch eq 0
		   then [ switch = -1	// signal a switch start
			  endcase ]
					// else fall thru
	   default:			// part of a body or switch
		test switch eq -1
		   ifso switch = ch	// set one-char switch
		  ifnot	[		// fill in body
			if firstNameFound ge 0
			   then [ firstNameFound = 1
				  endcase  // ignore lisp.run
				]
			if switch
			   then [	// multi-char switch parsed as body
				bodylen = bodylen+2
				body>>String.char^(bodylen-1) = $/
				body>>String.char^bodylen = switch
				switch = 0
				]
			bodylen = bodylen+1
			body>>String.char^bodylen = ch
			]
	   ]
	] repeat		// end until


   Closes(COMstream)		// close and discard COMstream
 ]ComParse

   [					// look up the lisp system files
   let VMEMid, SYSINid = 0, 0
   let dev = vec 5*lDV			// lDV = len dir entry
   let SysDir = CreateDiskStream(fpSysDir, ksTypeReadWrite, wordItem)
   let namev = vec 5
   namev!0 = "LISP.VIRTUALMEM."
   namev!1 = SysinName!0 ? SysinName, 0
   namev!2 = statsName!0 ? statsName, 0
   namev!3 = LispUcodeName!0 ? LispUcodeName, 0
   namev!4 = AltoUcodeName!0 ? AltoUcodeName, 0
   
   let RemoteP = ParseHostField(namev, hostName)

   LookupEntries(SysDir, namev, dev, 5, true)
   			// +1 turns dir entries into fileptrs
   // dont create vmem file - it should exist (contiguously!) already
   for i = 0 to 4
     do [
   	test @dev
	   ifso [ switchon i into
		   [
		   case 0: VMEMid = dev+1; endcase
		   case 1: SYSINid = dev+1; endcase
		   case 2: statsFP = Allocate(sysZone, lFP)
			   MoveBlock (statsFP, dev+1, lFP)
			   endcase
		   case 3: lispUcodeFp = dev+1; endcase
		   case 4: altoUcodeFp = Allocate(sysZone, lFP)
			   MoveBlock (altoUcodeFp, dev+1, lFP)
			   endcase
		   ]
		]
	  ifnot if (namev!i ne 0) & ((i ne 4) % askedForAlto)
		   then GiveUp ("Cant find ", namev!i)
	dev = dev+lDV			// move on to next file
	]
   Closes(SysDir)

// we now know what kind of sysin, if any, to do
   test haveUcode		// get versions for Ipage checking if possible
      ifso [
	InitLispRegs(lv RamV)		// fills in 9 words
	MinLispForRam = MLFR
	MinBcplForRam = MBFR
	RamVersion = RamV
	   ]
     ifnot [		// get versions from uCode file before loading
	unless ReadUCodeVersions(lispUcodeFp)
	   do GiveUp("Can't open microcode file ", LispUcodeName)
	   ]

   unless RamVersion ge MinRamForBcpl
	do GiveUp("Microcode too old for this lisp.run")
   unless BcplVersion ge MinBcplForRam
	do GiveUp("Lisp.run too old for this microcode")

   if SysinName!0
    then [		// there is a sysin to do
			// create a temporary dsp to communicate
	let temp = vec lenDSPBlock
	dsp = CreateDisplayStream (2, temp, lenDSPBlock)
	ShowDisplayStream (dsp, DSalone)
	if SysinHostName
	   then SYSINid = -1	// to flag that /I was done
	VmemStream = OpenFileFromFp(VMEMid)
	unless VmemStream do GiveUp("Can't open Lisp.virtualmem")
	test RemoteP
	   ifso [				// SYSIN from net
		@StackEnd = MiscLispInit	// flush useless code
		RemoteInitVmem ()
		]
	  ifnot	[				// SYSIN from disk
		@StackEnd = RemoteInitVmem	// flush useless code
		test SysinHostName
		   ifso RemoteDskInitVmem()
		  ifnot LocalInitVmem (OpenFile(0, ksTypeReadOnly, 0, 0, SYSINid))
		]
	ShowDisplayStream (dsp, DSdelete)	// flush dsp
	dsp = 0
	]
   if quitEarly then finish
   @StackEnd = LocalInitVmem	// free up some space
   AllocInFirstBlock = false
   lastStaticAllocation = AllocPtr
   AllocPtr = AllocVec		// next alloc will be overlaid on init code

// We allocate at least MinPupZoneLength words for the Pup zone, but we
// make sure that it extends at least to the end of the initialization code.
// This is because the pup zone is not touched during main initialization,
// whereas subsequent allocations are.  The Pup initialization code hides
// under the LispStack allocation (after Maininit) so it doesn't zorch itself.
// Hence, LispStack must be long enough to cover the Pup init code.

   LispStackLength = Max(DefaultLispStackLength, InitFmap-AllocPtr)
   LispStackStart=AllocVec(LispStackLength)	// space for lisp stack
   PupZoneLength=Max(MinPupZoneLength, @StackEnd-AllocPtr)
   PupZoneStart=AllocVec(PupZoneLength)

   if lispUcodeFp
      then [
	let s = CreateDiskStream(lispUcodeFp, ksTypeReadOnly, wordItem)
	unless s do GiveUp("Can't open microcode file ", LispUcodeName)
	let sl = (FileLength(s) + 1) rshift 1 - WordsPerPage
					// length of LoadRam buffer we need
	let buffer = (@StackEnd + WordsPerPage-1) & not (WordsPerPage-1)
	let newend = ShortStack(1000)
	if newend - buffer ls sl
	   then CallSwat("Microcode file too large")
	let oldend = @StackEnd
	@StackEnd = newend		// get lots of space for buffer
	PositionPage(s, 2)
	ReadBlock(s, buffer, sl)
	Closes(s)
	LoadRam((MachineType() eq Dolphin? buffer-1, buffer), 1)
	@StackEnd = oldend
	haveUcode = true
	InitLispRegs(lv RamV)		// fills in 9 words
	unless RamV ge MinRamForBcpl	// Check BEFORE using other ILR values
	   do GiveUp("Microcode too old for this lisp.run")
	unless BcplVersion ge MBFR
	   do GiveUp("Lisp.run too old for this microcode")
	MinLispForRam = MLFR
	RamVersion = RamV
	   ]
   uCodeLoaded = true

// Rebind OS procedures for errors, swat and exit. Restored at finish
   SavedUFP = @lvUserFinishProc
   @lvUserFinishProc = LispFinishProc
//   SavedSCP = @lvSwatContextProc
//   @lvSwatContextProc = LispSwatContext

   ScreenWords = sw	// copy InitLispRegs values into statics for others
   HostMagic0 = host0
   HostMagic1 = host1
   HostMagic2 = host2

   extraBufLength = ((AllocPtr+WordsPerPage) & (not (WordsPerPage-1))) -
			AllocPtr + extraBufWanted
   extraBuffers = AllocVec(extraBufLength)

   SetupLispMem(SYSINid, VMEMid, pnum, ppm, fakeCoreSize)	// Inits VMem
   ]

// Allocate the display, but do not open the TTY stream yet
   dlispDsp = AllocVec(2)			// lisp display

// dlispDsp is a fake. All it has are pointers to a single display block
// which is manipulated from Lisp. We allocate that now.
   DLispDCB =  AllocVec(lEDCB, 2)		// single dcb; 2word aligned
   Zero(DLispDCB, lEDCB)			// must be empty
   dlispDsp>>DS.fdcb = DLispDCB
   dlispDsp>>DS.ldcb = DLispDCB

   test makeZone & (Serial() ls #377)
      ifso [		// allocate an mds zone even so
	let length = EventualEndOfStack-AllocPtr	// what's left
	length = (length ls #10000) ? 0, Min(ExtraZoneSize, length-ExtraZoneSize)
	IPutBase(IFPMDSZone, length? AllocVec(length), 0)
	IPutBase(IFPMDSZoneLength, length)
	   ]
     ifnot [
	IPutBase(IFPMDSZone, 0)
	IPutBase(IFPMDSZoneLength, 0)
	   ]

// Now set the display start address. We will eventually give all of
// memory from this point on to the display bitmap.
   dspStartAddr = AllocVec(0, WordsPerPage)	// page align display
   dspArea = EventualEndOfStack - dspStartAddr
   unless dspArea ge WordsPerPage then CallSwat("No space for dsp")

   @lvSysErr = SysErr			// Not the OS SysErr

   RestoreCursor (origCursor)

// The display will be given whatever space remains between the end of the
// last AllocVec (rounded up to a page boundary) and the bottom of the stack
// frame for InitSystem (plus a small amount needed for it to start the rest
// of the system). The latter quantity is EventualEndOfStack. We do this so
// the (substantial) stack frame for MainInit can be reclaimed.
// Display is actually turned on in InitLisp after we exit

   SysinName = 0			// dynamic var will disappear
   ]
(1792)
and ShortStack(n) = (MyFrame()-n) & not (WordsPerPage-1)

// Figures out where to end the stack a specified distance from here. Allows
// at least n words and rounds down (i.e. more stack) to the nearest page

and GiveUp(str1, str2; numargs na) be
   [
   if VmemStream
      then Closes(VmemStream)		// regain some zone space
   let st = dontGiveUp? 0, CreateDiskStream(fpRemCm, ksTypeWriteOnly, charItem)
   test st
      ifso [ Resets(st)
	     Wss(st, "// ")	// write str on rem.cm for cleaner crash
	     Wss(st, str1)
	     if (na gr 1) & str2 & (str2!0)
		then Wss(st, str2)
	     Wss(st, "*N")
	     Closes(st)
	     @displayListHead = 0		// turn off any display
	     LISPFINISH()
	   ]
     ifnot CallSwat (str1, str2)
   ]

and SwapCursors (oldcursor, newcursor) be
[		// save cursor in oldcursor, set newcursor
  MoveBlock(oldcursor, cursorBitMap, 16)
  MoveBlock(cursorBitMap, newcursor, 16)
]

and RestoreCursor (oldcursor) be
		// make cursor be oldcursor
  MoveBlock(cursorBitMap, oldcursor, 16)