// 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 #14000
then NPages = #14000 // 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)
]
]