[eris]<Lisp>Harmony>uCode>OLDUCODEFILES.DM!1>MainInit.bcpl

// MainInit.bcpl. Bulk of the initialization code.
// 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
InitializeZone; Zero; Usc; Max; Min; CharWidth; SetFilePos
Allocate; Wss; Endofs; Gets; OpenFile; ShowDisplayStream; PositionPage
MyFrame; CallSwat; SysErr

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

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

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

// SUBR base, some init code base
uCodeCheck; InitFmap

// initialization only
GetRamVersion; SetupLispMem; KBDinit; RemoteInitVmem; LocalInitVmem

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

// statics used
@SubrBase; @lvNIL; @lvKT; @lvVPtr; @VPtr0; SubrArgsVector
@Bcpl; @ContextQ; LogPagingFlag
@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
sysFontCharWidth// width of a char, for Raid
dontGiveUp = false// if true, call swat instead of
// quitting on startup errors
ScreenWords// these 3 from InitLispRegs
RamVersion
MinLispForRam
HostMagic0
HostMagic1
HostMagic2
VmemStream = 0// nonzero while an OS vmem stream is open
SysinName = 0// for error msgs
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
extraBuffers
extraBufLength// for Lisp’s use
ebCreationDate = 0
]

manifest [
NILNum = #0// atom # for NIL
TNum = #114// atom # for T
SubrArgsPtr = #210// addr where ucode puts args
MaxSubrArgs = 12// maximum nargs for any subr
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 = 10*WordsPerPage // how much buffer to give to Lisp
EbCreationDateStart = 4// i.e. third word of file
LispVersionStart = #200// bytepos in eb file of version #s
]

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 = false
dsp = 0// turn off any display
AllocPtr = StartOfAllocBlock
AllocEnd = AllocVec
AllocInFirstBlock = true// do some initial alloc in fixed
// block reserved by loader

// Initialize new keyboard driver. Done quickly so typeahead is not lost
KBDinit()

// We will need space for the single disk stream that can be open at
// once (either stats or initialization) plus some extra space for other
// diverse allocations. Here we create a SysZone of approx. the right size.

// This could later be merged into the PupZone by InitSystem
[
let szl=2*(lKS+WordsPerPage)+WordsPerPage// stream+buffer*2 plus 1 page
sysZone = InitializeZone(AllocVec(szl),szl)// for us
@lvSysZone = sysZone// for Os
]

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

let RamV, MinBcplForRam, 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

// Set up ucoce/bcpl communication area in locations #200-#277
@StatsPtr = 0// no stats initially
@#206 = #2000 % lv Bcpl// = JMP @Bcpl
@#207 = #77400// CallSwat in case #206 gets clobbered

// Subr argument passing structures. SubrArgsPtr = #210
SubrArgsVector = AllocVec(MaxSubrArgs)// Bcpl args vector
for i = 0 to MaxSubrArgs-1 do SubrArgsVector!i=SubrArgsPtr+2*i

// Binding various atom pointers which go back to Lisp.
// The atom numbers of T and NIL used to come from the IPage, now constants
lvNIL = MakeAtomPtr(NILNum)
lvKT = MakeAtomPtr(TNum)

// Bind various statics
lvVPtr = lv VPtr0
SubrBase = lv uCodeCheck// First SUBR

// Set up context structures for Pup package
ContextQ=AllocVec(2); ContextQ!0=0// Allocate and empty ContextQ

// Open the sysfont file, get the file length and allocate space for the font
[ let s = CreateDiskStream(fpSysFont, ksTypeReadOnly, wordItem)
let sl = (FileLength(s) + 1) rshift 1// in words
if Usc(AllocPtr+sl, AllocEnd) gr 0
then [// SysFont too big
Closes(s)// close it
let s = OpenFile ("Gacha10.al", ksTypeReadOnly, wordItem)
// try for a common smaller font
if s eq 0
then GiveUp ("Sorry, your SysFont.al is too big*N// ",
"Couldn’t find {DSK}Gacha10.al (an acceptable alternative)")
let sl = (FileLength(s) + 1) rshift 1// Gacha size
]
let fontblk = AllocVec(sl)// space for sysFont
Resets(s)
ReadBlock(s, fontblk, sl)
Closes(s)
// The sysFont static is set to the third word of the font, which is
// what is wanted by the character display routines.
sysFont=fontblk+2
sysFontCharWidth = CharWidth (sysFont, $A)// for Raid
]

// Read command line - decides whether sysin or resume

let foo = vec lFileName
SysinName = foo
SysinName!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

[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 $P: case $p: LogPagingFlag = true; endcase
case $F: case $f: fillMemory = true; endcase
case $Z: case $z: makeZone = true; endcase
case $R: case $r: callRaid = 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 RemoteP = false
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
if SysinName!0
then [ let i = 1
[ let ch = nil
ch = SysinName>>String.char↑i
if ch eq ${ % ch eq $[// if remote name, don’t lookup now]
then [ namev!1 = 0; RemoteP = true; break ]
if ch ne $*S
then break
i = i+1 ] repeatuntil i gr SysinName>>String.length
]
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
RamVersion = RamV
]
ifnot [// get versions from uCode file before loading
let s = CreateDiskStream(lispUcodeFp, ksTypeReadOnly, wordItem)
unless s do GiveUp("Can’t open microcode file ", LispUcodeName)
// see StampVersions.bcpl
ebCreationDate = AllocVec(2)
SetFilePos(s, 0, EbCreationDateStart)
ebCreationDate!0 = Gets(s)
ebCreationDate!1 = Gets(s)
SetFilePos(s, 0, LispVersionStart)
RamVersion = Gets(s)
MinBcplForRam = Gets(s)
MinLispForRam = Gets(s)
Closes(s)
]

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")

test RemoteP
ifso [ RemoteInitVmem (SysinName, VMEMid)
SYSINid = -1
]
ifnot [ if SYSINid
then [// SYSIN from disk
@StackEnd = RemoteInitVmem// flush useless code
LocalInitVmem (SYSINid, VMEMid)
]
]
@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 MinBcplForRam
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(#10000, length-#10000)
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
]