// IfsOvXMInit.bcpl - Initialization for Bcpl code in Extended Memory
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 17, 1982 1:21 PM by Taft
get "AltoFileSys.d"
get "Disks.d"
get "Ifs.decl"
get "IfsInit.decl"
get "IfsVMem.decl"
get "IfsXEmulator.decl"
get "IfsOverlays.decl"
get "SysDefs.d"
get "AltoDefs.d"
get "BTree.decl"
external
[
// Outgoing procedures
InitXMOverlays
// Incoming procedures
Allocate; DoubleBlt; Enqueue; Free; Usc; MoveBlock; Max; Min; SysErr
GenerateOverlays; IFSError; OverlayFirstPn; OverlayNpages; ReadOverlay;
LoadXM; StoreXM; @VRRP; LockCell
IFSAllocate; IFSFree; Idle; IFSIdle
TFSActOnPages; TFSVirtualDA;
TFSInitializeCbStorage; TFSDoDiskCommand; TFSGetCb
OvDOPAGEIO; OvCleanupLocks; OvPageType; OvPageGroupBase; OvPageGroupAlign;
OvPageGroupSize; DeclareOverlayPresent;
NoBufsProc; LockedCells; LastLockedCell; OverlayLockProc
BVRRP; BVWRP; BtLockCell; BtUnlockCell
VFileDOPAGEIO; VFilePageType; VFilePageGroupBase; VFilePageGroupAlign;
VFilePageGroupSize
// Incoming statics
numOvXMPages; numOvXMPagesPerBank; offsetResidentXM;
ovFirstPage; ovPageSize; logOvPageSize; logOvVmPages
FirstOEP; EndOEP; FirstOD; EndOD; oVmd; vFileVMI
sysZone; bigZone; smallZone; AltoVersion; isb; primaryIFS
]
manifest
[
jsrRv370=#6370; sta312=#55001; jsrRv367=#6367; jsrRv366=#6366;
ecIllFormedXMOverlay = 50
ecOverlayCrossesBank = 51
]
structure ZN: // Zone structure, copied from Alloc.bcpl
[
Allocate word
Free word
OutOfSpaceRtn word
MalformedRtn word
]
//----------------------------------------------------------------------------
let InitXMOverlays() = valof
//----------------------------------------------------------------------------
// Called during swappable initialization to load as many overlays as will
// fit into extended memory, if present. Returns true if at least one
// extended memory bank is present and false otherwise.
// Consumes storage starting at isb>>ISB.initStart for creating XJmp blocks,
// and updates the initStart cell.
[
// Swap in and lock any pinned overlays (for debugging)
for i = 0 to (size ISB.pinnedOverlays/16)-1 do
if isb>>ISB.pinnedOverlays↑i ne 0 then
[
let od = FirstOD + (isb>>ISB.pinnedOverlays↑i -1)*lOD
if od>>OD.core eq 0 then
DeclareOverlayPresent(od,
VRRP((OverlayFirstPn(od)-ovFirstPage) lshift logOvVmPages +
oVmd>>VMD.base))
LockCell(lv od>>OD.core)
]
let nBanks = Min(CountBanks(), isb>>ISB.maxBanksXM)
if nBanks le 1 resultis false
// Must not cause an overlay fault during the following, since the overlay
// fault handler might try to get the overlay from XM!
numOvXMPagesPerBank = 177000b rshift logOvPageSize
numOvXMPages = numOvXMPagesPerBank*(nBanks-1)
GenerateOverlays(LoadOverlayIntoXM)
// See if there is enough XM left over to load all the resident Bcpl code,
// which begins at layout vector PC value "X" and ends at value "I".
let baseResident = isb>>ISB.pcX & -2 // make even (for DoubleBlt)
let endResident = isb>>ISB.pcI
let residentXMPages = (endResident-baseResident-1) rshift logOvPageSize +1
let numXMPagesUsed = OverlayFirstPn(EndOD) - ovFirstPage
if numXMPagesUsed + residentXMPages le numOvXMPages then
[
// Decide where to put it so as not to cross a bank boundary
let page = numXMPagesUsed rem numOvXMPagesPerBank
let bank = numXMPagesUsed/numOvXMPagesPerBank +1
if page+residentXMPages gr numOvXMPagesPerBank then
[ page = 0; bank = bank+1 ] // start in next higher bank
// Copy the code into XM
let baseXM = page lshift logOvPageSize
offsetResidentXM = baseXM - baseResident
DoubleBlt(baseXM, baseResident, residentXMPages lshift logOvPageSize,
bank lshift 2)
// Create XJMP blocks for all the procedures, and fix up their statics
let oldOverlayLockProc = OverlayLockProc
let relocTable = isb>>ISB.relocTable
for i = 1 to relocTable!0 do
[
let pStatic = relocTable!i
if @pStatic uls endResident then
[ // in resident XM code, as opposed to init
let xjmp = isb>>ISB.initStart; isb>>ISB.initStart = xjmp+2
xjmp!0 = XJMP0 + bank
xjmp!1 = @pStatic + offsetResidentXM
// When we find the rAllocate and rFree procedures (which aren't
// declared external), fix up the values in smallZone and bigZone.
if @pStatic eq smallZone>>ZN.Allocate then
[ smallZone>>ZN.Allocate = xjmp; bigZone>>ZN.Allocate = xjmp ]
if @pStatic eq smallZone>>ZN.Free then
[ smallZone>>ZN.Free = xjmp; bigZone>>ZN.Free = xjmp ]
@pStatic = xjmp
]
]
// InitXMOverlays (cont'd)
// Fix up procedure values in existing disk, zone, tree, vmi objects
for i = 0 to primaryIFS>>IFS.numUnits-1 do
[
let disk = primaryIFS>>IFS.lpdt↑i
disk>>DSK.ActOnDiskPages = TFSActOnPages
disk>>DSK.VirtualDiskDA = TFSVirtualDA
disk>>DSK.InitializeDiskCBZ = TFSInitializeCbStorage
disk>>DSK.DoDiskCommand = TFSDoDiskCommand
disk>>DSK.GetDiskCb = TFSGetCb
]
sysZone>>ZN.Allocate = IFSAllocate; sysZone>>ZN.Free = IFSFree
smallZone>>ZN.OutOfSpaceRtn = SysErr
if smallZone>>ZN.MalformedRtn ne 0 then smallZone>>ZN.MalformedRtn = SysErr
bigZone>>ZN.OutOfSpaceRtn = SysErr
if bigZone>>ZN.MalformedRtn ne 0 then bigZone>>ZN.MalformedRtn = SysErr
let tree = primaryIFS>>IFS.dirBTree
tree>>TREE.BVRRP = BVRRP; tree>>TREE.BVWRP = BVWRP
tree>>TREE.BLockCell = BtLockCell; tree>>TREE.BUnlockCell = BtUnlockCell
vFileVMI>>VMI.DOPAGEIO = VFileDOPAGEIO
vFileVMI>>VMI.PageType = VFilePageType
vFileVMI>>VMI.PageGroupBase = VFilePageGroupBase
vFileVMI>>VMI.PageGroupAlign = VFilePageGroupAlign
vFileVMI>>VMI.PageGroupSize = VFilePageGroupSize
let oVmi = oVmd>>VMD.vmi
oVmi>>VMI.DOPAGEIO = OvDOPAGEIO
oVmi>>VMI.CleanupLocks = OvCleanupLocks
oVmi>>VMI.PageType = OvPageType
oVmi>>VMI.PageGroupBase = OvPageGroupBase
oVmi>>VMI.PageGroupAlign = OvPageGroupAlign
oVmi>>VMI.PageGroupSize = OvPageGroupSize
// Fix up other copies of procedure statics
Idle = IFSIdle
let lc = LockedCells; while lc ne LastLockedCell do
[ if lc!1 eq oldOverlayLockProc then lc!1 = OverlayLockProc; lc = lc+2 ]
isb>>ISB.residentCodeXM = true // tell InitIFSPart3 we did this
]
resultis true
]
//----------------------------------------------------------------------------
and LoadOverlayIntoXM(od) be
//----------------------------------------------------------------------------
[
let ovn = (od-FirstOD)/lOD +1
for i = 0 to (size ISB.pinnedOverlays/16)-1 do
if isb>>ISB.pinnedOverlays↑i eq ovn then return // pinned overlay
let normPage = OverlayFirstPn(od)-ovFirstPage
let nPages = OverlayNpages(od)
if normPage+nPages le numOvXMPages then
[
// Overlay will fit in XM. Read it in so we can play with it.
let page = normPage rem numOvXMPagesPerBank
let bank = normPage/numOvXMPagesPerBank +1
let xBase = page lshift logOvPageSize
if page+nPages gr numOvXMPagesPerBank then IFSError(ecOverlayCrossesBank)
let buf = Allocate(sysZone, nPages lshift logOvPageSize)
ReadOverlay(ovFirstPage+normPage, buf, nPages)
// Sort the Bcpl pairs by relative PC value.
let firstPair = buf + #21 + buf!1;
let lastPair = firstPair + 2 * firstPair!-1 - 2;
for sortPair = firstPair + 2 to lastPair by 2 do // bubble sort the pairs
[
let staticAddress = sortPair!0; let relativePC = sortPair!1;
for pair = sortPair - 2 to firstPair by -2 do
[
if relativePC ugr pair!1 then break;
pair!2 = pair!0; pair!3 = pair!1;
pair!0 = staticAddress; pair!1 = relativePC;
]
]
// Move the non-Bcpl pairs to the beginning of the relocation pair table.
// A Bcpl pair is one that points to a Bcpl entry sequence or that is
// bracketed by a Bcpl entry and a Bcpl return (i.e., a label).
// We know that the compiler generates only one Bcpl return per procedure,
// and it is always at the end. Watch out for nested procedures!
let bcplPair = firstPair; // where the bcpl pairs start
let bcplReturn = buf; // the latest bcpl entry return address
let bcplEnd = buf; // the latest bcpl BR end + 1
for pair = firstPair to lastPair by 2 do
[
let entry = buf + #20 + pair!1;
if entry!0 eq sta312 & entry!1 eq jsrRv370 & entry!3 eq jsrRv367 then
[
if entry ugr bcplEnd then bcplEnd = entry-1 + entry!-1; //new bcpl BR
if entry ugr bcplReturn then // new bcpl procedure
[
bcplReturn = entry
let nests = 1;
until nests eq 0 do
[
bcplReturn = bcplReturn + 1;
if bcplReturn!0 eq sta312 & bcplReturn!1 eq jsrRv370 &
bcplReturn!3 eq jsrRv367 then nests = nests + 1;
if bcplReturn!0 eq jsrRv366 then nests = nests - 1;
]
]
]
test entry uls bcplEnd % entry uls bcplReturn
ifso unless entry uls bcplEnd & entry uls bcplReturn then
IFSError(ecIllFormedXMOverlay);
ifnot
[
let staticAddress = pair!0; let relativePC = pair!1;
bcplPair = bcplPair + 2;
for movePair = pair to bcplPair by -2 do
[ movePair!0 = movePair!-2; movePair!1 = movePair!-1; ]
bcplPair!-2 = staticAddress; bcplPair!-1 = relativePC;
]
]
// LoadOverlayIntoXM (cont'd)
// Look for non-Bcpl pairs that have been declared XM Entry Points (XEPs)
// and move them into the Bcpl group.
let xepTable = isb>>ISB.xepTable
let pair = firstPair
until pair uge bcplPair do
[
for i = 1 to xepTable!0 do
if pair!0 eq xepTable!i then
[
bcplPair = bcplPair-2
let t = pair!0; pair!0 = bcplPair!0; bcplPair!0 = t
t = pair!1; pair!1 = bcplPair!1; bcplPair!1 = t
]
pair = pair+2
]
// Adjust pair count to include only the non-Bcpl pairs, since those
// are the only ones that should participate in overlay fault fixups.
firstPair!-1 = (bcplPair-firstPair) rshift 1
// Now construct XJMP blocks for all the Bcpl pairs, except those
// that have already been declared OEPs.
for pair = bcplPair to lastPair by 2 do
[
let pStatic, pCode = pair!0, xBase + #20 + pair!1
let xjmp = nil; // xjmp is where to put the XJMP instruction
test Usc(@pStatic-FirstOEP, EndOEP-FirstOEP) ls 0 // OEP?
ifso
[ // yes, turn OEP block into XJMP block
xjmp = lv (@pStatic)>>OEP.JSRJMP
]
ifnot
[ // no, create an XJMP block
xjmp = isb>>ISB.initStart; isb>>ISB.initStart = xjmp+2
@pStatic = xjmp
]
xjmp!0 = XJMP0 + bank;
xjmp!1 = pCode
]
// If this overlay is already present, copy the modified fixup vector
// into the present overlay so that the Bcpl statics don't get clobbered
// when the overlay is released.
if od>>OD.core ne 0 then
MoveBlock(od>>OD.core + ((firstPair-1)-buf), firstPair-1,
(lastPair+2)-(firstPair-1))
// Copy the overlay into XM
DoubleBlt(xBase, buf, nPages lshift logOvPageSize, bank lshift 2)
Free(sysZone, buf)
]
]
//----------------------------------------------------------------------------
and CountBanks() = valof
//----------------------------------------------------------------------------
// Returns zero if this is a non-XM Alto, or 1 through 4 depending on the
// number of (contiguous) memory banks present. As a side-effect, corrects
// parity in all banks (>0) that are present.
[
if AltoVersion<<VERS.eng ne 3 resultis 0 // An XM Alto is an "Alto 3"
let nBanks = 4
@activeInterrupts = @activeInterrupts & 177776b // Disable parity interrupt
for bank = 1 to 3 do
[
StoreXM(bank, 0, 125252b); let r1 = LoadXM(bank, 0)
StoreXM(bank, 0, 52525b); let r2 = LoadXM(bank, 0)
if r1 ne 125252b % r2 ne 52525b then
[ nBanks = bank; break ]
DoubleBlt(0, 0, 177000b, bank lshift 2) // dest=bank, source=0
]
@wakeupsWaiting = @wakeupsWaiting & 177776b // Flush pending parity interrupt
@activeInterrupts = @activeInterrupts % 1 // Reenable parity interrupt
resultis nBanks
]