// VMemInit.bcpl - does VMem setup for MainInit
// 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"
	get "AltoFileSys.d"
	get "Streams.d"

external [	// procedures defined here
	SetupLispMem; LoadIPage
		// in LocalVMemInit.bcpl
	LocalInitVmem

		// O.S. procedures
	Closes; Endofs; ReadBlock; Zero; SetBlock; OpenFile; PositionPage
	CallSwat; Serial; Timer; OpenFileFromFp; WriteBlock; Min

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

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

static	[	// statics defined
	EmuDiskVp; EmuDiskBuffer; EmulatorSpace; LastRealPageNo; NPages
	lispBufVp
	]

manifest [
	PTBLsize = 100
	IsfChunkSize = 50
	]

let SetupLispMem(SYSINid, VMEMid, pnum, ppm) 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
   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")
	]

// TransferPage needs one page aligned paging buffer for reading in a page
   SwapBuf = AllocVec(WordsPerPage, WordsPerPage)
   BufVp = VP2(EmulatorSpace, SwapBuf)
   lispBufVp = VP2(EmulatorSpace, AllocVec(WordsPerPage, WordsPerPage))

   BufRP = ReadRP(BufVp)

// Disk routines need one also

//   EmuDiskBuffer = AllocVec(WordsPerPage, WordsPerPage)
   EmuDiskBuffer = extraBuffers+extraBufLength-WordsPerPage
   EmuDiskVp = VP2(EmulatorSpace, EmuDiskBuffer)

   SetupRealPageTable(ppm)

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

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

   LockInitPages()			// 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
   IPutBase(IFPRPTLAST, BptLast)	// store chain tail pointer
   BptLast = -1				// and disable it from now on
   ]

and SetupRealPageTable(ppm) be
  [				// ppm ignored nowadays
  if NPages gr #10000
    then NPages = #10000	// temporary to keep big mem Dorados happy

// 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 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 maxp = p
	 or if p ls minp
	  then minp = p
	]
  LastRealPageNo = maxp+1	// actually, exclusive upper bound...
  RPoffset = minp - 1		// Bpt's first real entry is minp
  BptSize = LastRealPageNo-RPoffset
  let BptLength = lBPT*BptSize
  Bpt = AllocVec(BptLength)		// alloc and initialize page table
  SetBlock(Bpt, UNAVAIL, BptLength)	// table entries all bad at first

// now march through the map again, marking good pages EMPTY,
// and linking them together

  let lastbp = Bpt			// trailing pointer
  let nextrp = nil

  for vp = nextvp to lastvp
    do	[
	nextrp = ReadRP(vp)	// next real page
	let thisbp = BP(nextrp - RPoffset)	// its Bpt entry
	if thisbp>>BPT.STATE ne UNAVAIL
	   then MapConfused(vp, nextrp)
	thisbp>>BPT.STATE = EMPTY
	lastbp>>BPT.NEXT = nextrp - RPoffset	// chain previous entry to it
	lastbp = thisbp
	SetFlags(vp, 0, VACANT)	// tell map this page is now empty, too
	]

  lastbp>>BPT.NEXT = 0
  BptLast = nextrp - RPoffset

// 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 & BP(rp-RPoffset)>>BPT.STATE ne UNAVAIL)
	   then MapConfused(vp, rp)
	]

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

// just in case, let's also mark all the other vp's vacant.
// Actually, EmulatorSpace is always zero now, but this is a
// marker in case someone changes his mind.

  for vp = NPages to (LastVirtualPage<<VP.segment eq EmulatorSpace?
			  LastVirtualPage-PagesPerSegment, LastVirtualPage)
    do SetFlags(vp, 0, VACANT)
  ]

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

and LoadIPage() be
  [ 
  // LoadIPage loads and locks the interface page and checks keys and versions
  LockSpecialPageVp(VP2(INTERFACEspace, INTERFACEbase))

  // 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)
     then GiveUp("Lisp.Run too old for this sysout")

  // 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(IFPREALPAGETABLE, Bpt)
  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)

  ]

and LockInitPages() be
[
   LoadIPage()
// get PageMapTBL and the pages of the PageMap
   SpecialLockPages(PMTspace, PMTbase, 2)
	// 2 pages covers 22-bit addresses
	// we need only the first page but all are locked for performance
   SpecialLockPages(PAGEMAPspace, PAGEMAPbase,
			(IGetBase(IFPNxtPMAddr)-1)<<HiByte+1)

// now that the essentials are in, pull in any locked pages

for i = 0 to MaxKey1
   do	[				// mapping over primary table
	let pmpE = BGetBase(PMTspace, PMTbase+i)
	if pmpE ne -1
	   then	[			// there are secondary entries
		for j = 0 to MaxKey2
		   do	[
			let fp = BGetBase(PAGEMAPspace, PAGEMAPbase+pmpE+j)
			if fp ls 0
			   then	[		// lock bit set
				let vp = (i lshift 5)+j
				test (ReadFlags(vp) & VACANT) eq VACANT
				   ifso GetPageInCore(vp, fp, false)
				  ifnot 	// page already read
					BP(ReadRP(vp)-RPoffset)>>BPT.LOCK = true
						// redundant??
				]
			]
		]
	]
if fillMemory
   then [			// fill real memory with everything else
for i = 0 to MaxKey1
   do	[				// mapping over primary table
	if BP(Bpt>>BPT.NEXT)>>BPT.STATE ne EMPTY
	   then break		// stop when no empties left	
	let pmpE = BGetBase(PMTspace, PMTbase+i)
	if pmpE ne -1
	   then	[			// there are secondary entries
		for j = 0 to MaxKey2
		   do	[
			let fp = BGetBase(PAGEMAPspace, PAGEMAPbase+pmpE+j)
			if fp gr 0
			   then	[		// lock bit set
				let vp = (i lshift 5)+j
				if (ReadFlags(vp) & VACANT) eq VACANT
				   then GetPageInCore(vp, fp, false)
				]
			]
		]
	]
	]

]

and SpecialLockPages(vaHi, vaLo, nbrPages) be
 [
   let v = VP2(vaHi, vaLo)
   for i = 0 to nbrPages-1 do LockSpecialPageVp(v+i)
 ]

and LockSpecialPageVp(vp) be
 [
   if (ReadFlags(vp) & VACANT) eq VACANT	// is page already in core?
      then 
	[
   // Special case code to return vmem file address of pages which support 
   // page lookup. These pages are looked up here b/c they are always locked
   // before their first reference and this is a low frequency operation.

   // InterfacePage is known to be on FirstVmemBlock. Rest of page map
   // tables are at a fixed location wrt various interface page entries. 

	let fpage =
		vp eq InterfacePageVP ? FirstVmemBlock,
		  vp eq PAGEMAPvp ? IGetBase(IFPfilePnPMP0),
		    (vp & #177770) eq PMTspaceVP ?
			IGetBase(IFPfilePnPMT0)+(vp&7),
			  LookupPage(vp)
	unless fpage do return
	GetPageInCore(vp, fpage % LOCKbit, false)
	]
 ]