%externalroutine imp11(%string(63) s)
       %externalstring(6) %fnspec imp11host
      %extrinsicinteger shortjumps
      %extrinsicinteger mediumjumps
      %extrinsicinteger longjumps
      %extrinsicreal stretchtime
  %externalinteger permad
   %extrinsicinteger LIST
      %externalroutinespec timeio(%string(63) file)
   %externalstring(8)%fnspec date
   %externalstring(8)%fnspec time
   %externallongrealfnspec cputime
      %owninteger exclam = 0, info2, info3
   %string(63) source, object, listing, grot, x1, x2
   %integer flag, stats
   %real t0,t1,t2,t3
   %systemintegermapspec comreg(%integer n)   
   %systemroutinespec connect(%string(31) file, %c
   %integer mode,hole,protect,%record(?)%name r, %c
    %integername flag)  
    %recordformat rfm(%integer conad,filetype,datastart,dataend,a,b,c,d)  
     %string(31) ss  
     %record(rfm) r  
   %externalroutinespec define(%string(63) s)
   %externalintegerfnspec exist(%string(255) s)
      %systemroutinespec destroy(%string(255) s,%integername flag)  
   %externalintegerfnspec pass1
   %externalroutinespec pass2
   %externalroutinespec pass3
      %owninteger uselimit=1000, envirs=7, arrayopt=1
      %owninteger noremember=0,nocc=0,noparams=0,nosame=0, nostatic=0
      %routine show date
         %conststring(3)%array month(1:12) = "JAN", "FEB", "MAR", "APR",
                                            "MAY", "JUN", "JUL", "AUG",
                                            "SEP", "OCT", "NOV", "DEC"
         %integer n
         %string(15) dat, day, mon, year
         dat = date
         dat -> day.("/").mon.("/").year
         n = (charno(mon, 1)-'0')*10+charno(mon, 2)-'0'
         printstring(day."-".month(n)."-19".year)
      %end
      %routine try(%integername flag, %string(15) key, %integer value)
         %if grot -> x1.(key).x2 %start
            flag = flag!value
            printstring(key." set");  newline
         %finish
      %end

      info2 = 0;  info3 = 0
      %if s -> s.("!").grot %start
         exclam = 1
         try(info3, "NOSHORT", 1)
         try(info3, "NOROUND", 2)
         try(info3, "NODEFER", 4)
         try(info3, "NOENTRY", 8)
         uselimit = charno(x2, 1)-'0' %if grot -> x1.("USE=").x2
         envirs   = charno(x2, 1)-'0' %if grot -> x1.("ENVIR=").x2
         try(noremember, "NOREMEMBER", 1)
         array opt = 0
         try(array opt, "NOARRAY", 1)
         array opt = array opt!!1
         try(nocc, "NOCC", 1)
         try(nosame, "NOSAME", 1)
         try(noparams, "NOPARAMS", 1)
         try(nostatic, "NOSTATIC", 1)
      %finish
   object = "";  listing = ""
   source = s
   %if s -> source.("/").s %or s -> source.(",").s %start
      object = s %unless s -> object.(",").listing
   %finish
   s = source %unless source -> s.("#").grot
   object = s."#REL" %if object = ""
   listing = ".NULL" %if listing = "" %or listing = ".N"

   s = source
   %if exist(s) = 0 %start
      s = s."#IMP"
      %if exist(s) = 0 %start
         printstring(source." does not exist")
         newline
         %return
      %finish
   %finish
   source = s
         ss=source  
      l1: connect(ss,0,0,0,r,flag)  
         %if flag#0 %start  
            printstring(" 
CANNOT CONNECT ".ss."
")  
            %return  
         %finish  
         %if r_filetype#3 %start  
            printstring("
".ss." IS NOT A CHARACTER FILE
")  
      %return  
         %finish  
      %if ss=source %then comreg(46)=r_conad %andc
      ss=imp11host.".IMP11PRIMS" %and ->l1  
       permad=r_conad
   define("ST4,".listing)
      LIST = 10000 %if listing = ".NULL"
      %if LIST <= 1 %start
         select output(4)
         printstring("Source file: ".source)
         printstring("       Compiled: ")
         show date
         spaces(2)
         printstring(time)
         newline
         printstring("Object file: ".object)
         newlines(2)
      %finish
   t1 = cputime
   stats=pass1
   t1 = cputime-t1
   selectoutput(0)
   %if stats > 0 %start
      write(stats, 4)
      printstring(" statements compiled");  newline
      ->avoid %if object =".NULL"
      selectinput(0)
      close stream(1)
      close stream(4)
p2:
      define("ST2,SS#IMP77O")
      define("ST3,SS#IMP77D")
      define("ST4,.OUT")
      t2 = cputime
      pass2
      t2 = cputime-t2
      selectoutput(0)
          close stream(2);  close stream(3)
      define("ST1,SS#IMP77O")
      define("ST2,SS#IMP77D")
      define("ST3,".object)
      t3 = cputime
      pass3
      t3 = cputime-t3
      avoid:
   %finish %else %start
      printstring("Program contains");  write(-stats, 1)
      printstring(" fault")
      printsymbol('s') %unless stats = -1
   %finish
   newline
      select input(0);  selectoutput(0)
      close stream(1);  closestream(2);  closestream(3);  closestream(4)
      ->closef %if exclam=0 %or stats<0
      write(shortjumps, 1);  printstring(" short,")
      write(mediumjumps, 1);  printstring(" medium, and")
      write(longjumps, 1);  printstring(" long jumps")
      newline
      print(stretch time, 2,4);  printstring(" seconds in STRETCH")
      newline
      %return %if t1 <= 0 %or t2 <= 0 %or t3 <= 0
      t0 = t1+t2+t3
      printstring("Pass1 time =");  print(t1, 2,4);  printstring(" sec")
      newline
      printstring("Pass2 time =");  print(t2, 2,4);  printstring(" sec")
      newline
      printstring("Pass3 time =");  print(t3, 2,4);  printstring(" sec")
      newline
      printstring("Total time =");  print(t1+t2+t3, 2,4);  printstring(" sec")
      newline
      stats = stats*60
      write(int(stats/t1), 1)
      printstring(" &")
      write(int(stats/t2), 1)
      printstring(" &")
      write(int(stats/t3), 1)
      printstring(": ")
      write(int(stats/t0), 1)
      printstring(" statements per minute")
      newline
      timeio(source)
      timeio("IMP#INT")
      timeio("SS#IMP77O")
      timeio("SS#IMP77D")
      timeio(object)
closef:
            %unless comreg(27)&(1<<18)#0 %start  
               destroy("SS#IMP77O",flag)  
               destroy("SS#IMP77D",flag)  
               destroy("IMP#INT",flag)  
            %finish  
%end
%endoffile