// MainInit.bcpl.  Bulk of the initialization code.
// 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
	InitializeZone; Zero; Usc; Max; Min; CharWidth; SetFilePos
	Allocate; Wss; Endofs; Gets; OpenFile; ShowDisplayStream; PositionPage
	MyFrame; CallSwat; SysErr

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

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

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

		// SUBR base, some init code base
	uCodeCheck; InitFmap

		// initialization only
	GetRamVersion; SetupLispMem; KBDinit; RemoteInitVmem; LocalInitVmem

		// statics exported
	AllocPtr; AllocEnd; AllocInFirstBlock; lastStaticAllocation
	statsFP; sysFontCharWidth
	ScreenWords; callRaid
	RamVersion; MinLispForRam
	HostMagic0; HostMagic1; HostMagic2
	VmemStream; SysinName
	fillMemory; haveUcode; altoUcodeFp; uCodeLoaded
	extraBuffers; extraBufLength
	
		// statics used
	@SubrBase; @lvNIL; @lvKT; @lvVPtr; @VPtr0; SubrArgsVector
	@Bcpl; @ContextQ; LogPagingFlag 
	@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
	sysFontCharWidth		// width of a char, for Raid
	dontGiveUp = false		// if true, call swat instead of
					//  quitting on startup errors
	ScreenWords			// these 3 from InitLispRegs
	RamVersion
	MinLispForRam
	HostMagic0
	HostMagic1
	HostMagic2
	VmemStream = 0		// nonzero while an OS vmem stream is open
	SysinName = 0		// for error msgs
	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
	extraBuffers
	extraBufLength		// for Lisp's use
	ebCreationDate = 0
	]

manifest [
	NILNum = #0			// atom # for NIL
	TNum = #114			// atom # for T
	SubrArgsPtr = #210		// addr where ucode puts args
	MaxSubrArgs = 12		// maximum nargs for any subr
	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 = 10*WordsPerPage  // how much buffer to give to Lisp
	EbCreationDateStart = 4		// i.e. third word of file
	LispVersionStart = #200		// bytepos in eb file of version #s
	]

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 = false
   dsp = 0					// turn off any display
   AllocPtr = StartOfAllocBlock
   AllocEnd = AllocVec
   AllocInFirstBlock = true	// do some initial alloc in fixed
				// block reserved by loader

// Initialize new keyboard driver.  Done quickly so typeahead is not lost
   KBDinit()

// We will need space for the single disk stream that can be open at
// once (either stats or initialization) plus some extra space for other
// diverse allocations. Here we create a SysZone of approx. the right size.

// This could later be merged into the PupZone by InitSystem
   [
   let szl=2*(lKS+WordsPerPage)+WordsPerPage	// stream+buffer*2 plus 1 page
   sysZone = InitializeZone(AllocVec(szl),szl)	// for us
   @lvSysZone = sysZone				// for Os
   ]

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

   let RamV, MinBcplForRam, 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

// Set up ucoce/bcpl communication area in locations #200-#277
   @StatsPtr = 0		// no stats initially
   @#206 = #2000 % lv Bcpl	// = JMP @Bcpl 
   @#207 = #77400		// CallSwat in case #206 gets clobbered

// Subr argument passing structures. SubrArgsPtr = #210
   SubrArgsVector = AllocVec(MaxSubrArgs)	// Bcpl args vector
   for i = 0 to MaxSubrArgs-1 do SubrArgsVector!i=SubrArgsPtr+2*i

// Binding various atom pointers which go back to Lisp.
// The atom numbers of T and NIL used to come from the IPage, now constants
   lvNIL = MakeAtomPtr(NILNum)
   lvKT = MakeAtomPtr(TNum)

// Bind various statics
   lvVPtr = lv VPtr0
   SubrBase = lv uCodeCheck		// First SUBR

// Set up context structures for Pup package
   ContextQ=AllocVec(2);  ContextQ!0=0	// Allocate and empty ContextQ

// Open the sysfont file, get the file length and allocate space for the font
   [ let s = CreateDiskStream(fpSysFont, ksTypeReadOnly, wordItem)
     let sl = (FileLength(s) + 1) rshift 1	// in words
     if Usc(AllocPtr+sl, AllocEnd) gr 0
	then [				// SysFont too big
		Closes(s)		// close it
		let s = OpenFile ("Gacha10.al", ksTypeReadOnly, wordItem)
					// try for a common smaller font
		if s eq 0
		   then GiveUp ("Sorry, your SysFont.al is too big*N// ",
		  "Couldn't find {DSK}Gacha10.al (an acceptable alternative)")
		let sl = (FileLength(s) + 1) rshift 1	// Gacha size
		]
     let fontblk = AllocVec(sl)			// space for sysFont
     Resets(s)
     ReadBlock(s, fontblk, sl)
     Closes(s)
   // The sysFont static is set to the third word of the font, which is
   // what is wanted by the character display routines.
     sysFont=fontblk+2
     sysFontCharWidth = CharWidth (sysFont, $A)	// for Raid
   ]


// Read command line - decides whether sysin or resume

   let foo = vec lFileName
   SysinName = foo
   SysinName!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

 [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 $P: case $p: LogPagingFlag = true; endcase
		   case $F: case $f: fillMemory = true; endcase
		   case $Z: case $z: makeZone = true; endcase
		   case $R: case $r: callRaid = true; 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 RemoteP = false
   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
   if SysinName!0 
      then [ let i = 1
	     [  let ch = nil
		ch = SysinName>>String.char^i
		if ch eq ${ % ch eq $[	// if remote name, don't lookup now]
		   then [ namev!1 = 0; RemoteP = true; break ]
		if ch ne $*S
		   then break
		i = i+1 ] repeatuntil i gr SysinName>>String.length
	   ]
   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
	RamVersion = RamV
	   ]
     ifnot [		// get versions from uCode file before loading
	let s = CreateDiskStream(lispUcodeFp, ksTypeReadOnly, wordItem)
	unless s do GiveUp("Can't open microcode file ", LispUcodeName)
			// see StampVersions.bcpl
	ebCreationDate = AllocVec(2)
	SetFilePos(s, 0, EbCreationDateStart)
	ebCreationDate!0 = Gets(s)
	ebCreationDate!1 = Gets(s)
	SetFilePos(s, 0, LispVersionStart)
	RamVersion = Gets(s)
	MinBcplForRam = Gets(s)
	MinLispForRam = Gets(s)
	Closes(s)
	   ]

   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")

   test RemoteP
      ifso [ RemoteInitVmem (SysinName, VMEMid)
	     SYSINid = -1
	   ]
     ifnot [ if SYSINid
		then [			// SYSIN from disk
			@StackEnd = RemoteInitVmem	// flush useless code
			LocalInitVmem (SYSINid, VMEMid)
		     ]
	   ]
   @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 MinBcplForRam
	   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)		// 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(#10000, length-#10000)
	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 MakeAtomPtr(atomNum) = valof
   [
   let ap = AllocVec(2, 2)		// Dolphin wants these 2-word aligned
   ap!0 = ATOMspace;  ap!1 = atomNum
   resultis ap
   ]

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
  for i = 0 to 15
    do [ oldcursor!i = cursorBitMap!i
	 cursorBitMap!i = newcursor!i
	]

and RestoreCursor (oldcursor) be
		// make cursor be oldcursor
  for i = 0 to 15
    do cursorBitMap!i = oldcursor!i