// VMemInit.bcpl - does VMem setup for MainInit
// Last change September 5, 1981  12:38 PM by Bill van Melle
// Last change May 8, 1981  11:53 PM by Beau Sheil
// Tone change March 17, 1981  9:18 PM by Beau Sheil
// Trill change February 24, 1981  10:40 AM by Beau Sheil
// Last change February 19, 1981  1:05 PM by Beau Sheil

	get "LispBcpl.decl"
	get "Stats.decl"
	get "VMem.decl"

external [	// procedures defined here
	SetupLispMem; LoadIPage

		// O.S. procedures
	Closes; Endofs; ReadBlock; Zero; OpenFileFromFp; PositionPage
	CallSwat; Serial; Timer

		// procedures used
	@BSetBR; @BGetBase; @RWrite; IGetBase; IPutBase; ReadRP
	SetFlags; MachineType
	BP; VP2; IndexedPageIO; InitFmap; SmallUnbox; @BPutBase32
        AllocVec; Bytes2; ShortStack; LockPages; InitLispRegs; WriteStatsX

		// statics defined and/or used
	@MiscSTATSbase; NPages; ScreenWidth; @InterruptEnable; @InterruptChar
	EmuDiskVp; EmuDiskBuffer; LispFmap; EmulatorSpace; LastRealPageNo
	UserName; UserPassword
	]

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

manifest PTBLsize = 100

