! General compiler driver
!!  COMPILE  lang|compilation parms  in/out

!!%option "NoStack,NoDecode"
%include "Sysinc:command.inc"

{Include file for compiler communication}
%recordformat impcomfm(%integer statements, flags, code, gla, diags, perm,
                        %string(31) file,
                        %string(63) Option)
%externalrecord(impcomfm) IMPCOM

%externalintegerfnspec OUT TYPE
%externalpredicatespec EXISTS(%string(63) file)
%externalroutinespec   DELETE FILE(%string(63) file)
%externalroutinespec   DOING(%string(15) S)
%Systemroutinespec   SRUN(%string(63) what)
%externalroutinespec   TO LOWER(%string(*)%name s)
%externalroutinespec To Upper(%string(*)%name s)
%externalroutinespec   CPU LIMIT(%integer n)
%externalroutinespec   OPTION(%string(63) P)

%externalroutine COMPILE %alias "%go"
   %conststring(15) pass2       = "imp:PASS2",
                    pass3       = "imp:PASS3"
   %string(31) prim,
               language,
               pass1,
               default ext
   %string(63) Param = Command_parameter
   %integer j, return code, lines
   %string(31) source file, object  file, listing file, source
   %string(31) temp1 = "", temp2 = "", temp3 = ""
   %string(31) work
   %integer options

   ! used for accumulating timing data
   %integer  x1, x2, x3

%integerfn  option bits(%string(63)  opt)
   %integer  initial
   %integer  include, exclude, item , item no, p, no
   %string(15)  item word
   %constinteger  options = 14
   %conststring(8)%array  option word(1:options) =
      "default",      "opt",  "trusted",
   !    512+31       256+0      32
      "capacity",  "assign",    "array",  "extra",
   !      1           2         4        16
      "suppress", "partial", "diags",  "timer",
   !     128         256       512     x'4000'
      "brief",      "trace",  "hide"
   ! x'1000',         64
   %constshortintegerarray  option mask(1:options) =
      X'821F',   X'8100',   X'8020',
            1,         2,         4,       16,
          128,       256,       512,  x'4000',
      x'1000',        64,    x'0900'

   %integerfn  known item
      %integer  n,sym
      %string(15)  s, t

      item word = ""
      opt -> item word.(",").opt
      no = 0
      %if item word -> s.("no").t %start
         %if s = "" %then item word = t %and no = 2
      %finish
      %for n = 1,1,options %cycle
         %result=n %if item word = option word(n)
      %repeat
      %result = 0
   %end {of known item}

   initial = option mask(1)&x'7FFF';      ! default
   include = 0;  exclude = 0
   to lower(opt)
   opt = opt.","
   %while opt # "" %cycle
      item no = known item
      %if item no # 0 %start
         item = option mask(item no)
         %if item < 0 %start;      ! reset completely
            initial = item & x'7FFF'
         %else
            %if no # 0 %start
               exclude = exclude ! item
            %else
               include = include ! item
            %finish
         %finish
      %else %if item word # ""
         print string(item word); print symbol('?')
         newline
      %finish
   %repeat
   %result = (initial & (\exclude)) ! include
