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