// VMemInit.bcpl - does VMem setup for MainInit
// Last change March 30, 1985  3:34 PM by Bill van Melle
// Bpt in high vmem March 17, 1985  2:13 PM by Bill van Melle
// Major rewrite November 20, 1984  6:34 PM by Bill van Melle
// Last change May 24, 1984  10:28 AM by Bill van Melle
// Last change May 25, 1983  11:19 AM by Bill van Melle
// Last change February 4, 1983  10:29 PM by Bill van Melle
// Revised real page setup July 13, 1982  10:40 AM by Bill van Melle
// Last change June 17, 1982  5:01 PM by Bill van Melle
// Last change May 19, 1982  10:23 PM by Bill van Melle
// Last change September 5, 1981  12:38 PM by Bill van Melle

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

external [	// procedures defined here
	SetupLispMem

		// O.S. procedures
	Zero; SetBlock
	CallSwat; Serial; Timer; Min

		// procedures used
	@BSetWriteBR; @RWrite; IGetBase; IPutBase; @BPutBase; @BGetBase
	ReadRP; SetFlags; ReadFlags; MachineType
	BP; VP2; IndexedPageIO; InitFmap; @BPutBase32
        AllocVec; ShortStack
	RestoreCursor; GiveUp

		// statics defined and/or used
	@MiscSTATSbase; NPages; ScreenWidth
	LispFmap; EmulatorSpace; LastRealPageNo
	UserName; UserPassword; AllocPtr
	HostMagic0; HostMagic1; HostMagic2
	sysDisk; extraBuffers; extraBufLength
	fillMemory; realPageTableSetup; bigMemTable
	SwapBuf; SwapBufVp; SwapBufFileP; SwapBufDirty
	FirstRealPageNo; memAvailTable
	
	ScreenWords; MinLispForRam; RamVersion
	]

static	[	// statics defined
	EmulatorSpace; LastRealPageNo; NPages
	lispBufVp
	nextRP
	nextRPT
	initBufVPs
	initBufRPs
	initBufVP
	initBufRP
	initBuffers
	lastMapIndex = -1
	maxMapIndex
	lastMappedFP = -2
	firstMappedFP
	]

manifest [
	PTBLsize = 100
	IsfChunkSize = 50
	fpEMPTY = #177777
	minSwapPages = 8
	unfilledSlop = 300	// guess as to how many pages in FPTOVP are marked empty
	BptThreshold = #10000	// NPages gr than this implies use highBptSegment
	highBptSegment = SMALLNEGspace
	]

let SetupLispMem(SYSINid, VMEMid, pnum, ppm, fakeCoreSize) be
   [
// SYSINid is currently only used to decide whether a /I was done, and
// hence whether we should initialize some stats.

   ScreenWidth = ScreenWords lshift 4	// Save width in bits
   if fakeCoreSize
      then [	// have to unmap the other pages
	   let nextvp = VP2((EmulatorSpace eq 0? 1, 0), 0)-PagesPerSegment
					// first page after emulator
	   for vp = nextvp+fakeCoreSize to nextvp+pnum-1
	     do SetFlags(vp, 0, VACANT)	 
	   pnum = fakeCoreSize
	   ]

   NPages = pnum
   unless NPages gr PagesPerSegment
       do CallSwat("Not enough real memory")
   EmulatorSpace = selecton MachineType() into
	[ case Dolphin: D0BCPLspace
	  case Dorado: D1BCPLspace
	  default: CallSwat("Invalid machine type")
	]

// Initialize ISF routines for access to Lisp.virtualmem

   LispFmap = AllocVec(PTBLsize + IsfChunkSize*2 + 6)
			// PTBLsize for isf map, rest for Lisp's use
   unless InitFmap(LispFmap, PTBLsize, VMEMid, true, IsfChunkSize)
       do CallSwat("Fragmented VMem")

// TransferPage needs one page aligned paging buffer for reading in a page

   SwapBuf = AllocVec(WordsPerPage, WordsPerPage)
   BufVp = VP2(EmulatorSpace, SwapBuf)
   BufRP = ReadRP(BufVp)

   lispBufVp = VP2(EmulatorSpace, AllocVec(WordsPerPage, WordsPerPage))

   SetupRealPageTable(ppm)

   RestoreCursor ( table [ #177777; #100001;  #40002;  #20004;
			    #14010;   #6160;   #3740;   #1700;
			     #1100;   #2440;   #4220;  #11710;
			    #27764;  #77776; #177777; #177777
			 ] )		// new cursor

   LoadMemory()			// swap in the necessary pages

   if SYSINid then
     [ BSetWriteBR(STATSspace, MISCSTATSbase)		// zero Stats counters
       for i = 0 to lenMiscStats-1 do RWrite(i, 0) ]
   let tmr = vec 1					// set StartTime
   Timer(tmr)
   BPutBase32(STATSspace, MISCSTATSbase+MSstrtTime, tmr)
   MiscSTATSbase = MISCSTATSbase	// enable miscstats
   ]

