// 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<