// IFSScavInit.bcpl -- Scavenger initialization // Copyright Xerox Corporation 1979, 1980, 1981, 1983 // Last modified June 16, 1983 9:18 PM by Boggs get "AltoDefs.d" get "Streams.d" get "IfsFiles.decl" get "IFS.decl" get "IfsVmem.decl" get "SysDefs.d" get "IfsInit.decl" external [ // outgoing procedures InitIFSPart1; InitIFSPart2; InitIFSPart3 IFSFinish // incoming procedures Junta; IFSAfterJunta; MyFrame; CallersFrame Zero; MoveBlock; SetBlock LoadRam; Idle; IFSIdle; IfsRamImage; InitBcplRuntime InitOverlays; FixupSwappedOut; CallProcProcess InitVMem; AddBuffers; InitXMOverlays; InitDisksFinish InitializeZone; Allocate; Free; AddToZone; IFSAddToZone IFSAllocate; IFSFree; IFSError; SysErr; CallSwat PutTemplate; InitContextSched SetWorkingDir; OpenFile; ReadBlock; PositionPage; GetCurrentFa SplitPuts; LogErrors; Endofs; Closes; Resets CreateKeyboardStream; ShowDisplayStream; CreateDisplayStream IFSCreateDDMgr; BFSCreateDDMgr; Enqueue; InitializeContext BFSWriteDiskDescriptor; BFSWritePages; ExtractSubstring IfsScavenger; ScavNoBufsProc; IfsNoBufsProc TFSSilentBoot; TFSSwatProc; BFSInit; CloseDisk // outgoing statics isb; ifsCtxQ; numVMemBufs bfsDDMgr; tfsDDMgr // incoming statics CursorLink; snarfTable; oPageQ; chunkQ; dontSnarf bigZone; smallZone; sysZone; lvSysZone; lenFMap lvUserFinishProc; lvSwatContextProc scratchDisk; scavDisk; sysDisk; dsp; OsVersion; debugFlag AltoVersion; monthNames ] static [ bfsDDMgr; tfsDDMgr; ifsCtxQ numVMemBufs = 0 savedUFP spyBuffer = 3200b //storage needed for spy buffer (changes over time) isb ] manifest [ stackLimit = 335b lenDsp = 2*1024 lenScavStack = 3*1024 lenInitStack = 2*1024 lenCallProcStack = 1024 ecBadLoadRam = 16 ecOsVersion = 5 ecNumVMemBufs = 3 ] //---------------------------------------------------------------------------- let InitIFSPart1(layoutVector, userParams, cfaIFSRun) be //---------------------------------------------------------------------------- //This procedures is called with the full OS in core, and does // initialization requiring the BFS and other OS modules which // are not needed once we get going. [ // Patch in overlay numbers of overlays to be pinned in memory let pinnedOverlays = table [ 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 ] compileif size ISB.pinnedOverlays/16 ne 10 then [ foo = nil ] if OsVersion ls 17 then IFSError(ecOsVersion, 17) // Create a local Initialization Storage Block. // It will be copied into a block pointed to by the isb static once // the allocator has been set up. // Install zone size constants now so they will be easy to patch. let lisb = vec lenISB; Zero(lisb, lenISB) lisb>>ISB.lenBigZone = 10*1024 lisb>>ISB.bigZoneIncr = 0 lisb>>ISB.lenSmallZone = 2*1024 lisb>>ISB.smallZoneIncr = 0 MoveBlock(lv lisb>>ISB.pinnedOverlays, pinnedOverlays, size ISB.pinnedOverlays/16) // First, patch the runtime environment in various ways let t = AddToZone; AddToZone = IFSAddToZone; IFSAddToZone = t CursorLink = 0 // unlink cursor from mouse Idle = IFSIdle // install our own Idle procedure for TFS @lvSwatContextProc = TFSSwatProc // Put an hourglass in the cursor MoveBlock(cursorBitMap, table [ 37776b; 20002b; 34016b; 17074b; 7570b; 3760b; 1740b; 700b 1740b; 3260b; 6230b; 14714b; 31746b; 23762b; 37776b; 0 ], 16) // Load the Ram with IFS microcode // First, change all the XMAR_s to MAR_s if running on a non-XM Alto if AltoVersion<>UInst.F1 eq 11b & uInst>>UInst.F2 eq 16b then uInst>>UInst.F2 = 10b ] ] let ram = LoadRam(IfsRamImage, true) // silent boot if ram ne 0 then IFSError(ecBadLoadRam, ram) // Now throw away LoadRam and microcode. // Since the relocation table is above this, we must slide it down. // While doing so, compress it to 1 word/entry. let relocTable = layoutVector!31 LoadRam!0 = relocTable!0 for i = 1 to relocTable!0 do LoadRam!i = relocTable!(2*i-1) lisb>>ISB.relocTable = LoadRam @stackLimit = LoadRam+LoadRam!0+1 lisb>>ISB.pcX = layoutVector!($X-$A) // Bldr "X/Q" lisb>>ISB.pcI = layoutVector!($I-$A) // Bldr "I/Q" // InitIFSPart1 (cont'd) // Set up access to resident instances of OS procedures also in overlays. // All procedures that are in Dirs, DiskStreams, DiskStreamsMain, and // DiskStreamsAux and that are externally called during InitIFSPart1 // must be enumerated here. Offsets are taken from Sys.bk. let mainStatics = lvSysZone - 221B //entry 0 of main statics vector SetWorkingDir = mainStatics!53b OpenFile = mainStatics!56b ReadBlock = mainStatics!77b PositionPage = mainStatics!101b GetCurrentFa = mainStatics!104b BFSCreateDDMgr = mainStatics!234b BFSWriteDiskDescriptor = mainStatics!233b BFSWritePages = mainStatics!254b // Interpret any global switches passed to us by the Executive lisb>>ISB.maxBanksXM = 0 //temporarily let allocatorDebug = false let allocateSpyBuffer = false lenFMap = 500 //don't screw around! while userParams!0 ne 0 do [ if userParams>>UPE.type eq globalSwitches then [ let val = true for i = 1 to userParams>>UPE.length-1 do [ switchon userParams!i into [ case $-: val = not val; loop case $D: case $d: debugFlag = val; endcase case $A: case $a: allocatorDebug = val; endcase case $S: case $s: allocateSpyBuffer = val; endcase case $X: case $x: unless val do lisb>>ISB.maxBanksXM = 0; endcase case $F: case $f: lenFMap = lenFMap+100; endcase case $1 to $4: lisb>>ISB.maxBanksXM = userParams!i-$0; endcase default: PutTemplate(dsp, "Unknown switch /$C, ignored.*n", userParams!i) ] val = true ] ] userParams = userParams + userParams>>UPE.length ] // if no potential for XM then turn off XM switch if AltoVersion<>ISB.maxBanksXM = 0 // Set up micorcoded bcpl runtime InitBcplRuntime() // InitIFSPart1 (cont'd) // Create the system free storage zones. // These zones will end up surrounded by vMem buffers, so they // begin and end on standard page boundaries. let iChunkQ = vec 1; iChunkQ!0 = 0 chunkQ = iChunkQ // Large blocks come from bigZone: lisb>>ISB.bigZoneBot = @stackLimit+(1 lshift logStdPageLength -1) & (-1) lshift logStdPageLength @stackLimit = lisb>>ISB.bigZoneBot + lisb>>ISB.lenBigZone bigZone = InitializeZone(lisb>>ISB.bigZoneBot, lisb>>ISB.lenBigZone, SysErr, (allocatorDebug ? SysErr, 0)) // Small blocks come from smallZone: let base = @stackLimit @stackLimit = base + lisb>>ISB.lenSmallZone smallZone = InitializeZone(base, lisb>>ISB.lenSmallZone, SysErr, (allocatorDebug ? SysErr, 0)) // Initialize the IFS Allocator and divert calls to sysZone into it. sysZone = Allocate(smallZone, 6) oPageQ = sysZone+2; oPageQ!0 = 0 chunkQ = sysZone+4; chunkQ!0 = iChunkQ!0; chunkQ!1 = iChunkQ!1 sysZone>>ZN.Allocate = IFSAllocate sysZone>>ZN.Free = IFSFree let lenSnarf = 1 lshift (16-logStdPageLength) snarfTable = Allocate(bigZone, lenSnarf) SetBlock(snarfTable,-1, lenSnarf) // Create the real Initialization Storage Block isb = Allocate(sysZone, lenISB) MoveBlock(isb, lisb, lenISB) MoveBlock(lv isb>>ISB.cfaIFSSwap, cfaIFSRun, lCFA) ifsCtxQ = Allocate(sysZone,2); ifsCtxQ!0 = 0 InitContextSched() //queues a resident user finish proc // Start the CallProc process. Enqueue(ifsCtxQ, InitializeContext(Allocate(bigZone, lenCallProcStack), lenCallProcStack, CallProcProcess)) // Allocate spy buffer if required test allocateSpyBuffer ifso [ isb>>ISB.initStart = isb>>ISB.pcI+spyBuffer spyBuffer = isb>>ISB.pcI ] ifnot [ isb>>ISB.initStart = isb>>ISB.pcI; spyBuffer = 0 ] //IFSFinish should be the first swappable user finish proc queued on // lvUserFinishProc so that it will be the last one executed, // because when it is done, vMem and overlays won't work. savedUFP = @lvUserFinishProc @lvUserFinishProc = IFSFinish IfsNoBufsProc = ScavNoBufsProc InitVMem() bfsDDMgr = BFSCreateDDMgr(sysZone) BFSWriteDiskDescriptor(sysDisk) // OS version sysDisk = BFSInit(sysZone, true, 0, bfsDDMgr) // my version // finished with most of the OS. Junta! Junta(levBuffer, IFSAfterJunta) ] //---------------------------------------------------------------------------- and InitIFSPart2() be //---------------------------------------------------------------------------- // This procedure sets up the virtual memory and overlay machinery. // Most of the OS is gone now. [ // Get the keyboard going again quickly CreateKeyboardStream() // Make stack end in zero rather than loop or garbage CallersFrame()!0 = 0 // Give most of our stack to vmem and free storage zones. // Must keep 'lenInitStack' words (more or less) until the last moment let base = @stackLimit @stackLimit = (MyFrame()-lenInitStack) & (-1) lshift logStdPageLength if isb>>ISB.bigZoneIncr ne 0 then [ AddToZone(bigZone, base, isb>>ISB.bigZoneIncr) base = base + isb>>ISB.bigZoneIncr ] if isb>>ISB.smallZoneIncr ne 0 then AddToZone(smallZone, base, isb>>ISB.smallZoneIncr) base = base + isb>>ISB.smallZoneIncr MakeFree(bigZone, base, @stackLimit-base) dontSnarf = false //ok for Allocate to snarf vmem buffers now // Give InitOverlays the largest contiguous chunk of storage we can find let bufLen = numVMemBufs lshift logStdPageLength let buf = nil [ buf = Allocate(sysZone, bufLen, true) if buf ne 0 break bufLen = bufLen - 1 lshift logStdPageLength ] repeat isb>>ISB.numOverlays = 50 //CopyOverlays does this in IFS InitOverlays(sysDisk, lv isb>>ISB.cfaIFSSwap, buf, bufLen) Free(sysZone, buf) InitDisksFinish() //fix up OEPs for sysDisk & bfsDDMgr // ***** Do not queue any user finish procedures efore here ***** // this must be the last procedure called by InitIFSPart2 FixupSwappedOut(isb>>ISB.relocTable) ] //--------------------------------------------------------------------------- and InitIFSPart3() be //--------------------------------------------------------------------------- // This procedure will be called in as an overlay. // It cuts up the resident initialization code into vmem buffers, // and turns the remaining stack into vmem buffers. [ // Attempt to load overlays into extended memory. // If this is successful it will consume some of the storage // formerly occupied by initialization code, updating isb>>ISB.initStart. InitXMOverlays() // Turn the remaining initialization code into vMem buffers. MakeFree(bigZone, isb>>ISB.initStart, isb>>ISB.bigZoneBot-isb>>ISB.initStart) // If we moved resident code into XM, turn it into free storage as well. // Must do this after the preceding MakeFree to avoid the AddToZone bug. if isb>>ISB.residentCodeXM then MakeFree(bigZone, isb>>ISB.pcX, isb>>ISB.pcI-isb>>ISB.pcX) InitTimeIO() tfsDDMgr = IFSCreateDDMgr() // Open the Scavenger log dsp = Allocate(sysZone, lST); SetBlock(dsp, CallSwat, lST) dsp>>ST.par1 = CreateDisplayStream(5, Allocate(bigZone, lenDsp), lenDsp) ShowDisplayStream(dsp>>ST.par1, DSalone) dsp>>ST.par2 = OpenFile("IfsScavenger.log", ksTypeWriteOnly, charItem) if dsp>>ST.par2 eq 0 then IFSError(ecDiabloFile, "IfsScavenger.log") dsp>>ST.par2>>ST.error = LogErrors dsp>>ST.puts = SplitPuts // Create main process Enqueue(ifsCtxQ, InitializeContext(Allocate(bigZone, lenScavStack), lenScavStack, IfsScavenger)) // Free up most of the remaining stack. let base = @stackLimit @stackLimit = MyFrame() -100 MakeFree(bigZone, base, @stackLimit-base) // Change cursor to 'IFS' MoveBlock(cursorBitMap, table [ 0; 0; 0; 0; 71706b; 21011b; 21010b; 21606b 21001b; 21011b; 71006b; 0; 77777b; 0; 0; 0 ], 16) // All done initializing. Let it rip. ] //--------------------------------------------------------------------------- and MakeFree(zone,first,length) be //--------------------------------------------------------------------------- // Cuts up the stretch of memory starting at 'first' into // vmem buffers, adding any scraps to 'zone'. [ manifest pageLength = 1 lshift logStdPageLength manifest pageMask = (-1) lshift logStdPageLength let last = first+length let firstModPageLength = (first+pageLength-1) & pageMask let lastModPageLength = last & pageMask AddBuffers(firstModPageLength, lastModPageLength-1) for i = firstModPageLength rshift logStdPageLength to lastModPageLength rshift logStdPageLength -1 do [ snarfTable!i = 0; numVMemBufs = numVMemBufs+1 ] if numVMemBufs lshift (logStdPageLength-logVMPageLength) gr maxVMPages then IFSError(ecNumVMemBufs) if firstModPageLength-first ge 10 then AddToZone(zone, first, firstModPageLength-first) if last-lastModPageLength ge 10 then AddToZone(zone, lastModPageLength, last-lastModPageLength) ] //---------------------------------------------------------------------------- and IFSFinish() be //---------------------------------------------------------------------------- // The last finish procedure called when a finish is done [ Closes(dsp>>ST.par1) Closes(dsp>>ST.par2) if scratchDisk ne sysDisk & scratchDisk ne 0 then CloseDisk(scratchDisk, true) if scavDisk ne 0 then CloseDisk(scavDisk) CloseDisk(sysDisk) @displayListHead = 0 TFSSilentBoot() @lvUserFinishProc = savedUFP ] //--------------------------------------------------------------------------- and InitTimeIO() be // make legal constant string for modified IfsTimeIO //--------------------------------------------------------------------------- monthNames = ExtractSubstring("x*007January*000*000*010February*000*005March*000*000*000*000*005April*000*000*000*000*003May*000*000*000*000*000*000*004June*000*000*000*000*000*004July*000*000*000*000*000*006August*000*000*000*011September*007October*000*000*010November*000*010December*000") +1