[eris]<Lisp>JCAI>BASICS>LispBcplFiles.dm!1>MainInit.bcpl

// MainInit.bcpl. Bulk of the initialization code.
// Last change May 22, 1984 2:52 PM by Bill van Melle
// Last change July 20, 1983 2:23 PM by Bill van Melle
// Last change May 25, 1983 11:22 AM by Bill van Melle
// Last change March 24, 1983 9:06 PM by Bill van Melle
// Last change December 21, 1982 5:18 PM by Bill van Melle
// reorganized dsk init June 8, 1982 9:57 PM by Bill van Melle
// Last change May 24, 1982 12:14 PM by Bill van Melle
// InitLispRegs change May 19, 1982 10:23 PM by Bill van Melle
// command parse change March 19, 1982 1:05 PM by Bill van Melle
// Last change March 18, 1982 1:42 PM by Bill van Melle

get "AltoFileSys.d"
get "AltoDefs.d"
get "LispBcpl.decl"
get "Stats.decl"
get "Streams.d"

external [// defined here
AllocVec; MainInit; ShortStack; SavedUFP; SavedSCP; GiveUp
SwapCursors; RestoreCursor

// O.S. procedures
Resets; Closes; MoveBlock; ReadBlock; CreateDiskStream; FileLength
Zero; Usc; Max; Min; CharWidth; SetFilePos
Allocate; Wss; Endofs; Gets; OpenFile; OpenFileFromFp; PositionPage
MyFrame; CallSwat; SysErr
CreateDisplayStream; ShowDisplayStream

// OS statics
dsp; sysZone; fpSysDir; fpComCm; sysDisk; fpRemCm
UserName; lvSysErr; lvUserFinishProc

// other library procedures
LookupEntries; SetupReadParam; ReadParam; EvalParam

// LIsp procedures
MachineType; Version; LispFinishProc; InitLispRegs
Serial; IPutBase; LoadRam; LISPFINISH

// one init code base
InitFmap

// initialization only
SetupLispMem
RemoteInitVmem; LocalInitVmem; RemoteDskInitVmem
ParseHostField; MiscLispInit; ReadUCodeVersions

// statics exported
AllocPtr; AllocEnd; AllocInFirstBlock; lastStaticAllocation
statsFP
ScreenWords; callRaid
RamVersion; MinLispForRam; MinBcplForRam
HostMagic0; HostMagic1; HostMagic2
VmemStream; SysinName; SysinHostName
fillMemory; haveUcode; altoUcodeFp; uCodeLoaded; bigMemTable
extraBuffers; extraBufLength

// statics used
@dspStartAddr; @dspArea; @dlispDsp; @DLispDCB
EmulatorSpace
LispStackLength; StartOfAllocBlock
PupZoneLength
LispStackStart
PupZoneStart
]

static [
AllocPtr// set in InitLisp
AllocEnd// end of fixed alloc region
AllocInFirstBlock// true when in fixed block
lastStaticAllocation// last AllocPtr in fixed region
SavedUFP = -1
SavedSCP = -1// used to save OS procs
statsFP = 0// FP for Lisp.stats
dontGiveUp = false// if true, call swat instead of
// quitting on startup errors
ScreenWords// these 3 from InitLispRegs
RamVersion
MinLispForRam
MinBcplForRam
HostMagic0
HostMagic1
HostMagic2
VmemStream = 0// nonzero while an OS vmem stream is open
SysinName = 0// for error msgs
SysinHostName = 0
fillMemory = false// T -> fill up memory completely
haveUcode = false// true if started with Lisp microcode
uCodeLoaded = false// true after ucode loaded
altoUcodeFp = 0// maybe the Fp for AltoD0Mc.eb
callRaid = false// if true, call Raid on startup
bigMemTable = false// if true, stick Bpt in high memory
extraBuffers
extraBufLength// for Lisp’s use
]

manifest [
lEDCB = 6// extended DCB length
lFileName = 80// file name length in words
MinPupZoneLength = 8000// space for pup zone
DefaultLispStackLength = 2400// ~10 pages for bcpl/lisp stack
extraBufWanted = 16*WordsPerPage // how much buffer to give to Lisp
ExtraZoneSize = 2*WordsPerPage// how much to allocate on /Z
lenDSPBlock = lDCB*2 + (380*3)/2// for temp dsp
]

structure Vers:
[// Microcode Version word
machType bit 4// machine type
emulType bit 4// emulators supported
blank byte
]

structure String: [ length byte; char↑1,255 byte ]

