// MainInit.bcpl.  Bulk of the initialization code.
// Last change September 27, 1981  10:56 PM by Bill van Melle
// Last change September 5, 1981  12:39 PM by Bill van Melle
// Allegro change August 2, 1981  6:01 PM by Beau Sheil
// Last change July 20, 1981  6:59 PM by Beau Sheil
// Last change May 12, 1981  1:34 AM by Beau Sheil
// Last change March 26, 1981  12:20 AM by Beau Sheil
// Tone change March 17, 1981  5:35 PM by Beau Sheil

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

external [	// defined here
	AllocVec; MainInit; ShortStack; SavedUFP; SavedSCP

		// O.S. procedures
	Resets; Closes; MoveBlock; ReadBlock; CreateDiskStream; FileLength
	InitializeZone; MyFrame; CallSwat; SysErr; Zero; Usc; Max

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

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

		// utilities
	MachineType; Version; LispFinish; LispSwatContext

		// SUBR base
	uCodeCheck

		// initialization only
	AllocPtr; AllocEnd; AllocInFirstBlock; StartOfAllocBlock
	GetRamVersion; SetupLispMem; KBDinit; RemoteInitVmem

		// statics used
	@SubrBase; @lvNIL; @lvKT; @lvVPtr; @VPtr0; SubrArgsVector
	@Bcpl; @ContextQ; LogPagingFlag 
	@dspStartAddr; @dspArea; @dlispDsp; @DLispDCB
	EmulatorSpace; @MoveWordsBBT; @MoveWordsBBTAddr
	LispStackLength
	PupZoneLength
	LispStackStart
	PupZoneStart
	]

static [
	AllocPtr			// set in InitLisp
	AllocEnd			// end of fixed alloc region
	AllocInFirstBlock		// true when in fixed block
	SavedUFP; SavedSCP		// used to save OS procs
	]

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 
	]

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
   [
   dsp = 0					// turn off any display
   unless Version()<<Vers.emulType eq 4		// Lisp emul = 4
       do CallSwat("No Lisp microcode!")

   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
   ]

// 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

// Rebind OS procedures for errors, swat and exit. Restored at finish
   SavedUFP = @lvUserFinishProc
   @lvUserFinishProc = LispFinish
   SavedSCP = @lvSwatContextProc
   @lvSwatContextProc = LispSwatContext
   @lvSysErr = SysErr			// Not the OS SysErr

// 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
     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
   ]

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

// Read command line - decides whether sysin or resume
   let SysinName = vec lFileName
   SysinName!0 = 0			// empty until one is specified

   [
   let COMstream = CreateDiskStream(fpComCm, ksTypeReadOnly, charItem)
   let param, SW = vec lFileName, vec 10
   SetupReadParam(param, SW, COMstream)	// get switches
   for i = 1 to @SW do
	switchon SW!i into
	      [ case $I: case $i: SysinName = "LISP.SYSOUT."; endcase
		case $P: case $p: LogPagingFlag = true; endcase
	      ]

// check for parameters in the command line
   [ let P = ReadParam(0,-1)
     if (P eq -1) then break		// No more switches
     switchon (@SW ge 1? SW!1, 0) into
	[ case $I: case $i: case 0: // SYSIN file
		   MoveBlock(SysinName, EvalParam(param,$P), lFileName)
		   endcase
	  case $N: case $n:		// set UserName
		   P = param!0
		   unless P gr (((UserName!-1) lshift 1) - 1) do
			for i = 1 to P do UserName>>String.char^i = param!i
		   UserName>>String.length = P
		   endcase
	  default: break	// unrecognized switch; so exit
	]			// End of switch on switches 
   ] repeat			// Loop back for another switch
   Closes(COMstream)		// close and discard COMstream
   ]

   [					// look up the lisp system files
   let VMEMid, SYSINid = nil, nil
   let RemoteP = false
   let dev = vec 2*lDV			// lDV = len dir entry
   let SysDir = CreateDiskStream(fpSysDir, ksTypeReadWrite, wordItem)
   let namev = vec 2
   namev!0 = "LISP.VIRTUALMEM."
   namev!1 = SysinName!0 ? SysinName, 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, 2, true)
   VMEMid = dev+1			// +1 turns dir entries into fileptrs
   // dont create vmem file - it should exist (contiguously!) already
   unless @dev do CallSwat("Cant find ", namev!0)
   dev = dev+lDV			// move on to sysin file
   SYSINid = @dev ? dev+1,		// ok if found; else better not ask
		namev!1 ? CallSwat("Cant find SYSIN file", namev!1), 0
   Closes(SysDir)

// we now know what kind of sysin, if any, to do
   if RemoteP
      then [ RemoteInitVmem (SysinName, VMEMid)
	     SYSINid = -1
	   ]
   @StackEnd = RemoteInitVmem	// free up some space
   AllocInFirstBlock = false
   AllocPtr=AllocVec		// next alloc will be overlaid on init code
   LispStackStart=AllocVec(DefaultLispStackLength)	// space for lisp stack
   LispStackLength = DefaultLispStackLength
   PupZoneLength=Max(MinPupZoneLength, @StackEnd-AllocPtr)
   PupZoneStart=AllocVec(PupZoneLength)

// 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.


   SetupLispMem(SYSINid, VMEMid)		// Inits VMem
   ]

// MoveWords BBT tables. This code knows way too much about XBBTs
   MoveWordsBBT = AllocVec(20, 2);  Zero(MoveWordsBBT, 20)
   MoveWordsBBT!0 = #100000; MoveWordsBBT!3 = #10000	// fn; width
   MoveWordsBBT!7 = #1; MoveWordsBBT!9 = #10000		// height; width
   MoveWordsBBTAddr = AllocVec(2, 2)
   MoveWordsBBTAddr!0 = EmulatorSpace;  MoveWordsBBTAddr!1 = MoveWordsBBT

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

// 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

 ]
(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