// IfsInitRes.bcpl -- IFS resident initialization
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 12, 1982 6:41 PM by Taft
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
// incoming procedures
Junta; MyFrame; CallersFrame; Zero; MoveBlock; IFSAfterJunta; SetBlock
LoadRam; Idle; IFSIdle; IfsRamImage; InitBcplRuntime; RamTest
InitOverlays; CopyOverlays; FixupSwappedOut
InitDisks; InitDisksFinish; MakeFree; IFSFinish
InitVMem; SetEndCode
InitializeZone; Allocate; Free; Enqueue
AddToZone; IFSAddToZone
OpenIFSPart1; CreateIFSPart1
GetCreateParams; DestroyCreateParams
IFSAllocate; IFSFree; IFSError; SysErr; TFSSwatProc; CallProcProcess
ExtractSubstring; PutTemplate; Wss; InitContextSched; InitializeContext
OpenFile; Endofs; Closes; ReadBlock; WriteBlock; ReadLeaderPage
FilePos; SetFilePos; PositionPtr; CreateDiskStream; TruncateDiskStream
SetWorkingDir; PositionPage; JumpToFa; GetCurrentFa; GetCompleteFa
// outgoing statics
ifsCtxQ; primaryIFS; system; savedUFP; isb
debugFlag; numVMemBufs; spyBuffer
// incoming statics
lvCursorLink; snarfTable; dsp; OsVersion; AltoVersion
oPageQ; chunkQ; freePageQ; dontSnarf;
bigZone; smallZone; lvSysZone; sysZone; entFlag; lenFMap
lvUserFinishProc; lvSwatContextProc; TFSLeaveDisplay; leafPresent
]
static
[
ifsCtxQ; primaryIFS; system; savedUFP; isb
debugFlag = false
numVMemBufs = 0
spyBuffer = 5500b // Storage needed for spy buffer (changes over time)
]
manifest
[
stackLimit = 335b
lenInitStack = 2*1024
lenCallProcStack = 800
ecBadLoadRam = 16
ecOsVersion = 5
]
//----------------------------------------------------------------------------
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 19 then IFSError(ecOsVersion, 19)
// 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 = 7*1024
lisb>>ISB.bigZoneIncr = 6*1024
lisb>>ISB.lenSmallZone = 2*1024
lisb>>ISB.smallZoneIncr = 0*1024
MoveBlock(lv lisb>>ISB.pinnedOverlays, pinnedOverlays,
size ISB.pinnedOverlays/16)
// First, patch up the runtime environment in various ways
let t = AddToZone; AddToZone = IFSAddToZone; IFSAddToZone = t
@lvCursorLink = 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<<VERS.eng ne 3 then // an XM Alto is an "Alto 3"
[
structure UInst: // Alto microinstruction
[
RSEL bit 5; ALUF bit 4; BS bit 3; F1 bit 4;
F2 bit 4; LOADT bit 1; LOADL bit 1; NEXT bit 10;
]
for i = 0 to 1777B do
[ // XMAR← is F1=1, F2=6, but high-order bits of F1/F2 are complemented
let uInst = IfsRamImage + 400B + 2*i
if uInst>>UInst.F1 eq 11B & uInst>>UInst.F2 eq 16B then
uInst>>UInst.F2 = 10B
]
]
RamTest(0) // Doesn't return if Ram is bad
let ram = LoadRam(IfsRamImage, true) //silent boot
if ram ne 0 then IFSError(ecBadLoadRam, ram)
RamTest(IfsRamImage+400B)
// Must now throw away LoadRam and microcode to gain enough memory
// for primaryIFS creation, which needs a lot of space and executes
// with the full OS in core. Since the relocation table is above this,
// we must slide it down. While doing so, compress to 1 word/entry.
let relocTable = layoutVector!31 //table of resident init procs
LoadRam!0 = relocTable!0
for i = 1 to relocTable!0 do LoadRam!i = relocTable!(2*i-1)
lisb>>ISB.relocTable = LoadRam
SetEndCode(LoadRam+LoadRam!0+1)
lisb>>ISB.pcX = layoutVector!($X-$A) // Bldr "X/Q"
lisb>>ISB.pcL = layoutVector!($L-$A) // Bldr "L/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
CreateDiskStream = mainStatics!71B
ReadLeaderPage = mainStatics!72B
WriteBlock = mainStatics!76B
ReadBlock = mainStatics!77B
TruncateDiskStream = mainStatics!100B
PositionPage = mainStatics!101B
PositionPtr = mainStatics!102B
JumpToFa = mainStatics!103B
GetCurrentFa = mainStatics!104B
GetCompleteFa = mainStatics!105B
FilePos = mainStatics!110B
SetFilePos = mainStatics!111B
// Interpret any global switches passed to us by the Executive
lisb>>ISB.verifyTree = true
lisb>>ISB.maxBanksXM = 4
lisb>>ISB.enableMiscServers = true
let allocatorDebug = false
let allocateSpyBuffer = false
leafPresent = false
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 $C: case $c:
lisb>>ISB.creatingPrimary = val; endcase
case $D: case $d:
debugFlag = val; endcase
case $A: case $a:
allocatorDebug = val; endcase
case $V: case $v:
lisb>>ISB.verifyTree = val; endcase
case $S: case $s:
allocateSpyBuffer = val; endcase
case $X: case $x:
unless val do lisb>>ISB.maxBanksXM = 0; endcase
case $M: case $m:
lisb>>ISB.enableMiscServers = val; endcase
case $F: case $f:
lenFMap = lenFMap+100; endcase
case $L: case $l:
leafPresent = val; 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 /X switch
if AltoVersion<<VERS.eng ne 3 then lisb>>ISB.maxBanksXM = 0
// Set up microcoded 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 on sysZone into it.
sysZone = Allocate(smallZone, 10); Zero(sysZone, 10)
oPageQ = sysZone+2
chunkQ = sysZone+4; MoveBlock(chunkQ, iChunkQ, 2)
freePageQ = sysZone+6
ifsCtxQ = sysZone+8
sysZone>>ZN.Allocate = IFSAllocate
sysZone>>ZN.Free = IFSFree
let savedSysZone = @lvSysZone
@lvSysZone = sysZone
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)
// Start the CallProc process.
InitContextSched()
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.
// ***** Do not queue any userFinishProcs between here and
// the end of InitIFSPart2 *****
savedUFP = @lvUserFinishProc
@lvUserFinishProc = IFSFinish
// Build the "system" user info block for internal file operations
system = Allocate(sysZone, lenUserInfo); Zero(system, lenUserInfo)
system>>UserInfo.userName = ExtractSubstring("System")
system>>UserInfo.connName = system>>UserInfo.userName
system>>UserInfo.capabilities.wheel = true
// The following procedures must be called before any attempt to TFSInit.
// Note that VMem won't actually work until we have given it some buffers.
InitVMem()
InitDisks() //must be after InitVMem because it does a LockCell
// InitIFSPart1 (cont'd)
// Open Primary file system
if isb>>ISB.creatingPrimary then
[
let cPar = GetCreateParams(ifsTypePrimary)
if cPar eq 0 then finish
let ec = CreateIFSPart1(cPar)
DestroyCreateParams(cPar)
if ec eq 0 break
Wss(dsp, "*nUnable to create Primary IFS.")
PutTemplate(dsp, " Error code is $D. - See IFS.Errors", ec)
] repeat
// Since OpenIFSPart1 does TFSInit passing the ifsDDMgr, we must
// give VMem a buffer to page the DiskDescriptor with.
// We 'know' that @stackLimit is at a page boundary.
@stackLimit = @stackLimit + 1 lshift logStdPageLength
MakeFree(0, @stackLimit - 1 lshift logStdPageLength, 1 lshift logStdPageLength)
let ec = nil
primaryIFS = OpenIFSPart1("Primary", lv ec)
if primaryIFS eq 0 then [ IFSError(ec); finish ]
// Copy overlays from model 31 to Trident
CopyOverlays(primaryIFS>>IFS.lpdt↑0, cfaIFSRun, lv isb>>ISB.cfaIFSSwap)
// Copy vital files from model 31 to Trident.
CopyDiabloFile("IFS.Errors", true)
CopyDiabloFile("IFS.Syms", false)
// Finished with most of the OS. Junta!
@lvSysZone = savedSysZone
Junta(levBasic, IFSAfterJunta)
]
//----------------------------------------------------------------------------
and CopyDiabloFile(name, vital) be
//----------------------------------------------------------------------------
// Copies a file from the model 31 to IFS logical unit 0.
// Failure to do so is considered a fatal error if "vital" is true.
[
// Open file on Diablo disk
let diablo = OpenFile(name, ksTypeReadOnly, charItem)
if diablo eq 0 then test vital
ifso IFSError(ecDiabloFile, name)
ifnot return
// Open file on Trident disk
let trident = OpenFile(name, ksTypeWriteOnly, charItem,
verLatest, 0, 0, sysZone, 0, primaryIFS>>IFS.lpdt↑0)
if trident eq 0 then test vital
ifso IFSError(ecTridentFile, name)
ifnot [ Closes(diablo); return ]
// Copy file
let buf = Allocate(sysZone, 1024)
until Endofs(diablo) do
WriteBlock(trident, buf, ReadBlock(diablo, buf, 1024))
let pos = vec 1 // supply filePos sink explicitly to avoid OS 17 bug
if (FilePos(diablo, pos) & 1) ne 0 then //back up over garbage byte
SetFilePos(trident, 0, FilePos(trident, pos)-1)
Free(sysZone, buf)
Closes(diablo)
Closes(trident)
]
//----------------------------------------------------------------------------
and InitIFSPart2() be
//----------------------------------------------------------------------------
// This procedure sets up the overlay machinery and gives the virtual memory
// package enough buffers to work with. Most of the OS is gone now.
[
// Make stack end in zero rather than loop or garbage
CallersFrame()!0 = 0
// Make the screen black
let dcb = Allocate(sysZone, 4, false, true); Zero(dcb, lDCB)
dcb>>DCB.background = 1
@displayListHead = dcb
TFSLeaveDisplay = true
// Give most of our stack to vmem and free storage zones.
// Must keep 'lenInitStack' words (more or less) until initialization finished
let base = @stackLimit
@stackLimit = (MyFrame()-lenInitStack) & (-1) lshift logStdPageLength
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
InitOverlays(primaryIFS>>IFS.lpdt↑0, lv isb>>ISB.cfaIFSSwap, buf, bufLen)
Free(sysZone, buf)
InitDisksFinish() //fix up OEPs for TFSFinishProc and disk objects
// ***** Do not queue any user finish procedures before here *****
// This must be the last procedure called by InitIFSPart2
FixupSwappedOut(isb>>ISB.relocTable)
]