%end;      ! 'option bits'

   %routine close in(%integer st)
      select input(st);  close input
   %end
   %routine close out(%integer st)
      select output(st);  close output
   %end
   %string(31)%fn temp file
      %string(1) work
      %record(parmfm) p
      p_dact = 25;  svc(20, p)
      p_p4 = p_p4&x'FFFF'
      %if p_p4 > 26 %then work = tostring(p_p4-27+'0') %c
                    %else work = tostring(p_p4+'a'-1)
      %result = "$tmp.".work
   %end
   %routine print pass(%integer pass, time)
      %if pass = 0 %start
         print string("mean ")
      %else
         print string("pass");  write(pass,-1)
      %finish
      write( (2*time+1)//2000,5);  print string(" secs")
      write(60*1000*lines//time,5);  print string(" statements/min")
      newline
   %end
   %routine show result(%integer n)
      %if n < 0 %start
         printstring("Program contains")
         write(-n, 1)
         printstring(" fault")
         printsymbol('s') %if n # -1
      %else
         write(n, -4)
         printstring(" statements compiled")
      %finish
      newline
   %end
   %routine Fail(%string(63) Why)
      Printstring(Language." fails -- " . Why . snl)
      %stop
   %end

   %on 9,10,11 %start
      Select Output(0)
      Fail(EVENT_Message)
   %finish

   To upper(param)
   %unless param -> language.("|").param %start
      printstring("Which language?");  newline
      %return
   %finish
   %if Language = "IMP" %start
      pass1 = "IMP:Pass1"
      prim = "IMP:Prims"
      Default ext = ".imp"
   %else %if Language = "PASCAL"
      pass1 = "PASCAL:Pass1"
      prim = "PASCAL:Prims"
      Default ext = ".pas"
   %else %if Language = "FORTRAN"
      pass1 = "FORTRAN:Pass1"
      prim = ""
      Default ext = ".ftn"
   %else
      printstring(language." not available");  newline
      %return
   %finish
   parse parameter(command,0,param)          {%signal 11,10 on failure}

! ******** set compiler options *********
   options = option bits(command_parameter)

   source file = command_in1
   listing file = command_out1
   object file = command_out2
   to lower(source file)
   to lower(object file)
   to lower(listing file)

   IMPCOM_option = "";            ! %OPTION string

   %if source file -> source.(".").work %start      {extension given}
      %unless exists(source file) %start
Noex:    Fail(Source file." does not exist")
      %finish
   %else
      source = source file                          {no extension}
      %unless exists(source) %start
         work = source file.default ext
         ->noex %unless exists(work)
         source file = work
      %finish
   %finish
   %if source -> work.(":").source %start;  %finish
   %if object file = "" %start
      object file = source.".exe"
   %else %unless object file -> (".")
      object file = object file.".exe" %unless object file = "n:"
   %finish
   %if object file = "n:" %or object file = "null:" %start
      temp1 = "n:"
   %else
      temp1 = temp file
   %finish
   cpu limit(60*10)      {10 minutes}
   x1 = cpu time
   %if Source file = Listing File %start
      Printstring("Overwrite source file with listing?")
      Newline
      %return
   %finish

   open input(1, source file)
   open input(2, prim) %unless prim = ""
   open output(2, listing file)
   open output(1, temp1)
   open output(3, "t:")

   select output(2)
   options = options!x'1000' %if out type = 0     {null:}
   options = options!x'2000' %if out type < 0    {t:} 
   IMPCOM_flags = options
   printstring("Source file: ");  printstring(source file)
   printstring("     compiled on ")
   printstring(date);  printstring(" at ");  printstring(time)
   newline
   printstring("Object file: ");  printstring(object file);  newlines(2)
   doing("First pass")
   Srun(pass1)
   lines = impcom_statements
   select output(2);  show result(lines)
   select output(0)
   close in(1);  close in(2)
   close out(1);  close out(2);  close out(3)
   ->done1 %if lines < 0


   ->done %if temp1 = "n:"
   x2 = cpu time

   open input(1, temp1)
   temp2 = temp file;  open output(1, temp2)
   temp3 = temp file;  open output(2, temp3)
   doing("Second pass")
   cpu limit(60*5)      {5 minutes}
   Srun(pass2)

   close in(1)
   close out(1);  close out(2)

   x3 = cpu time

   open input(1, temp2);  open input(2, temp3)
   impcom_file = object file;      ! pass 3 opens its own DA file
   doing("Final pass")
   cpu limit(60*4)         {4 minutes}
   Srun(pass3)
   %if IMPCOM_Option # "" %start
      option("[".IMPCOM_Option."]".Object file)
   %finish

done:selectoutput(0)
      %if command_modifier # 0 %start
         printstring("Code");  write(impcom_code, 1)
         printstring(" + Perm");  write(impcom_perm, 1)
         printstring(" + Glap");  write(impcom_gla, 1)
         printstring(" + Diags");  write(impcom_diags, 1)
         printstring(" =")
         write(impcom_code+impcom_perm+impcom_gla+impcom_diags, 1)
         printstring(" bytes")
         newline
      %finish
     %if options & x'4000' # 0 %start
        x1 = x2-x1;  x2 = x3-x2;  x3 = cputime - x3
        print pass(1,x1); print pass(2,x2); print pass(3,x3)
        print pass(0,x1+x2+x3)
     %finish
stop:    delete file(temp2);  delete file(temp3)
done1:   delete file(temp1)
         select output(0)
         show result(lines)
         doing("")
%end
%endoffile