let SetupLispMem(SYSINid, VMEMid) be
   [
   let RamV, MinBcplForRam, MinLispForRam, ScreenWords, pnum, ppm
       = 0, nil, nil, nil, nil, nil	// adjacent for InitLispRegs
   InitLispRegs(lv RamV)		// fills in 6 words
   unless RamV ge MinRamForBcpl		// Check BEFORE using other ILR values
       do CallSwat("Microcode too old for this lisp.run")
   unless BcplVersion ge MinBcplForRam
       do CallSwat("Lisp.run too old for this microcode")
   ScreenWidth = ScreenWords lshift 4	// Save width in bits
   unless (pnum rem ppm) eq 0		// bad pages unless pnum mod ppm = 0
       do CallSwat("Bad pages found in main memory")
   let mnum = pnum / ppm		// # modules
   let pbm = nil			// pages between mods
   switchon MachineType() into
      [ case Dorado:			// Dorado specific code
             [ pbm = ppm; EmulatorSpace = D1BCPLspace ]
             endcase
	case Dolphin:			// Dolphin specific code
             [ pbm = #1000; EmulatorSpace = D0BCPLspace ]
             endcase
	default: CallSwat("Invalid machine type")
      ]
   LastRealPageNo = ppm+pbm*(mnum-1)
   NPages = mnum*ppm			// dumped by stats
   unless NPages gr PagesPerSegment
       do CallSwat("Not enough real memory")

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

// Disk routines need one also
   EmuDiskBuffer = AllocVec(WordsPerPage, WordsPerPage)
   EmuDiskVp = VP2(EmulatorSpace, EmuDiskBuffer)

// ReadRP gets page number of first real page. Then skip over emulator pages
   RPoffset = ReadRP(VP2(EmulatorSpace, 0))+PagesPerSegment
   BptSize = LastRealPageNo-PagesPerSegment
   [
   let BptLength = lBPT*BptSize
   Bpt = AllocVec(BptLength)		// alloc and zero page table
   Zero(Bpt, BptLength)
   ]
   for i = 0 to BptSize-1 do BP(i)>>BPT.STATE = UNAVAIL
// can't use buffer rel 0, as 0 used as an end marker
   AddBuffers(1, ppm - #401)		// real pages for xvmem
   for m = 1 to mnum-1 do
	AddBuffers(pbm*m - WordsPerPage, pbm*m + ppm - #401)

// make all 2^14 map entries (except for alto emulator) vacant
   for s = 0 to LastVirtualPage<<VP.segment do unless s eq EmulatorSpace
    do for p = 0 to PagesPerSegment-1
        do [ let i = Bytes2(s, p); SetFlags(i, i+PagesPerSegment, VACANT) ]

   LispFmap = AllocVec(PTBLsize)	// for isf access to lisp.virtualmem
   unless InitFmap(LispFmap, PTBLsize, VMEMid, true, 50)
       do CallSwat("Fragmented VMem")

   test (SYSINid eq 0) % (SYSINid eq -1) // SYSINid is zero if no sysin file
     ifso LoadIPage(RamV, MinLispForRam, ScreenWords)
     ifnot				// read sysin file into VMem
   [ let sst = OpenFileFromFp(SYSINid)
     unless sst do CallSwat("Can't find /I file")

//   We can use the rest of the space between the last AllocVec and the
//   current end of stack for buffers.  This space will eventually go to
//   the display bit map, but for now it is empty.
     let Buffers = AllocVec(0, WordsPerPage)	// first buf page
     let LowStackPage = ShortStack(1000)	// allow 1000 words of stack
     let bsize = LowStackPage - Buffers		// size of buffer region
     if bsize ls WordsPerPage then CallSwat("No buffers for SYSIN")
     let OldLowStack = rv StackEnd		// save old low stack
     @StackEnd = LowStackPage			// enforce stack end in read

//   Restore SavedVMEMstate from the InterfacePage
     PositionPage(sst, FirstVmemBlock);  ReadBlock(sst, Buffers, WordsPerPage)
//   First page of Buffers now has InterfacePage of sysin - write it into vmem
     IndexedPageIO(LispFmap, FirstVmemBlock, Buffers, 1, -1)
//   Interface page is now in VMEM file, so load, lock and check it
     LoadIPage(RamV, MinLispForRam, ScreenWords)

//   now read the pages off the file and into vmem - the entries in
//   the page maps on the file have the correct vmem address already
     let nxtpage = FirstVmemBlock + 1
     until Endofs(sst) do
       [ let npgs = ReadBlock(sst, Buffers, bsize)<<HiByte
         IndexedPageIO(LispFmap, nxtpage, Buffers, npgs, -1)
         nxtpage = nxtpage + npgs
       ]
     Closes(sst)
     @StackEnd = OldLowStack			// restore previous stack end
     ]

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

// for free variable lookup in microcode, all stack pages must be in core
   LockPages(STACKspace, 0, IGetBase(IFPEndOfStack)<<HiByte + 1)

// bring in the pages of the MDStypeTable and the locked down STATS pages.
// The latter contain the interrupttable, misc stats, UFN table, etc.
   LockPages(MDSTYPEspace, MDSTYPEbase, MDSTTsize)
   LockPages(STATSspace, STATSbase, STATSsize)
   
// lock down the defs of the #400+ subrs as they field punts incl page faults
   LockPages(DEFspace, #1000, 1)

   compileif DTDSize then [
	// lock down DTD table
	LockPages(DTDspace, DTDbase, DTDSize)

	// lock down the main GC table, so gc refs work in microcode.
	LockPages(HTMAINspace, HTMAINbase, HTMAINnpages)
	]

   if SYSINid then
     [ BSetBR(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 AddBuffers(firstRP, lastRP) be
   for tn = firstRP to lastRP do
      [ let bp = BP(tn)
        bp>>BPT.STATE = EMPTY
        bp>>BPT.NEXT = @Bpt
        if @Bpt eq 0 then BptLast = tn
        @Bpt = tn
        if LogPagingFlag then WriteStatsX(evAddBuffer, 0, tn)
      ]

and LoadIPage(RamVersion, MinLispForRam, ScreenWords) be
  [ 
  // LoadIPage loads and locks the interface page and checks keys and versions
  LockPages(INTERFACEspace, INTERFACEbase, 1)

  // Key check - verify file is valid and complete
  if IGetBase(IFPKey) ne IFPValidKey
     then CallSwat(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 CallSwat("Sysout too old for this microcode")
  unless LispV ge MinLispForBcpl
      do CallSwat("Sysout too old for this Lisp.Run")
  unless RamVersion ge IGetBase(IFPMinRVersion)
      do CallSwat("Microcode too old for this sysout")
  unless BcplVersion ge IGetBase(IFPMinBVersion)
     then CallSwat("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)

  // Caching some data from the IPage into statics
  InterruptEnable = IGetBase(IFPInterruptEnable)
  InterruptChar = IGetBase(IFPInterruptChar)

  ]