// BCPL0.bcpl - BCPL Main program
// Copyright Xerox Corporation 1980
// Swinehart, 9 May 77, always type dest file report line
// Swinehart, 6 May 77, file lengths -> statics
// Called from In..CPL<SWINEHART>BCPL0.;3 4-APR-75 07:29:49 EDIT BY SWINEHART
// pull SWAltoc...ime <SWINEHART>BCPL0.;2 28-MAR-75 13:18:15 EDIT BY SWINEHART
// last modified by Butterfield, May 9, 1979 2:18 PM
// - SWUnsignedCompares, O (Oz) global switch, unsigned compares - 5/8
// - SWStackStrings, I (IFS) global switch, strings and tables on stack - 5/4
// - Main, allow multiple source files - 5/3
// - SWNoExtExts, Main, -E global switch, allow EXTERNAL & EXTERNAL - 2/12
// - SWGetLINEs, Main, add -G global switch, don'T "LINE" get files - 2/2
// - WriteLines, use Usc to extend its range - 2/2/79
get "bcplx"
get "bcpliox"
//external streamvec
static [
//streamvec = 0
Version =nil
filename =nil
sw =nil
SourceName =nil
BinName =nil
OutputName =nil
SourceDevice =nil
Device =nil
///*DCS* Precompiled Declarations
DECLName = nil ///* Compiled decl. lexemes file
DICTName = nil ///* Compiled dictionary file
BCPLname =nil
LEXname =nil
CAEname =nil
SAEname =nil
TRNname =nil
NCGname =nil
FreeMax =nil
DictFreeLimit =nil
TreeFreeLimit =nil
CodeFreeLimit =nil
FreelistP =nil
Reportcount =nil
Istream =nil
Ostream =nil
TTIstream =nil
TTOstream =nil
OutputStream =nil
ErrorStream =nil
SourceStream =nil
SourceLength =nil
LexStream =nil
Dictionary =nil
DictStream =nil
DictLength =nil
///*DCS*2 Symbol Table Compaction NCG Pass
RealSymCount =0
RealSymSize =0
Tree =nil
TreeOffset =nil
OcodeStream =nil
CodeStream =nil
Code =nil
///*DCS* next 4 used to be manifest
FileNameLength=nil
GetFileMax =nil
GetnameT =nil
GetlineT =nil
GetnameV =nil
GetnameP =nil
GetlineV =nil
GetlineP =nil
Curfile =nil
Curline =nil
myFrame =nil
]
static [
SWHelp =false
SWDebug =false
SWList =false
SWLexTrace =false
SWCaeTrace =false
SWSaeTrace =false
SWOcode =false
SWCode =false
SWLexList =false
SWCaeList =false
SWSaeList =false
SWTrnList =false
SWPassOneList =false
SWPassTwoList =false
SWPassOneCode =false
SWPassTwoCode =false
SWListCode =false
SWWait =true
SWUpperCase =false
SWLowerCase =false
SWOneCase =false
SWTTOfile =false
SWTTOtype =false
SWOutput =false
SWAlto = nil // initted in INITBCPL
SWNoxios =false
///*DCS* Precompiled Declarations
SWPrepare = false ///* Global /G -- compile declarations
SWUseDecl = false ///* Local /G -- use precompiled declarations
///*DCS* Precompiled Declarations
SWParamset = false ///* Local /V or /M -- command line manifests
// /S (global) or n/S (local): Issue call on fast getframe, return
SWFastFrame = false
SWGetLINEs = true // Global /-G, don't "LINE" get files, sets this false
SWNoExtExts = true // Global /-E, allow EXTERNAL & EXTERNAL, sets this false
SWStackStrings = false //if true, put string and tables on stack
SWUnsignedCompares = false //if true, enable uls, ule, uge, and ugt
]
//----------------------------------------------------------------------------
let Main(paramvec) be
//----------------------------------------------------------------------------
[
// Called from InitBCPL in system-dependent
// file (BCPLDOS, BCPLALTO, BCPLRDOS...)
let fNL = FileNameLength/Bytesperword+1
GetnameT = GetFileMax*GetnameN-1
GetlineT = 2*GetFileMax*GetlineN-1 // gets us coming and going
let vecLen, Vec = (15+GetFileMax)*fNL+GetnameT+GetlineT+40, vecLen
Dvec(Main,lv Vec); for i = 0 to vecLen do Vec!i = 0
InitFree(FreeMax)
BCPLname = Vec
LEXname = BCPLname + fNL
CAEname = LEXname + fNL
SAEname = CAEname + fNL
TRNname = SAEname + fNL
NCGname = TRNname + fNL
filename = NCGname + fNL // needs FileNameLength+11
sw = filename+FileNameLength+11 // needs 27
ReadCOMCM()
FixFileName(BCPLname, "", 0)
FixFileName(LEXname, ".YL", 0)
FixFileName(CAEname, ".YC", 0)
FixFileName(SAEname, ".YS", 0)
FixFileName(TRNname, ".YT", 0)
FixFileName(NCGname, ".YG", 0)
for i = 1 to sw!0 switchon sw!i into
[
case $D: SWDebug = true; loop
case $H: SWHelp, SWDebug = true, true; loop
case $F: if SWTTOtype do BadSwitch(i); SWTTOfile = true; loop
case $T: if SWTTOfile do BadSwitch(i); SWTTOtype = true; loop
case $A: SWOutput, SWListCode = true, true; loop
case $W: SWWait = true; loop
case $P: SWWait = false; loop
case $S: if SWAlto then SWFastFrame = #74400; loop
case $U: SWUpperCase, SWOneCase = true, true; loop
// case $X: SWAlto = true; loop
// case $N: SWNoxios = true; loop
case $G: SWPrepare = true; loop
case -$G: SWGetLINEs = false; loop
case -$E: SWNoExtExts = false; loop
case $I: SWStackStrings = true; loop
case $O: SWUnsignedCompares = true; loop
default: BadSwitch(i)
]
SourceName = sw+27
BinName = SourceName+fNL
OutputName = BinName+fNL
SourceDevice = OutputName+fNL
Device = SourceDevice+fNL
DECLName = Device+fNL
DICTName = DECLName+fNL // DICTName needs fNL
myFrame = MyFrame()
let moreSources = ReadCOMCM() lshift 8;
let reads = 0
[
if filename!0 eq -1 then [ moreSources = 0; break ]
test sw!0 eq 0
ifso
[
test SourceName!0 eq 0
ifso FixFileName(SourceName, "", Device)
ifnot
[
if reads ne 1 % not SWAlto then
Error("Two source file names")
CloseCOMCM(); break;
]
if BinName!0 eq 0 then FixFileName(BinName, ".BR", Device)
if OutputName!0 eq 0 then FixFileName(OutputName, ".BT", Device)
if SWPrepare then
[
FixFileName(DECLName, ".BL", Device)
FixFileName(DICTName, ".BD", Device)
]
]
ifnot for i = 1 to sw!0 switchon sw!i into
[
case $A: SWOutput, SWListCode = true, true
case $F: if SWTTOtype do BadSwitch(i)
if sw!i eq $F do SWTTOfile = true
FixFileName(OutputName, ".BT", Device)
loop
case $R: FixFileName(BinName, ".BR", Device)
loop
case $C: test SourceName!0 eq 0
then FixFileName(SourceName, "", Device)
or Error("TWO SOURCE FILE NAMES")
loop
case $G:
if SWPrepare then Error("/G Both Global and Local")
SWUseDecl = true;
FixFileName(DECLName, ".BL", Device)
FixFileName(DICTName, ".BD", Device)
loop
///*DCS* command line manifests -- see enterparams() in LEX
///* number/V sets manifest value -- default is 0
///* name/M does "manifest name = current-number"
///*5-9-77 number/S sets getframe call value to number (octal)
///* entry of names must be delayed until enterparams in LEX
case $V:
case $M:
case $S:
SWParamset = true ///* Will reread COM.CM in LEX
loop
case $L:
case $T:
[
SWOutput = true
unless i eq 1 & sw!0 le 2 do BadSwitch(i)
let L, T = sw!1 eq $L, sw!(sw!0) eq $T
for j = 1 to filename!0 do switchon filename!j into
[
case $L: SWLexList, SWLexTrace = L, T; loop
case $C: SWCaeList, SWCaeTrace = L, T; loop
case $S: SWSaeList, SWSaeTrace = L, T; loop
case $T: SWTrnList, SWOcode = L, T; loop
case $1: SWPassOneList, SWPassOneCode = L, T; loop
case $2: SWPassTwoList, SWPassTwoCode = L, T; loop
default: BadSwitch(i)
]
i = sw!0
loop
]
default: BadSwitch(i)
]
moreSources = (moreSources & #177400) + ReadCOMCM(); reads = reads + 1;
] repeat
if SourceName!0 eq 0 do Error("No source file name")
if SourceDevice!0 eq 0 do Movestring(SourceName, SourceDevice)
if BinName!0 eq 0 do Error("No binary file name")
test SWTTOfile % (SWOutput & not SWTTOtype)
ifso
[
if OutputName!0 eq 0 then Error("No output file name")
OutputStream = OpenOutput(OutputName)
]
ifnot [ OutputStream = TTOstream; OutputName!0 = 0 ]
test SWTTOfile
ifso ErrorStream = OutputStream
ifnot ErrorStream = TTOstream
Ostream = TTOstream
///*DCS* Modifications to clean up, add printing for SWPrepare
for i=0 to (OutputStream eq TTOstream? 0, 1) do
[
WriteS(BCPLname); WW($*s)
WriteN(Version rshift 8); WW($.); WriteN(Version & #377);
WriteS(" -- ")
test SWPrepare
ifso [ WriteS(DECLName); WriteS(" , "); WriteS(DICTName) ]
ifnot
[
if OutputName!0 ne 0 do [ WriteS(OutputName); WriteS(" , ") ]
WriteS(BinName);
]
WriteS(" = "); WriteS(SourceName); WW($*n)
Ostream = OutputStream
]
GetnameV = DICTName+fNL; GetnameP = 0
let nv = GetnameV+GetnameT+1
for i = 0 to GetnameT by GetnameN do [ GetnameV!i = nv; nv = nv + fNL ]
GetlineV = nv; GetlineP = 0
// This Here's The Compiler
InitFree(DictFreeLimit)
Overlay(LEXname, DictFreeLimit+1)
if SWHelp do Help("LEX START")
SWList = SWLexList
ReadSource()
if SWHelp do Help("LEX END")
///*DCS* Precompiled Declarations
if SWPrepare then goto Abort
InitFree(TreeFreeLimit)
Overlay(CAEname, TreeFreeLimit+1)
if SWHelp do Help("CAE START")
SWList = SWCaeList
ConstructTree()
if SWHelp do Help("CAE END")
unless Reportcount eq 0 goto Abort
Overlay(SAEname, TreeFreeLimit+1)
if SWHelp do Help("SAE START")
SWList = SWSaeList
DeclareNames()
if SWHelp do Help("SAE END")
Overlay(TRNname, TreeFreeLimit+1)
if SWHelp do Help("TRN START")
SWList = SWTrnList
TranslateTree()
if SWHelp do Help("TRN END")
unless Reportcount eq 0 goto Abort
InitFree(CodeFreeLimit)
CodeStream = OpenOutput(BinName)
Overlay(NCGname, CodeFreeLimit+1)
if SWHelp do Help("NCG START")
if SWListCode do SWPassTwoList, SWPassTwoCode = true, true
GenerateCode()
if SWHelp do Help("NCG END")
Abort:
GotoLabel(myFrame, localAbort)
localAbort:
test Reportcount eq 0
ifnot
[
Ostream = TTOstream
WriteN(Reportcount)
WriteS(" ERROR"); unless Reportcount eq 1 do WW($S)
WriteS(" IN "); WriteS(SourceName)
WW($*n)
unless OutputName!0 eq 0 do CloseOutput(OutputStream, OutputName)
]
ifso
[
unless SWPrepare do CloseOutput(CodeStream, BinName)
Ostream = ErrorStream
for i=0 to (OutputStream eq ErrorStream? 0, 1) do test SWPrepare
ifso [ WriteS(" finished*n") ]
ifnot
[
WW($*n); WriteS(BinName); WriteS(" -- "); WriteO(PC); WW($*s);
WW($(); WriteN(PC); WW($)); WriteS(" WORDS*n")
Ostream = OutputStream
]
unless OutputName!0 eq 0 do
CloseOutput(OutputStream, OutputName)
]
if moreSources eq 0 then finish;
CloseInput(SourceStream);
RestartBCPL(moreSources rshift 8, moreSources & #377);
]
//----------------------------------------------------------------------------
and BCPLreport(n, Message) be
//----------------------------------------------------------------------------
[
Ostream = n ge 0 ? ErrorStream, TTOstream
if n ls 0 do [ SWDebug = true ]
WriteS("ERROR ")
Reportcount = Reportcount + 1
let f = lv n - 6
if SWDebug % Message eq 0 do
[ WriteN(n)
]
test SWDebug
ifnot WriteS(": ")
ifso
[ WriteS(" FROM ")
let p = f!0 - (SWNoxios? 0, #200)
WriteO(p!1)
WriteS(" IN ")
let q = p!0 - (SWNoxios? 0, #200)
WriteO(q!2 - 2)
WriteS(" , FRAME AT ")
WriteO(q)
WW($*n)
]
if Message ne 0 do WriteS(Message)
WW($*n)
if Reportcount gr MaxErrors do
[ Ostream = TTOstream
WriteS("TOO MANY ERRORS*n")
goto Abort
]
]
and WriteLine(line) = WriteLines(line, 0, 1)
and WriteLines(line, lineoffset, linecount) = valof
[
static [ Prevfile = -1; Prevline = -1 ]
let ch = nil
let i = 0
while Usc(line, GetlineV!i) gr 0 do
[ if i eq GetlineP do [ line = GetlineV!i; break ]
i = i + GetlineN
]
let file = GetlineV!(i+1)
unless file eq Curfile do
[ CloseInput(SourceStream, GetnameV!Curfile)
Curfile = file
SourceStream = OpenInput(GetnameV!Curfile)
]
line = line - (GetlineV!i - GetlineV!(i+2))
if line le 0 do line = 0
Reposition(SourceStream, line)
unless lineoffset eq 0 do
test lineoffset ls 0
then [ line = Back1(line)
lineoffset = lineoffset+1
] repeatuntil lineoffset eq 0
or if lineoffset gr 0 do
[ line = Forward1(line)
lineoffset = lineoffset-1
] repeatuntil lineoffset eq 0
if Prevline eq line & Prevfile eq file resultis false
Prevline, Prevfile = line, file
Reposition(SourceStream, line)
for i = 1 to linecount do
[ [ Readch(SourceStream, lv ch)
] repeatwhile ch eq $*n
WW(ch)
[ Readch(SourceStream, lv ch)
if ch eq #777 break
WW(ch)
] repeatuntil ch eq $*n
]
resultis true
]
and Back1(line) = valof
[
let ch = nil
[ line = line - 1
if line le 0 resultis 0
Reposition(SourceStream, line)
Readch(SourceStream, lv ch)
] repeatwhile ch eq $*n
[ line = line - 1
if line le 0 resultis 0
Reposition(SourceStream, line)
Readch(SourceStream, lv ch)
] repeatuntil ch eq $*n
resultis line + 1
]
and Forward1(line) = valof
[
let ch = nil
Reposition(SourceStream, line)
[ Readch(SourceStream, lv ch)
line = line + 1
] repeatwhile ch eq $*n
[ Readch(SourceStream, lv ch)
line = line + 1
] repeatuntil ch eq $*n % ch eq #777
[ Readch(SourceStream, lv ch)
line = line + 1
] repeatwhile ch eq $*n
resultis line
]