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