[eris]<Lisp>Harmony>BCPL>BCPLENV.DM!1>MainInit.bcpl

// MainInit.bcpl. Bulk of the initialization code.
// Last change September 27, 1981 10:56 PM by Bill van Melle
// Last change September 5, 1981 12:39 PM by Bill van Melle
// Allegro change August 2, 1981 6:01 PM by Beau Sheil
// Last change July 20, 1981 6:59 PM by Beau Sheil
// Last change May 12, 1981 1:34 AM by Beau Sheil
// Last change March 26, 1981 12:20 AM by Beau Sheil
// Tone change March 17, 1981 5:35 PM by Beau Sheil

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

external [// defined here
AllocVec; MainInit; ShortStack; SavedUFP; SavedSCP

// O.S. procedures
Resets; Closes; MoveBlock; ReadBlock; CreateDiskStream; FileLength
InitializeZone; MyFrame; CallSwat; SysErr; Zero; Usc; Max

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

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

// utilities
MachineType; Version; LispFinish; LispSwatContext

// SUBR base
uCodeCheck

// initialization only
AllocPtr; AllocEnd; AllocInFirstBlock; StartOfAllocBlock
GetRamVersion; SetupLispMem; KBDinit; RemoteInitVmem

// statics used
@SubrBase; @lvNIL; @lvKT; @lvVPtr; @VPtr0; SubrArgsVector
@Bcpl; @ContextQ; LogPagingFlag
@dspStartAddr; @dspArea; @dlispDsp; @DLispDCB
EmulatorSpace; @MoveWordsBBT; @MoveWordsBBTAddr
LispStackLength
PupZoneLength
LispStackStart
PupZoneStart
]

static [
AllocPtr// set in InitLisp
AllocEnd// end of fixed alloc region
AllocInFirstBlock// true when in fixed block
SavedUFP; SavedSCP// used to save OS procs
]

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
]

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
[
dsp = 0// turn off any display
unless Version()<<Vers.emulType eq 4// Lisp emul = 4
do CallSwat("No Lisp microcode!")

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
]

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

// Rebind OS procedures for errors, swat and exit. Restored at finish
SavedUFP = @lvUserFinishProc
@lvUserFinishProc = LispFinish
SavedSCP = @lvSwatContextProc
@lvSwatContextProc = LispSwatContext
@lvSysErr = SysErr// Not the OS SysErr

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

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

// Read command line - decides whether sysin or resume
let SysinName = vec lFileName
SysinName!0 = 0// empty until one is specified

[
let COMstream = CreateDiskStream(fpComCm, ksTypeReadOnly, charItem)
let param, SW = vec lFileName, vec 10
SetupReadParam(param, SW, COMstream)// get switches
for i = 1 to @SW do
switchon SW!i into
[ case $I: case $i: SysinName = "LISP.SYSOUT."; endcase
case $P: case $p: LogPagingFlag = true; endcase
]

// check for parameters in the command line
[ let P = ReadParam(0,-1)
if (P eq -1) then break// No more switches
switchon (@SW ge 1? SW!1, 0) into
[ case $I: case $i: case 0: // SYSIN file
MoveBlock(SysinName, EvalParam(param,$P), lFileName)
endcase
case $N: case $n:// set UserName
P = param!0
unless P gr (((UserName!-1) lshift 1) - 1) do
for i = 1 to P do UserName>>String.char↑i = param!i
UserName>>String.length = P
endcase
default: break// unrecognized switch; so exit
]// End of switch on switches
] repeat// Loop back for another switch
Closes(COMstream)// close and discard COMstream
]

[// look up the lisp system files
let VMEMid, SYSINid = nil, nil
let RemoteP = false
let dev = vec 2*lDV// lDV = len dir entry
let SysDir = CreateDiskStream(fpSysDir, ksTypeReadWrite, wordItem)
let namev = vec 2
namev!0 = "LISP.VIRTUALMEM."
namev!1 = SysinName!0 ? SysinName, 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, 2, true)
VMEMid = dev+1// +1 turns dir entries into fileptrs
// dont create vmem file - it should exist (contiguously!) already
unless @dev do CallSwat("Cant find ", namev!0)
dev = dev+lDV// move on to sysin file
SYSINid = @dev ? dev+1,// ok if found; else better not ask
namev!1 ? CallSwat("Cant find SYSIN file", namev!1), 0
Closes(SysDir)

// we now know what kind of sysin, if any, to do
if RemoteP
then [ RemoteInitVmem (SysinName, VMEMid)
SYSINid = -1
]
@StackEnd = RemoteInitVmem// free up some space
AllocInFirstBlock = false
AllocPtr=AllocVec// next alloc will be overlaid on init code
LispStackStart=AllocVec(DefaultLispStackLength)// space for lisp stack
LispStackLength = DefaultLispStackLength
PupZoneLength=Max(MinPupZoneLength, @StackEnd-AllocPtr)
PupZoneStart=AllocVec(PupZoneLength)

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

SetupLispMem(SYSINid, VMEMid)// Inits VMem
]

// MoveWords BBT tables. This code knows way too much about XBBTs
MoveWordsBBT = AllocVec(20, 2); Zero(MoveWordsBBT, 20)
MoveWordsBBT!0 = #100000; MoveWordsBBT!3 = #10000// fn; width
MoveWordsBBT!7 = #1; MoveWordsBBT!9 = #10000// height; width
MoveWordsBBTAddr = AllocVec(2, 2)
MoveWordsBBTAddr!0 = EmulatorSpace; MoveWordsBBTAddr!1 = MoveWordsBBT

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

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

]