// BLDRINIT.BCPL
// Copyright Xerox Corporation 1979
// Taft, February 22, 1980 2:02 PM, /D global switch, rearranged init
// Swinehart, June 20, 1977 8:35 PM
get "BLDR.DECL"
let BeforeJuntaInit(blv) be
[
savedUserFinishProc = @lvUserFinishProc
@lvUserFinishProc = BldrFinishProc
relPairList = blv!#37
if malFormedRoutine eq -1 then malFormedRoutine = SysErr
let freeEnd = MyFrame() - 1500
freeBegin = @stackLim
@stackLim = freeEnd
test freeEnd - freeBegin < 0
ifnot sysZone = InitializeZone(freeBegin, freeEnd-freeBegin,SysErr,malFormedRoutine)
ifso [
sysZone = InitializeZone(freeEnd-32767, 32767,SysErr,malFormedRoutine)
freeEnd =freeEnd - 32767
if freeEnd - freeBegin > 100 then
AddToZone(sysZone, freeBegin, freeEnd - freeBegin)
]
@lvSysZone = sysZone
@424B = 300; @425B = 150 // tweak mouse position
DisplayInCursor(0)
ParseGlobalSwitches()
Junta((noDisplaySw? levDirectory, levDisplay), Main)
]
and AfterJuntaInit() be
[
@lvSysZone = sysZone
let freeEnd = MyFrame() - 1500 // additional space gained by Junta
let freeBegin = @stackLim
@stackLim = freeEnd
AddToZone(sysZone, freeBegin, freeEnd - freeBegin)
dsp = lv Noop - offset ST.puts/16 // Noop display stream
unless noDisplaySw do
[
let font = OpenFile("SysFont.al", ksTypeReadOnly, wordItem, 0, fpSysFont)
unless font do CallSwat("Can't open SysFont.al")
let lenFont = (FileLength(font)+1)/2
sysFont = Allocate(sysZone, lenFont)
Resets(font); ReadBlock(font, sysFont, lenFont); Closes(font)
sysFont = sysFont+2
// lineWords = lDCB+38*2*((sysFont!-2+1)/2)+1
dsp = CreateDisplayStream(5, Allocate(sysZone, 1500), 1500, sysFont)
ShowDisplayStream(dsp,DSalone)
]
ParseCommands() // all initialization
]
and ParseGlobalSwitches() be
[
TSTREAM = dsp; LSTREAM = TSTREAM
// Global switches
NAME = Zmem(FILENAMELENGTH+1)
SW = Zmem(32)
LFILENAME = Zmem(FILENAMELENGTH/2+1)
MAPSW = true
WARNINGSW = true
OSBKSW = true
SetupReadParam(NAME, SW)
EvalParam(NAME,$P,0,LFILENAME) // Save loader name
for I = 1 to SW!0 switchon CAPITALIZE(SW!I) into
[ case $M: MAPSW = false; loop
case $U: CASESW = true; loop
case $N: LISTNUMSW = true; loop
case $L: LISTLABSW = true; loop
case $V: LISTVARSW = true; loop
case $T: TTYPESW = true; loop
case $F: TFILESW = true; loop
case $W: WARNINGSW = false; loop
case $R: DUPSW = true; loop
case $I: INITSWAPSW = 1; loop
case $B: BBINSAVESW = true; loop
case $K: OSBKSW = false; loop
case $D: noDisplaySw = true; loop
case $$: DEBUGSW = true ;loop
default: BADSWITCH(I)
]
LISTSW = not TTYPESW&(LISTNUMSW%LISTLABSW%LISTVARSW)
]
and ParseCommands() be
[
TSTREAM = dsp; LSTREAM = TSTREAM
PutTemplate(dsp,"*N*N$S $O.$O -- ",LFILENAME,VERSION rshift 8, VERSIONŹ)
// global local switches
SYMMAX = ISYMMAX; CODEMAX = ICODEMAX
COMMONSTART, COMMONMAX = -1, -1
STATICSTART, STATICMAX = -1, -1
CODESTART = -1
fileNameVec = Zmem(ALLFILEMAX)
eventList = Zmem(2)
DICT = Zmem(DICTHEADLENGTH)
let MOREGLOBALS = true
while MOREGLOBALS do
[GLOB
// unpacked to NAME, switches to SW, quit on null
if ReadParam(0, -1) eq -1 %
NAME!0 eq 0 then ERROR("No .BR name")
let oV = nil
if BETWEEN(NAME!1,$0,$7+1) then oV = EvalParam(NAME,$B,-1)
test SW!0 eq 0 then MOREGLOBALS = false
or for I = 1 to SW!0 switchon CAPITALIZE(SW!I) into
[ case $S: SFILENUM = FormFileName($S)
if MAPSW & MFILENUM eq -1 do
MFILENUM = FormFileName($M)
if (TFILESW % LISTSW) & TFILENUM eq -1 do
TFILENUM = FormFileName($T)
loop
case $M: MFILENUM = FormFileName($M); loop
case $F: TFILESW = true
TFILENUM = FormFileName($T); loop
case $V: STATICSTART = oV; loop
case $W: STATICMAX = oV; loop
case $Z: COMMONSTART = oV; loop
case $N: SYMMAX = oV; loop
case $C: CODEMAX = oV; loop
case $O: CODESTART= oV; loop
default: test I eq 1 then [ MOREGLOBALS = false; break ]
or BADSWITCH(I)
]
]GLOB
// file names and local switches
let MOREFILES = true
while MOREFILES do
[FILES
NEWRFILE = 0
test SW!0 eq 0 then NEWRFILE = $R
or for I = 1 to SW!0 do
[
let sw = CAPITALIZE(SW!I)
switchon sw into
[
case $A: case $B:
unless SFILENUM ge 0 do ERROR("No .RUN file name")
FormFileName(sw); loop
case $R: case $I: case $H: case $J: case $K: NEWRFILE = sw; loop
case $X: case $Y: case $Q: case $P: ParsePC(sw); loop
default: BADSWITCH(I)
]
]
if NEWRFILE eq $R & SFILENUM eq -1 then
[
SFILENUM = FormFileName($S)
if MAPSW & MFILENUM eq -1 do MFILENUM = FormFileName($M)
if (TFILESW%LISTSW) & TFILENUM eq -1 then
TFILENUM = FormFileName($T)
]
if NEWRFILE then FormFileName(NEWRFILE)
if ReadParam(0,-1) eq -1 then MOREFILES = false
]FILES
Closes(ReadParamStream)
if OSBKSW then // look up SYS.BK unless inhibited
[ let t = table [ 3; $S; $Y; $S]; MoveBlock(NAME, t, 4); FormFileName($K) ]
// Prepare to load
if TFILESW do TTYPESW = false
MHEAD = Zmem(MHEADLENGTH)
BHEAD = Zmem(BHEADLENGTH)
RHEAD = Zmem(RHEADLENGTH)
ZCODE = Zmem(#400) // IN THEORY, ONLY 400 ARE USED
LABLIST = Zmem(SYMMAX*2+1)
SYMLIST = Zmem(SYMMAX+1)
SYMTAB = Zmem(SYMMAX+1)
CODE = Zmem(CODEMAX)
PARAMLIST = Zmem(#40, -1)
startOverlayFa = Zmem(lFA)
staticLinksFa = Zmem(lFA)
unless SFILENUM ge 0 do ERROR("No .RUN file name")
SFILENAME = fileNameVec!SFILENUM
OPENBLDRFILES()
]
and ParsePC(sw) be
[
let letterVbl = CAPITALIZE(NAME!1)
let nameLen, lN = NAME!0, lPCsave
unless nameLen eq 1 & BETWEEN(letterVbl, $A, $Z+1) do
test sw eq $P ifnot BADSWITCH(1)
ifso [
test letterVbl eq $$ then
[ nameLen = nameLen-1; NAME!0 = nameLen;
MoveBlock(lv NAME!1, lv NAME!2, nameLen) ]
or letterVbl = 0
lN = lPCmod
]
let event = Zmem(lN)
Enqueue(eventList, event)
event>>PCsave.cmd = sw
event>>PCsave.letterVbl = letterVbl
if lN eq lPCmod then event>>PCmod.newValue = EvalParam(NAME,$B,-1)
]
and FormFileName(code, regardless; numargs na) = valof
[
if na < 2 then regardless = false
// select extension
let ext = selecton code into
[
case $S: ".RUN"
case $A: case $B: ".BB"
case $R: case $I: ".BR"
case $H: case $J: ".BJ"
case $K: ".BK"
case $M: ".SYMS"
case $T: ".BS"
case $X: ".XC"
]
let dict = FixFileName(NAME, ext, regardless)
// enter file name in dictionary
fileCount = fileCount+1
fileNameVec ! fileCount = lv dict>>DIct.name
// create event entries for principal files
let append, useCode = true, BFILECODE
switchon code into
[
case $R: case $H to $K: useCode = RFILECODE; docase $A
case $S: append = false // (docase $A)
case $A: case $B:
[
let event = Zmem(lFile)
test append then Enqueue(eventList,event)
or InsertAfter(eventList,eventList,event)
event>>RFile.cmd = code
event>>RFile.useCode = useCode
event>>RFile.fileNum = fileCount
]
default: endcase
]
// produce ".XC" name matching ".RUN"
let res = fileCount
if code eq $S then FormFileName($X, true)
resultis res
]
and FixFileName(uName, ext, cmd) = valof
[
// cmd = 0: pack uName to new string, append ext unless uName contains a $.
// cmd = 1: pack to new string, replace extension by supplied one regardless
let lN = uName!0
cmd = valof
[ for i = 1 to lN do if uName!i eq $. then
[ if cmd then lN = i-1; resultis cmd ]; resultis 1 ]
uName!0 = lN
let lExt = ext>>STRING.length
let name = vec FILENAMELENGTH/2+1
EvalParam(NAME,$P,-1,name)
if cmd then for i = 1 to lExt do
[ lN = lN+1; name>>STRING.char↑lN = ext>>STRING.char↑i ]
name>>STRING.length = lN
if (lN&1) eq 0 then name>>STRING.char↑(lN+1) = 0
resultis DICTENTRY(name)
]
and OPENBLDRFILES() be
[
PREAMBLEVEC = Zmem(lDV*(fileCount+1))
let sysDir = OpenFileFromFp(fpSysDir)
LookupEntries(sysDir, fileNameVec+1, PREAMBLEVEC+lDV, fileCount, true)
for i = 1 to fileCount do
[
let preamble = PREAMOF(i)
let fileName = fileNameVec!i
if @preamble loop // found and not duplicated
let j = valof
[ for j = 0 to i-1 do if fileNameVec!j eq fileName resultis j;
resultis 0 ]
if j eq 0 loop
MoveBlock(preamble, PREAMOF(j),lDV)
@preamble = -1 // mark duplicated
]
]