// The address of AllocVec is used as the base of the initialization code in
// InitLisp (which allocates run time storage starting here). Do not move
// within the file or change order of file load without being careful.

let AllocVec(n, align; numargs nargs) = valof

// AllocPtr is initialized to the first address that can be used to allocate
// permanent data structures (AllocVec). The first two allocations (the
// Pup zone and the Bcpl/Lisp run time stack) are made over the top of the
// initialization code and are not written into until the initialization is
// complete.

[
// If align is specified, the allocation is align word aligned, for align a power of 2.
if nargs eq 2 then [ let mask=align-1
AllocPtr=(AllocPtr+mask) & (not mask)
]
let addr=AllocPtr// Save existing pointer for result
AllocPtr=AllocPtr+n// Move to after this allocation
test AllocInFirstBlock
ifso if Usc(AllocPtr, AllocEnd) gr 0
then CallSwat ("Not enough initial allocation space")
ifnot if Usc (AllocPtr, @StackEnd) gr 0
then @StackEnd=AllocPtr// Reset end of stack to after allocation
resultis addr
]

and MainInit(EventualEndOfStack) be
[
let makeZone = MachineType() eq Dolphin
dsp = 0// turn off any display
AllocPtr = StartOfAllocBlock
AllocEnd = AllocVec
AllocInFirstBlock = true// do some initial alloc in fixed
// block reserved by loader

let RamV, MBFR, MLFR, sw, pnum, ppm, host0, host1, host2
= 0, nil, nil, nil, nil, nil, 0, 0, 0// adjacent for InitLispRegs

let origCursor = vec 16
SwapCursors (origCursor, table[
#177777; #100001; #40002; #25544;
#17770; #7760; #3740; #1700;
#1100; #2440; #4220; #10610;
#21704; #47742; #177777; #177777 ])
// set hour-glass cursor
MiscLispInit()

// don’t do this until sysZone exists
if Version()<<Vers.emulType eq 4// Lisp emul = 4
then haveUcode = true// usually only true when ucode debugging

// Read command line - decides whether sysin or resume

let foo = vec lFileName
SysinName = foo
SysinName!0 = 0// empty until one is specified
let hostName = vec lFileName
hostName!0, hostName!1 = 0, 0// empty until one is specified
let statsName = vec lFileName
statsName!0 = 0// empty until one is specified
let LispUcodeName = vec lFileName
test haveUcode
ifso LispUcodeName!0 = 0// don’t need to load microcode
ifnot test MachineType() eq Dolphin
ifso MoveBlock(LispUcodeName, "DolphinLispMc.eb", 9)
ifnot MoveBlock(LispUcodeName, "DoradoLispMc.eb", 8)
let lispUcodeFp = 0
let AltoUcodeName = vec lFileName
MoveBlock(AltoUcodeName, (MachineType() eq Dolphin? "AltoD0Mc.eb", "AltoD1Mc.eb"), 6)
let askedForAlto = false
let quitEarly = false

[ComParse
let body = vec lFileName
let COMstream = CreateDiskStream(fpComCm, ksTypeReadOnly, charItem)
let switch, bodylen, bodywords = 0, 0, 0
let firstNameFound = 0
[// begin loop
let ch = Endofs(COMstream)? $*N, Gets(COMstream)
switchon ch into
[
case $*S: case $*N:// end of token
if firstNameFound eq 0
then endcase
if bodylen
then [
body>>String.length = bodylen
bodywords = (bodylen rshift 1) + 1
]
switchon switch into
[
case 0: case -1:// no switch
if bodylen eq 0
then endcase// else fall thru for default /I
case $I: case $i:// sysin name
test bodylen
ifso MoveBlock(SysinName, body, bodywords)
ifnot MoveBlock(SysinName, "Lisp.sysout", 6)
endcase
case $N: case $n:// set UserName
unless bodywords gr UserName!-1
do MoveBlock(UserName, body, bodywords)
endcase
case $S: case $s:// open stats file
test bodylen
ifso MoveBlock(statsName, body, bodywords)
ifnot MoveBlock(statsName, "Lisp.stats", 6)
endcase
case $M: case $m:// load microcode file
test bodylen
ifso MoveBlock(LispUcodeName, body, bodywords)
ifnot test MachineType() eq Dolphin
ifso MoveBlock(LispUcodeName, "DolphinLispMc.eb", 9)
ifnot MoveBlock(LispUcodeName, "DoradoLispMc.eb", 8)
haveUcode = false// ignore loaded ucode
endcase
case $A: case $a:// specify alto ucode file
test (bodylen ne 0) &
((bodylen gr 1) % body>>String.char↑1 ne $-)
ifso [// -/A means none
MoveBlock(AltoUcodeName, body, bodywords)
askedForAlto = true
]
ifnot AltoUcodeName!0 = 0
endcase
case $F: case $f: fillMemory = true; endcase
case $Z: case $z: makeZone = true; endcase
case $R: case $r: callRaid = true; endcase
case $Q: case $q: quitEarly = true; endcase
case $B: case $b: bigMemTable = true; endcase
]
if Endofs(COMstream) then break
bodylen = 0
switch = 0
firstNameFound = -1
endcase
case $/:// maybe a switch
if switch eq 0
then [ switch = -1// signal a switch start
endcase ]
// else fall thru
default:// part of a body or switch
test switch eq -1
ifso switch = ch// set one-char switch
ifnot[// fill in body
if firstNameFound ge 0
then [ firstNameFound = 1
endcase // ignore lisp.run
]
if switch
then [// multi-char switch parsed as body
bodylen = bodylen+2
body>>String.char↑(bodylen-1) = $/
body>>String.char↑bodylen = switch
switch = 0
]
bodylen = bodylen+1
body>>String.char↑bodylen = ch
]
]
] repeat// end until

Closes(COMstream)// close and discard COMstream
]ComParse

[// look up the lisp system files
let VMEMid, SYSINid = 0, 0
let dev = vec 5*lDV// lDV = len dir entry
let SysDir = CreateDiskStream(fpSysDir, ksTypeReadWrite, wordItem)
let namev = vec 5
namev!0 = "LISP.VIRTUALMEM."
namev!1 = SysinName!0 ? SysinName, 0
namev!2 = statsName!0 ? statsName, 0
namev!3 = LispUcodeName!0 ? LispUcodeName, 0
namev!4 = AltoUcodeName!0 ? AltoUcodeName, 0

let RemoteP = ParseHostField(namev, hostName)

LookupEntries(SysDir, namev, dev, 5, true)
// +1 turns dir entries into fileptrs
// dont create vmem file - it should exist (contiguously!) already
for i = 0 to 4
do [
test @dev
ifso [ switchon i into
[
case 0: VMEMid = dev+1; endcase
case 1: SYSINid = dev+1; endcase
case 2: statsFP = Allocate(sysZone, lFP)
MoveBlock (statsFP, dev+1, lFP)
endcase
case 3: lispUcodeFp = dev+1; endcase
case 4: altoUcodeFp = Allocate(sysZone, lFP)
MoveBlock (altoUcodeFp, dev+1, lFP)
endcase
]
]
ifnot if (namev!i ne 0) & ((i ne 4) % askedForAlto)
then GiveUp ("Cant find ", namev!i)
dev = dev+lDV// move on to next file
]
Closes(SysDir)

// we now know what kind of sysin, if any, to do
test haveUcode// get versions for Ipage checking if possible
ifso [
InitLispRegs(lv RamV)// fills in 9 words
MinLispForRam = MLFR
MinBcplForRam = MBFR
RamVersion = RamV
]
ifnot [// get versions from uCode file before loading
unless ReadUCodeVersions(lispUcodeFp)
do GiveUp("Can’t open microcode file ", LispUcodeName)
]

unless RamVersion ge MinRamForBcpl
do GiveUp("Microcode too old for this lisp.run")
unless BcplVersion ge MinBcplForRam
do GiveUp("Lisp.run too old for this microcode")

if SysinName!0
then [// there is a sysin to do
// create a temporary dsp to communicate
let temp = vec lenDSPBlock
dsp = CreateDisplayStream (2, temp, lenDSPBlock)
ShowDisplayStream (dsp, DSalone)
if SysinHostName
then SYSINid = -1// to flag that /I was done
VmemStream = OpenFileFromFp(VMEMid)
unless VmemStream do GiveUp("Can’t open Lisp.virtualmem")
test RemoteP
ifso [// SYSIN from net
@StackEnd = MiscLispInit// flush useless code
RemoteInitVmem ()
]
ifnot[// SYSIN from disk
@StackEnd = RemoteInitVmem// flush useless code
test SysinHostName
ifso RemoteDskInitVmem()
ifnot LocalInitVmem (OpenFile(0, ksTypeReadOnly, 0, 0, SYSINid))
]
ShowDisplayStream (dsp, DSdelete)// flush dsp
dsp = 0
]
if quitEarly then finish
@StackEnd = LocalInitVmem// free up some space
AllocInFirstBlock = false
lastStaticAllocation = AllocPtr
AllocPtr = AllocVec// next alloc will be overlaid on init code

// We allocate at least MinPupZoneLength words for the Pup zone, but we
// make sure that it extends at least to the end of the initialization code.
// This is because the pup zone is not touched during main initialization,
// whereas subsequent allocations are. The Pup initialization code hides
// under the LispStack allocation (after Maininit) so it doesn’t zorch itself.
// Hence, LispStack must be long enough to cover the Pup init code.

LispStackLength = Max(DefaultLispStackLength, InitFmap-AllocPtr)
LispStackStart=AllocVec(LispStackLength)// space for lisp stack
PupZoneLength=Max(MinPupZoneLength, @StackEnd-AllocPtr)
PupZoneStart=AllocVec(PupZoneLength)

if lispUcodeFp
then [
let s = CreateDiskStream(lispUcodeFp, ksTypeReadOnly, wordItem)
unless s do GiveUp("Can’t open microcode file ", LispUcodeName)
let sl = (FileLength(s) + 1) rshift 1 - WordsPerPage
// length of LoadRam buffer we need
let buffer = (@StackEnd + WordsPerPage-1) & not (WordsPerPage-1)
let newend = ShortStack(1000)
if newend - buffer ls sl
then CallSwat("Microcode file too large")
let oldend = @StackEnd
@StackEnd = newend// get lots of space for buffer
PositionPage(s, 2)
ReadBlock(s, buffer, sl)
Closes(s)
LoadRam((MachineType() eq Dolphin? buffer-1, buffer), 1)
@StackEnd = oldend
haveUcode = true
InitLispRegs(lv RamV)// fills in 9 words
unless RamV ge MinRamForBcpl// Check BEFORE using other ILR values
do GiveUp("Microcode too old for this lisp.run")
unless BcplVersion ge MBFR
do GiveUp("Lisp.run too old for this microcode")
MinLispForRam = MLFR
RamVersion = RamV
]
uCodeLoaded = true

// Rebind OS procedures for errors, swat and exit. Restored at finish
SavedUFP = @lvUserFinishProc
@lvUserFinishProc = LispFinishProc
// SavedSCP = @lvSwatContextProc
// @lvSwatContextProc = LispSwatContext

ScreenWords = sw// copy InitLispRegs values into statics for others
HostMagic0 = host0
HostMagic1 = host1
HostMagic2 = host2

extraBufLength = ((AllocPtr+WordsPerPage) & (not (WordsPerPage-1))) -
AllocPtr + extraBufWanted
extraBuffers = AllocVec(extraBufLength)

SetupLispMem(SYSINid, VMEMid, pnum, ppm)// Inits VMem
]

// Allocate the display, but do not open the TTY stream yet
dlispDsp = AllocVec(2)// lisp display

// dlispDsp is a fake. All it has are pointers to a single display block
// which is manipulated from Lisp. We allocate that now.
DLispDCB = AllocVec(lEDCB, 2)// single dcb; 2word aligned
Zero(DLispDCB, lEDCB)// must be empty
dlispDsp>>DS.fdcb = DLispDCB
dlispDsp>>DS.ldcb = DLispDCB

test makeZone & (Serial() ls #377)
ifso [// allocate an mds zone even so
let length = EventualEndOfStack-AllocPtr// what’s left
length = (length ls #10000) ? 0, Min(ExtraZoneSize, length-ExtraZoneSize)
IPutBase(IFPMDSZone, length? AllocVec(length), 0)
IPutBase(IFPMDSZoneLength, length)
]
ifnot [
IPutBase(IFPMDSZone, 0)
IPutBase(IFPMDSZoneLength, 0)
]

// Now set the display start address. We will eventually give all of
// memory from this point on to the display bitmap.
dspStartAddr = AllocVec(0, WordsPerPage)// page align display
dspArea = EventualEndOfStack - dspStartAddr
unless dspArea ge WordsPerPage then CallSwat("No space for dsp")

@lvSysErr = SysErr// Not the OS SysErr

RestoreCursor (origCursor)

// The display will be given whatever space remains between the end of the
// last AllocVec (rounded up to a page boundary) and the bottom of the stack
// frame for InitSystem (plus a small amount needed for it to start the rest
// of the system). The latter quantity is EventualEndOfStack. We do this so
// the (substantial) stack frame for MainInit can be reclaimed.
// Display is actually turned on in InitLisp after we exit

SysinName = 0// dynamic var will disappear
]