1 //  The command interface for the compiler.
  2 //  Last modified on 06/06/74 at 18:25:47 by R F Mabee.
  3 //  Installed on 6180 as Version 3.4, R F Mabee.
  4 //  ACL rings changed to V,V,V and installed as Version 2.8, R F Mabee.
  5 //  First installed as Version 2.7 by R F Mabee.
  6 
  7 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  8 
  9 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 10 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 11 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 12 
 13 get "head"                    //  Declarations for whole BCPL library, because driver uses things not in bcpl_compiler_head.
 14 get "bcpl_compiler_head"      //  Declarations for compiler routines and global cells.
 15 get "bcpl_metering_head"      //  Declarations for compiler metering tools.
 16 
 17 external
 18      $(   BcplCommand = "bcpl_driver$bcpl"
 19           BcplMeters = "bcpl_driver$meters"
 20 
 21           Wdir = "get_wdir_"            //  call get_wdir_ (return dir name)
 22           GetGroupId = "get_group_id_"  //  call get_group_id_ (return userid)
 23           LevelGet = "cu_$level_get"    //  call cu_$level_get (return validation ring number)
 24           Initiate = "hcs_$initiate"    //  call hcs_$initiate (dir name, ent name, ref name, 0, 1, return ptr, return code)
 25           MakeSeg = "hcs_$make_seg"     //  call hcs_$make_seg (dir name, ent name, ref name, mode, return ptr, return code)
 26           AclAddOne = "hcs_$acl_add1"   //  call hcs_$acl_add1 (dir name, ent name, userid, mode, rings, return code)
 27           AclDelete = "hcs_$acl_delete" //  call hcs_$acl_delete (dir name, entry name, acl ptr, count, return code)
 28           UnsnapLinks = "term_$nomakeunknown" // call term_$nomakeunknown (pointer, return code)
 29 
 30           SymbolTable = "bound_bcpl_$symbol_table"          //  Compiler's own symbol table contains time compiler updated.
 31 
 32           BadOpt = "error_table_$badopt"
 33           TranslationFailed = "error_table_$translation_failed"
 34      $)
 35 static
 36      $(   StaticMeterData = 0
 37           StaticMeteringSw = false
 38 
 39           RE = 12
 40           RWA = 11
 41           Zero = 0
 42           One = 1
 43      $)
 44 manifest
 45      $(   Empty = $8707070  $)          //  Used to indicate undefined state of truth value.
 46 
 47 
 48 let BcplCommand () be main
 49      $(   Errcode, ProgramID := 0, "bcpl"
 50   Clp:    MONITOR := Open (Console + Write)
 51           OUTPUT := MONITOR
 52           let StartingTime = GetCpuUsage ()
 53 
 54           if Pl1NumbArgs () = 0 do
 55                     Complain ("Pathname of source file is required as first argument.  Options:*n^a*n^a",
 56                               "General:  list  source  xref  alist  check  uppercase  symbols  map  optimize  quiet",
 57                               "Compiler debug:  time  print_meters  tree  crep  pprep  645  ocode")
 58 
 59 //  Process options.
 60           let Source, Alist = Empty, Empty
 61           and List, Time, DumpTree, MetersPrintSw, Check = false, false, false, false, false
 62           and Followon = true                     //  This is the 6180 version.
 63           Xref, LineMap, Optimize := Empty, Empty, Empty
 64           Crep, PPrep, OcodeSw, QuietSw, Symbols, UpperCase := false, false, false, false, false, false
 65 
 66           let Names = list "list", "xref", "source", "alist", "tree",
 67                               "check", "uppercase", "symbols", "map", "optimize",
 68                               "crep", "pprep", "time", "quiet", "print_meters",
 69                               "645", "ocode"
 70           and Pointers = list lv List, lv Xref, lv Source, lv Alist, lv DumpTree,
 71                               lv Check, lv UpperCase, lv Symbols, lv LineMap, lv Optimize,
 72                               lv Crep, lv PPrep, lv Time, lv QuietSw, lv MetersPrintSw,
 73                               lv Followon, lv OcodeSw
 74           and Flags = table OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable,
 75                               OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable,
 76                               OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable,
 77                               OptNegatable | OptNegate, OptNegatable
 78           ArgIndex := 2                 //  Used by GetNextCommandArg.
 79           OptionParse (GetNextCommandArg, 17, Names, Pointers, Flags, 0)
 80                               //  Apply complicated defaults.
 81           if Xref = Empty do Xref := List
 82           if Source = Empty do Source := List | Xref
 83           if Alist = Empty do Alist := List
 84           Check := Check | Crep
 85           if Optimize = Empty do Optimize := Source & not (Check | Symbols)     //  Guess whether this compilation is final version.
 86           if LineMap = Empty do LineMap := not (Optimize | Check)
 87           LineMap := LineMap | Symbols
 88 
 89           HaveListingFile := (Source | Xref | Alist | DumpTree | OcodeSw | PPrep) & not Crep
 90           Machine := Followon -> 6180, 645
 91           Metering := MetersPrintSw logor StaticMeteringSw
 92           let TimeSummary, TimeTemp = Time | HaveListingFile, nil
 93                               //  Make list of options used.
 94           OptionString := vec 128
 95           SetLength (OptionString, 0)
 96           if Source do AddOption ("source")
 97           if Xref do AddOption ("xref")
 98           if DumpTree do AddOption ("tree")
 99           if Alist do AddOption ("alist")
100           if Check do AddOption ("check")
101           if UpperCase do AddOption ("uppercase")
102           if Symbols do AddOption ("symbols")
103           if LineMap do AddOption ("map")
104           if Optimize do AddOption ("optimize")
105           if PPrep do AddOption ("pprep")
106           if OcodeSw do AddOption ("ocode")
107           AddOption (Followon -> "6180", "645")
108 
109 //  Process file name argument.
110           let Arg = vec 100
111           Pl1ArgString (1, Arg, 100 * 4)
112           let Len = Length (Arg)
113           if Len > 5 do                 //  If the ".bcpl" suffix might already be present.
114                $(   let w = vec 5
115                     Substr (w, Arg, Len - 4, 5)
116                     if EqualString (w, ".bcpl") do SetLength (Arg, Len - 5)
117                $)
118           let Path, Dir, Ent = vec 50, vec 50, vec 10
119           ExpandPathname (Arg, Path)
120           SplitPathname (Path, Dir, Ent)
121           unless Errcode = 0 do Complain (Arg)
122           ProgramName := vec 8
123           MakeBcplString (Ent, 32, ProgramName)
124 
125 //  Set up some more environment things.
126                     //  Temporary kludge to check for stack segment too full to allow for Newvec space.
127           if (ProgramName & Right) ge 45000 do Complain ("Not enough room left in stack to perform compilation. Type 'release'.")
128 
129           let v = vec 10000
130           UtilitiesInit (v, 10000, StartingTime)
131           let v = vec 20
132           SetHandler ("cleanup", Cleanup, v)
133           SetOverflowMask (true)        //  Turn off overflow faults.
134 
135           Errorsw := false
136           NAMECHAIN := 0
137 
138           GetVersion ()                 //  Compiler version info is isolated in small easily changed program.
139 
140                     //  Get date/time compiler was updated (bound) from symbol table of bound segment.
141           CompilerDTM, TimeNow := vec 2, vec 2
142           CompilerDTM!0, CompilerDTM!1 := SymbolTable!6, SymbolTable!7
143           RawClockTime (TimeNow)
144           CompilerDTMString, TimeNowString := MakeTimeString (CompilerDTM), MakeTimeString (TimeNow)
145 
146           UserID := vec 8
147           let v = vec 8
148           call GetGroupId (v char 32)
149           MakeBcplString (v, 32, UserID)
150 
151 //  Open input and output files.
152           test Crep
153           then $(   INPUT := Open (Console + Read)
154                     FilesInfo!0, FilesInfo!1, FilesInfo!2, FilesInfo!3 := "console", 0, 0, 0
155                     FileNames!0 := "console"
156                     LineCount := FileCount lshift FileShift
157                     WriteS (MONITOR, "Type program:*n")
158                $)
159           or   $(   GetStream (Arg, 0)            //  0 indicates no previous input stream for searching.
160                     if HaveListingFile do
161                          $(   let w = vec 50
162                               OUTPUT := Open (EntryName + Write + MultiSegmentFile, Concatenate (w, 32, ProgramName, ".list"))
163                               unless Errcode = 0 do Complain (w)
164                               Format (OUTPUT, "Compilation listing of file ^s.*n", FilesInfo!0)
165                               Format (OUTPUT, "Compilation performed for ^s at ^s.*n", UserID, TimeNowString)
166                               Format (OUTPUT, "Compiled by ^s.  Compiler updated at ^s.*n",
167                                                                                 CompilerVersionString, CompilerDTMString)
168                               Format (OUTPUT, "Options applied:  ^s.*n*n", OptionString)
169                          $)
170                     WriteS (MONITOR, "BCPL*n")
171                $)
172 
173 //  Read source program and construct syntax tree.
174           let UsageTemp = nil
175           if Metering do UsageTemp := SaveOldUsage ()
176           if TimeSummary do TimeTemp := GetCpuUsage ()
177           Listing := Source
178 
179           LexInit ()
180           let A = CAE ()
181           if Crep & A = 0 & not Errorsw finish    //  Escape from type-in mode.
182           if Metering do
183                $(   MeterData!TotalLines_Count := TotalLines
184                     RecordUsage (SyntaxAnalysis_Meter, UsageTemp)
185                $)
186           Close (INPUT)
187           INPUT := 0
188           if TimeSummary do Wrtime ("CAE", GetCpuUsage () - TimeTemp, "source lines", TotalLines, Time)
189 
190 //  Put out optional cross reference and tree listings.
191           if Xref do
192                $(   Writech (OUTPUT, Crep -> '*n', '*f')
193                     WriteS ("cross reference table*n*n")
194                     Pname (NAMECHAIN)
195                $)
196           if DumpTree do
197                $(   Writech (OUTPUT, Crep -> '*n', '*f')
198                     WriteS ("abstract syntax tree*n*n")
199                     Plist (A, 0)
200                $)
201 
202 //  Perform semantic translation on syntax tree, generating machine code and listing.
203           unless Errorsw do
204                $(   Listing := Alist & Check                //  Generate only partial listing during Trans.
205                     if Metering do UsageTemp := SaveOldUsage ()
206                     if TimeSummary do TimeTemp := GetCpuUsage ()
207                     CgInit ()
208                     Trans (A)
209                     if Metering do
210                          $(   MeterData!TextWords_Count := TotalWords
211                               RecordUsage (SemanticTranslation_Meter, UsageTemp)
212                          $)
213                     if TimeSummary do Wrtime ("Trans", GetCpuUsage () - TimeTemp, "object words", TotalWords, Time)
214                     if Alist & not Check do WriteObjectListing ()     //  Generate full listing in separate pass.
215                $)
216           unless OUTPUT = MONITOR do
217                $(   Close (OUTPUT)
218                     OUTPUT := MONITOR
219                $)
220 
221 //  Form object segment out of internally-stored machine code program.
222           unless Check | Errorsw do
223                $(   let x, y = nil, nil
224                     let v = vec 2
225                     if Metering do UsageTemp := SaveOldUsage ()
226                     call Wdir (Dir char 168)
227                     call Initiate (Dir char 168, Ent char 32, "" char 0, lv Zero, lv One, v pointer, lv Errcode)
228                     let P = BCPLaddr (v)
229                     unless Errcode = 0 do
230                               test P = Null
231                               then $(   call MakeSeg (Dir char 168, Ent char 32, "" char 0, lv RE, v pointer, lv Errcode)
232                                         P := BCPLaddr (v)
233                                         if P = Null do Complain ("Unable to create object segment ^a.", ProgramName)
234                                    $)
235                               or call UnsnapLinks (ITS (P, v), lv Errcode)      // Segment in use, unlink it.
236                     let AclArray, Rings = vec 8, vec 3
237                     MakePl1String (UserID, AclArray, 32)
238                     AclArray!8 := 0
239                     call LevelGet (lv x)
240                     Rings!0, Rings!1, Rings!2 := x, x, x
241                     call AclAddOne (Dir char 168, Ent char 32, AclArray char 32, lv RWA, Rings, lv Errcode)
242                     unless Errcode = 0 do Complain ("Unable to change ACL of object segment ^a.", ProgramName)
243                     x := BuildObject (P)
244                     SetBitCount (P, x)
245                     call AclDelete (Dir char 168, Ent char 32, ITS (AclArray, v) pointer, lv One, lv Errcode)
246                     Terminate (P)
247                     if Metering do RecordUsage (MakeObject_Meter, UsageTemp)
248                $)
249 
250 //  Print or save meter values as required.
251           if Metering do
252                $(   RecordUsage (DriverOverhead_Meter, 0)
253                     let Elapsed, Total, Calls = GetCpuUsage () - StartingTime, 0, 0
254                     for i = 0 to MeteringOverhead_Meter - 1 by 3 do
255                               Total, Calls := Total + MeterData!i, Calls + MeterData!(i + 1)
256                     MeterData!MeteringOverhead_Meter := Elapsed - Total
257                     MeterData!(MeteringOverhead_Meter + 1) := Calls
258                     for i = 0 to MeteringOverhead_Meter by 3 unless MeterData!i = 0 do MeterData!(i + 2) := Total
259                     MeterData!DictionaryDepth_Count := DictionaryDepth
260                     if StaticMeteringSw do for i = 0 to Meters_Length do StaticMeterData!i := StaticMeterData!i + MeterData!i
261                     if MetersPrintSw do PrintMeters (MeterData)
262                $)
263 
264 //  Almost done.  Clean up and report success/failure in form suitable for programmed interpretation.
265           Cleanup ()
266           RevertHandler ("cleanup")
267           Close (MONITOR)
268           if Crep goto Clp              //  "C^H_ompile and _^Hr_^He_^Hpeat" - jump back to beginning of driver.
269 
270           if Errorsw do
271                $(   Errcode := rv TranslationFailed
272                     Complain (Arg)
273                $)
274      $)
275 
276 and AddOption (s) be                    //  Append option name to list in OptionString.
277           test Length (OptionString) = 0
278           then CopyString (s, OptionString)
279           or Concatenate (OptionString, 511, OptionString, "  ", s)
280 and Wrtime (ID, Usage, Thing, Nthings, Time) be   //  Report time used, etc. in listing and console streams.
281      $(   let Rate = Nthings * 1000 * 1000 / Usage
282           Usage := Usage / 100 / 1000
283           let a, b = Usage / 10, Usage rem 10
284           if Time do Format (MONITOR, "^s time ^d.^d, ^d ^s per second.*n", ID, a, b, Rate, Thing)
285           if HaveListingFile do Format (OUTPUT, "*n*n*n^s time ^d.^d, ^d ^s per second.*n", ID, a, b, Rate, Thing)
286      $)
287 
288 let BcplMeters () be main               //  Entry to control static metering of compiler.
289      $(   Errcode, ProgramID := 0, "bcpl$meters"
290           if Pl1NumbArgs () = 0 do Complain ("Options are:  print  reset  meter  no_meter")
291 
292           let Print, Reset, Start = false, false, Empty
293           let Names = list "print", "reset", "meter"
294           and Pointers = list lv Print, lv Reset, lv Start
295           and Flags = list OptNegatable, OptNegatable, OptNegatable
296           ArgIndex := 1
297           OptionParse (GetNextCommandArg, 3, Names, Pointers, Flags, 0)
298 
299           if StaticMeterData = 0 do
300                $(   let x = Allocate (Meters_Length + 1)
301                     for i = 0 to Meters_Length do x!i := 0
302                     StaticMeterData := x
303                $)
304           unless Start = Empty do StaticMeteringSw := Start
305           if Print do
306                $(   if StaticMeterData!(MeteringOverhead_Meter + 1) = 0 do Complain ("No metering data available.")
307                     OUTPUT := Open (Console + Write)
308                     PrintMeters (StaticMeterData)
309                     Close (OUTPUT)
310                $)
311           if Reset then for i = 0 to Meters_Length do StaticMeterData!i := 0
312      $)