and SetupRealPageTable(ppm) be
  [				// ppm ignored nowadays

// Emulator pages are not represented in Bpt, since they are always
// resident and Lisp doesn't manage them (though it may temporarily map
// emulator buffers elsewhere).  RPoffset is computed so that Bpt[i]
// corresponds to real page i+RPoffset.  There is a dummy header entry 0,
// which corresponds to no page.  We assume Initial has mapped virtual
// pages 0 thru NPages-1 into each good page of memory.  Bpt spans that
// set of real pages, with bad or missing pages marked UNAVAIL.

// first find the smallest and largest real pages outside of the emulator,
// so we know how big to make Bpt.

  let maxRealPageNo = MachineType() eq Dorado? NPages,
			Min((NPages*4)/3, #10000)
  maxRealPageNo = (maxRealPageNo+255) & (not 255)	// round up to next segment
  let tableSize = maxRealPageNo rshift 4
  let masks = table [ 1; 2; 4; #10; #20; #40; #100; #200; #400;
			#1000; #2000; #4000; #10000; #20000; #40000; #100000 ]
  memAvailTable = AllocVec(tableSize)
  Zero(memAvailTable, tableSize)
  let maxp = NPages-1		// must be at least this big
  let minp = #10000
  let nextvp = VP2((EmulatorSpace eq 0? 1, 0), 0)
				// first page after emulator
  let lastvp = nextvp+NPages-PagesPerSegment-1
  for vp = nextvp to lastvp
    do	[
	if (ReadFlags(vp) & VACANT) eq VACANT
	   then MapConfused(vp, 0)
	let p = ReadRP(vp)
	test p gr maxp
	   then [
		if p ge maxRealPageNo
		   then MemInitFailed("Too many bad pages", p, vp, maxRealPageNo)
		maxp = p
		]
	 or if p ls minp
	  then minp = p
	let base = memAvailTable + (p rshift 4)
	@base = @base % @(masks + (p&#17))	// set bit for this page
	SetFlags(vp, 0, VACANT)		// unmap page
	]
  FirstRealPageNo = minp	// should be #400

// to simplify what follows, insist that minp correspond to start of table

  let slop = minp & #17
  if slop ne 0
     then [	// waste some space
	NPages = NPages - (#20-slop)
	minp = minp + (#20-slop)
	]
  let bitBase = memAvailTable + (minp rshift 4)

  LastRealPageNo = maxp+1	// actually, exclusive upper bound...
  RPoffset = minp - 1		// Bpt's first real entry is minp
  BptSize = LastRealPageNo-RPoffset
  let BptLength = lBPT*BptSize
  let nBptPages = nil

// decide what kind of table to build, in this segment or elsewhere

  test (NPages gr BptThreshold) % bigMemTable
   ifnot [	// allocate it in this segment
	 Bpt = AllocVec(BptLength)
	 SetBlock(Bpt, EMPTY, BptLength)	// assume all good
	 BptSegment = EmulatorSpace
	 ]
   ifso [	// allocate it in higher virtual space
	BptSegment = highBptSegment
	Bpt = 0
	nBptPages = (BptLength-1) rshift 8 + 1
	let BptVp = VP2(BptSegment, 0)
	let lastBitBase = memAvailTable + (nBptPages-1) rshift 4
	for base = bitBase to lastBitBase
	   do if @base + 1 ne 0
		then MemInitFailed ("Early bad pages")
	for i = 0 to nBptPages-1
	   do	[	// allocate Bpt.  Initialize pages to EMPTY
			// do this by swap buf into desired real page
			// setting SwapBuf appropriately, then
			// swinging map back
		SetFlags(BufVp, minp+i, OCCUPIED)
		SetBlock(SwapBuf, EMPTY, WordsPerPage)
		SetFlags(BufVp, BufRP, OCCUPIED)
		SetFlags(BptVp+i, minp+i, OCCUPIED)
		]
	]


// now march through bit table, marking bad pages UNAVAIL

  let lastBitBase = memAvailTable + (maxp rshift 4) + 1
  let base = Bpt+1	// offset to flag word
  BPutBase(BptSegment, base, UNAVAIL)	// dummy first entry

    [	let info = @bitBase
	test info eq 0
	  ifso	// 16 unavailable pages
		for i = 0 to 15
		   do 	[
			base = base+3
			BPutBase(BptSegment, base, UNAVAIL)
			]
	 ifnot test info eq -1
		 ifso	// all available, do nothing
			base = base + (16*3)
		 ifnot	// mix of available and unavailable
			for i = 0 to 15
			  do	[
				base = base+3
				if (info&1) eq 0
				   then BPutBase(BptSegment, base, UNAVAIL)
				info = info rshift 1
				]
	bitBase = bitBase + 1
    ] repeatuntil bitBase eq lastBitBase

  if BptSegment ne EmulatorSpace
    then [	// mark Bpt pages unavailable
	base = 1
	for i = 1 to nBptPages
	   do [ base = base+3; BPutBase(BptSegment, base, UNAVAIL) ]
	]

// Finally, a consistency check: make sure each emulator page is resident,
// and that none are mapped into pages that Lisp thinks it owns.

  let emvp = VP2(EmulatorSpace, 0)
  for vp = emvp to emvp+PagesPerSegment-1
    do	[
	let rp = ReadRP(vp)
	if ((ReadFlags(vp) & VACANT) eq VACANT) %
	  (rp ge minp & rp le maxp
		 & BGetBase(BptSegment, BP(rp-RPoffset)+1) ne UNAVAIL)
	   then MapConfused(vp, rp)
	]

// table is setup now, so finish proc can be happy anytime...
  realPageTableSetup = true

  ]

and MapConfused(badvp, badrp) be
  [ 
  CallSwat("Memory map confused",
		 MachineType() eq Dolphin? 
			"Try booting to reinitialize map",
			"Try triple booting to reinitialize map")
  ]

and LoadMemory() be
[
  nextRP = 0
  nextRPT = Bpt+1		// Initialize GetNextRP

// load InterfacePage first to get vital info

  let vp = VP2(INTERFACEspace, INTERFACEbase)
  GetNextRP()
  SetFlags(BufVp, nextRP+RPoffset, OCCUPIED)	// map real page onto buff
  IndexedPageIO(LispFmap, FirstVmemBlock, BufVp lshift 8, 1, false)
  SetFlags(BufVp, BufRP, OCCUPIED)		// map buf back
  SetFlags(vp, nextRP+RPoffset, 0)		// reset flags
  BPutBase(BptSegment, nextRPT, vp)
  BPutBase(BptSegment, nextRPT+1, FirstVmemBlock)	//  nextRPT>>BPT.FILEP 
  LoadIPage()

// InterfacePage is in and ok.  Map in more stuff now.
// First get lots of space for buffers
// Want space for FPTOVP, as well as a bunch of buffers to read vps

  let FPTOVP = (@StackEnd + WordsPerPage-1) & not (WordsPerPage-1)
  let newend = ShortStack(1000)
  let oldend = @StackEnd
  @StackEnd = newend
  initBuffers = (memAvailTable + WordsPerPage-1) & not (WordsPerPage-1)

// craftiness: initBuffers is the start of a buffer space used solely for
// its virtual pages, not its contents.  So it can overlap anything that
// Bcpl does not need to touch during the function DoMapInBatch.
// In particular, it can overlap FPTOVP, and also Bpt, which was the last
// allocation before this.

  let nInitBufs = (newend - initBuffers) rshift 8
		// number of pages of buffer space available
  initBufVPs = newend - (nInitBufs lshift 1)
		// allocate initBufxx vectors at end of buf space
		// decrease number of buffers if necessary
  nInitBufs = (initBufVPs - initBuffers) rshift 8
  initBufRPs = initBufVPs + nInitBufs
  initBufVP = VP2(EmulatorSpace, initBuffers)
  initBufRP = ReadRP(initBufVP)		// VP and RP of first of the buffers
  maxMapIndex = nInitBufs-1

// now carve out space for FPTOVP somewhere between newend and initBufVPs

  let bufAvail = (initBufVPs & not (WordsPerPage-1)) - FPTOVP
					// space available for reading FPTOVP
  let lastFP = IGetBase(IFPLastLockedFilePage)
  if lastFP ge bufAvail
     then CallSwat("No space for FPTOVP")
  lastFP = Min(bufAvail-1,
	(fillMemory? NPages, NPages - (NPages rshift 2)) + unfilledSlop)
					// try to fill 3/4 of memory
  let maxFP = (lastFP + WordsPerPage-1) & not (WordsPerPage-1)
		// will read an integral number of pages of FPTOVP
  lastFP = Min (maxFP-1, IGetBase(IFPNActivePages))

// load enough pages of FPTOVP to get to lastFP

  IndexedPageIO(LispFmap, IGetBase(IFPFPTOVPStart), FPTOVP, maxFP rshift 8, false)

// now process FPTOVP until done

  for nextFP = FirstVmemBlock + 1 to lastFP
    do [
	vp = @(FPTOVP + nextFP)
	if vp ne fpEMPTY
	   then [
		unless GetNextRP() do break
		BPutBase(BptSegment, nextRPT, vp)
		BPutBase(BptSegment, nextRPT+1, nextFP)	// nextRPT>>BPT.FILEP

// map virtual page vp living on file page nextFP into real page nextRP.
// to take best advantage of disk, we do chunks of consecutive file
// pages at once.  Thus, buffer up a few pages at a time.

		if (nextFP ne lastMappedFP+1) % (lastMapIndex eq maxMapIndex)
		   then DoMapInBatch()	// not consecutive, dump what we have
		lastMapIndex = lastMapIndex+1
		@(initBufRPs + lastMapIndex) = nextRP+RPoffset
		@(initBufVPs + lastMapIndex) = vp
		if lastMappedFP le 0
		   then firstMappedFP = nextFP
		lastMappedFP = nextFP
		]
	]

  if lastMapIndex ge 0
     then DoMapInBatch()	// finish up stragglers

  @StackEnd = oldend  		// restore stack

  ]

and GetNextRP() = valof
[
// sets nextRP and nextRPT to point to next real pages, or returns false

 [ nextRP = nextRP + 1
   if nextRP ge BptSize
      then resultis false
   nextRPT = nextRPT + 3
 ] repeatwhile BGetBase(BptSegment, nextRPT) eq UNAVAIL

   resultis true
]

and DoMapInBatch() be
[
// actually do the file transfers: read file pages firstMappedFP thru
// lastMappedFP into the virtual/real pages indicated by the vectors
// initBufVPs and initBufRPs.  This is actually accomplished by mapping the
// appropriate real pages into the buffer pages, then reading the pages off
// the file (since alto disk can only read into alto pages), then swinging
// the map so that those real pages are now mapped to the appropriate
// virtual pages.

  if lastMapIndex ls 0 then return
  for i = 0 to lastMapIndex
    do  	// map alto buffers into desired real pages
		// note that nobody is mapped to those pages now
	SetFlags (initBufVP+i, @(initBufRPs+i), OCCUPIED)

  IndexedPageIO(LispFmap, firstMappedFP, initBuffers, lastMapIndex+1, false)

  for i = 0 to lastMapIndex
    do  [	// map alto buffers back where they started, then map
		// the desired virtual pages into the real pages just filled
	SetFlags (initBufVP+i, initBufRP+i, OCCUPIED)
	SetFlags (@(initBufVPs+i), @(initBufRPs+i), OCCUPIED)
	]
  lastMapIndex = -1
  lastMappedFP = -2
]

and MemInitFailed (reason, a, b, c) be
   CallSwat ("Memory Initialization failed", reason)
 
and LoadIPage() be
  [ 
  // LoadIPage checks keys and versions

  // Key check - verify file is valid and complete
  if IGetBase(IFPKey) ne IFPValidKey
     then GiveUp(IGetBase(IFPKey) eq (not IFPValidKey) ?
                      "Can't resume: Inconsistent VMem file" ,
                      "Invalid or obselete Lisp VMem")

  // Version checking
  // IPage has the actual version of Lisp (which is checked here against the
  // versions required by both ucode and Bcpl) and the min required versions
  // of ucode and Bcpl. Bcpl/ucode compatibility is checked earlier.
  let LispV = IGetBase(IFPLVersion)
  unless LispV ge MinLispForRam
      do GiveUp("Sysout too old for this microcode")
  unless LispV ge MinLispForBcpl
      do GiveUp("Sysout too old for this Lisp.Run")
  unless RamVersion ge IGetBase(IFPMinRVersion)
      do GiveUp("Microcode too old for this sysout")
  unless BcplVersion ge IGetBase(IFPMinBVersion)
      do GiveUp("Lisp.Run too old for this sysout")
  if (MachineType() eq Dolphin) & (IGetBase(IFPFullSpaceUsed) ne 0)
    then GiveUp("Sysout has larger virtual address space than this machine can read")

  // Updating IPage entries
  IPutBase(IFPRVersion, RamVersion)
  IPutBase(IFPBVersion, BcplVersion)
  IPutBase(IFPSerialNumber, Serial())
  IPutBase(IFPEmulatorSpace, EmulatorSpace)
  IPutBase(IFPScreenWidth, ScreenWords)
  IPutBase(IFPUserNameAddr, UserName)
  IPutBase(IFPUserPswdAddr, UserPassword)
  IPutBase(IFPREALPAGETABLEPTR, BptSegment)
  IPutBase(IFPREALPAGETABLEPTR+1, Bpt)	// new format: store as pointer
  IPutBase(IFPRPTSIZE, BptSize)
  IPutBase(IFPRPOFFSET, RPoffset)
  IPutBase(IFPEMBUFVP, lispBufVp)
  IPutBase(IFPMachineType, MachineType())
  IPutBase(IFPNSHost0, HostMagic0)
  IPutBase(IFPNSHost1, HostMagic1)
  IPutBase(IFPNSHost2, HostMagic2)
  IPutBase(IFPSYSDISK, sysDisk)
  IPutBase(IFPISFMAP, LispFmap)
  IPutBase(IFPEMUBUFFERS, extraBuffers)
  IPutBase(IFPEMUBUFLENGTH, extraBufLength)
  IPutBase(IFPNRealPages, NPages)

  ]