#if ~(d!e)
  #report One of d or e must be set
#fi
#if (d&e)
  #report Only one of d or e may be set
#fi
#if x
#report Debugging code added
#fi
#if d
!DEIMOS declerations
%systemroutinespec exit(%integer fault)
%externalstring(255)%mapspec cli param
%conststring(8) date="00/00/00"
%conststring(8) time="00:00:00"
#fi
#if e
  #report Preparing EMAS version of PREP
#else
  #report Preparing DEIMOS version of PREP
#fi
#if e
!Emas declerations
%externalstringfnspec date
%externalstringfnspec time
%externalroutinespec set return code(%integer code)
%externalroutinespec define(%string (255) s)
%externalroutinespec destroy(%string (255) s)
%externalintegerfnspec exist(%string (255) s)
%systemintegerfnspec iocp(%integer ep, parm)
#fi

%ownstring (255) expression
%ownstring (255) initstr
%owninteger expindex,expchar,errflag,line no,hash present
%ownbyteintegerarray vars(0:25)=0(26)
%owninteger cleanflag;   !non zero => don't print unwanted code
#if e
%constinteger report=0,input=10,output=11
#fi
#if d
%constinteger report=0,input=1,output=1
#fi


%integerfn to lc(%integer i)
!---------------------------
!
!Convert UC character to lower case

 %if 'A'<=i<='Z' %then %result=i+'a'-'A' %else %result=i

%end
%string(255)%fn subs(%integer i,%string(255)%name s)
!---------------------------------------------------
!
!Returns substring of s starting at position i
%integer n
%string(255) x

   x=""
   %result="" %if length(s)<i
   %for n=i,1,length(s) %cycle
     x=x.tostring(charno(s,n))
   %repeat
   %result=x
%end

%integerfn starts(%string (255) %name s, %string (255) ss)
!-------------------------------------------
!return 1 if s starts with ss
%integer i,l
   %result=0 %if length(s)<2
   l=1
   l=l+1 %while charno(s,l)=' '%and l+length(ss)<=length(s)
   l=l-1
 
   %if length(ss)+l>length(s) %then %result=0
   %for i=1,1,length(ss) %cycle
      %if to lc(charno(s,i+l))#charno(ss,i) %then %result=0
   %repeat
   %result=length(ss)+l+1
%end

%routine getline(%string (255) %name s,%integer skipping)
!--------------------------------------
%string(255) mess
%integer a
#if ~e
%integer c
x: s=""
   readsymbol(c)
   %while c#nl %cycle
      s=s.to string(c)
      readsymbol(c)
   %repeat
#else
x: s=string(iocp(6,0))
   %if length(s)>0 %then length(s)=length(s)-1
#fi
   line no = line no + 1
   %return %if skipping=0
   ! code to speed up prep
   hash present = 0
   %if s # "" %start
       %cycle a = 1, 1, length(s)
          %if charno(s, a) = '#' %then hash present = 1 %and %exit
       %repeat
   %finish
   %return %if hash present = 0;    ! no '#' in line


#if d
   %if starts(s,"#datestring")#0 %or starts(s,"#timestring")#0 %start
      select output(report)
      printstring("Date/Time can not be set correctly from DEIMOS version")
      newline
      select output(output)
   %finish
#fi
   %if starts(s,"#datestring")#0 %then s="%conststring (8) datestring=""".date.""""
   %if starts(s,"#timestring")#0 %then s="%conststring (8) timestring=""".time.""""
   %if starts(s,"#options")#0 %start
      s = "! Options used:".initstr
   %finish
   %if starts(s,"#report")#0 %start
      mess=subs(starts(s,"#report"),s)
      select output(report)
      printstring(mess)
      newline
      select output(output)
      -> x
  %finish
  %if starts(s,"#abort")#0 %then %signal 1
%end

%routine error
!-------------
   %if errflag=1 %then %return
   expchar=-1;   !force termination of expression
   selectoutput(0)
   printstring("line");  write(line no,4)
   printstring("error in :-".expression)
   newline
   selectoutput(11)
   errflag=1
%end

%routine getchar
!---------------
   %cycle
      %if expindex>=length(expression) %then expchar=-1 %and %return
      expindex=expindex+1
      expchar=charno(expression,expindex)
   %repeatuntil expchar#' '
   %if 'a'<=expchar<='z' %then expchar=expchar-'a'+'A'
%end

%integerfnspec operand

%integerfn evaluate
!------------------
%integer x
   x=operand
   %while expchar='&' %or expchar='!' %cycle
      %if expchar='&' %start
         getchar
         x=x&operand
      %finishelsestart
         getchar
         x=x!operand
      %finish
   %repeat
   %result=x
%end

%integerfn operand
!-----------------
%integer x
   %if expchar<0 %then %result=0
   %if expchar='(' %start
      getchar
      x=evaluate
      %if expchar#')' %then error %and %result=0
      getchar
      %result=x
   %finish
   %if 'A'<=expchar<='Z' %start
      x=vars(expchar-'A')
      getchar
      %result=x
   %finish
   %if expchar='~' %start
      getchar
      %result=1-operand
   %finish
   error
   %result=0
%end

%routine put(%integer x)
!-----------------------
   %if x=0 %then printstring("(=false)") %else printstring("(=true)")
%end

%routine commentout(%string (*) %name s)
!---------------------------------------
   %if cleanflag#0 %then %return
   printstring("{".s."}")
   newline
%end

%routine skip fi
!--------------
%string (255) text
   %cycle
      getline(text,0)
      commentout(text)
      %if starts(text,"#if")#0 %then skipfi
   %repeatuntil starts(text,"#fi") # 0
%end

%routine putout(%string (255) %name s)
!-------------------------------------
!print string unless ERCC type comment {xyz}
%integer val,i,c
   %if s="" %then newline %and %return
   %if charno(s,1)='{' %start
      val=0;    !line not wanted
      i=2
      %cycle
         %if i>length(s) %then val=1 %and %exit
         c=charno(s,i);    i=i+1
         %if c='}' %then %exit;      !valid ERCC type comment
         %if 'a'<=c<='z' %then c=c-'a'+'A'
         %if 'A'<=c<='Z' %then val=val ! vars(c-'A') %else val=1 %and %exit
      %repeat
      %if val=0 %start;  !line not wanted
         %if cleanflag#0 %then %return
         charno(s,1)='!'
         charno(s,i-1)='!'
      %finish
   %finish
   printstring(s);  
  newline

%end

%routine do if(%string (255) %name s)
!------------------------------------
%integer val
%string (255) text
   expression=subs(starts(s,"#if"),s)
   expindex=0; errflag=0;  getchar
   val=evaluate
   %if errflag#0 %then val=0;   !error
   %if cleanflag=0 %start
      printstring("!#if ".expression)
      put(val);   newline
   %finish
   %cycle
      getline(text,val)
      %if starts(text,"#else") # 0 %start
         val=1-val
         %if cleanflag=0 %start
            printstring("!".text)
            put(val)
            newline
         %finish
      %finishelseif starts(text, "#fi") # 0 %start
         %if cleanflag=0 %start
            printstring("!".text)
            newline
         %finish
         %exit
      %finishelsestart
         %if val=0 %start
            commentout(text)
            %if starts(text, "#if") # 0 %then skip fi
         %finishelsestart
            %if starts(text, "#if")#0 %then do if(text) %else putout(text)
         %finish
      %finish
   %repeat
%end

%routine param(%string (255) %name s)
!------------------------------------
%integer c
#if x
   printstring("Param: ")
   printstring(s)
   newline
#fi
   %if s="" %then %return
   %if s="CLEAN" %then cleanflag=1 %and %return
   c=charno(s,1)
   %if 'a'<=c<='z' %then c=c-'a'+'A'
   %if 'A'<=c<='Z' %start
      vars(c-'A')=1
   %finishelsestart
      printstring("Illegal parameters, use: infile,outfile,letter,letter...")
      %stop
   %finish
%end

#if e
%externalroutine prep(%string (255) s)
#else
%begin
%string(255) s
#fi
!this routine is a pre-processor for imp11 programs, it provides a
!conditional compilation facility. The first parameter is the source
!file name, the second parameter is the output file. If the output
!file is not specified <input file>#p is used. The remaining
!parameters are taken to be booleans (all true) to control the
!generation of the text. Booleans not in the parameter list are taken
!to be false. The conditional generation is controlled by lines
!begining with # i.e.
!#if <boolean exp>
!#else
!#fi
!#datestring      this is changed to a conststring declaration
!                 containing the date   %conststring(9) datestring='.....'
!#timestring      similarily returns a time declaration
!
!The #if construct can be nested but this only is evaluated in the 'true'
!case. The boolean operators are &, ! and ~.
!the precedence is ~ first then & and ! (left to right) brackets
!may be used. Null operands evaluate to false.
!
!
!for example    PREP(infile,outfile,k,r)      the booleans k and r are true
!Within the file expressions such as
!    #if (k!x) & r 
!may be used
!
!
%string (255) t,infile,outfile,text

%on %event 1,9 %start
#if e
   %if event inf>>8=1 %start
      select output(0)
      printstring("Run aborted after ")
      write(line no-1,3)
      printstring(" lines")
      newline
      set return code(1)
      %stop
   %finish
   select output(0)
   close stream(output)
#fi
#if d
   %if event_event=1 %start
      select output(0)
      printstring("Run aborted after ")
      write(line no-1,3)
      printstring(" lines")
      exit(1)
   %finish
   close output
   select output(0)
#fi
   write(line no-1,3); printstring(" lines processed"); newline
   %stop
%finish


   printstring("Prep version 3.0")
   newline
#if e
   initstr = s;                           ! keep for later
   infile=s
   outfile=""
   %if infile->infile.(",").outfile %start
      %if outfile->outfile.(",").s %start
         %while s->t.(",").s %cycle
            param(t)
         %repeat
         param(s)
      %finish
   %finish
   %if infile="" %then printstring("No input!!") %and %stop
   %if charno(infile,1)#'.' %and exist(infile)=0 %start
      printstring(infile." not there")
      newline
      %stop
   %finish
   %if outfile="" %start
      %if charno(infile, 1)='.' %then printstring("No output!!") %and %stop
      outfile=infile."#P"
      printstring("Output file=".outfile)
      newline
   %finish
   %if exist(outfile)#0 %then destroy(outfile)
   define("10,".infile)
   define("11,".outfile)
#fi
#if d
   s=cli param
   initstr = s
#if x
   printstring("Input command :")
   printstring(s)
   newline
#fi
  s="" %unless s->(":").s
   %while s->t.(",").s %cycle
     param(t)
   %repeat
   param(s)
#fi
   selectinput(input)
   selectoutput(output)

   line no=0
   %cycle
      getline(text,1)
      %if hash present # 0 %and starts(text, "#if") # 0 %then %c
        do if(text) %else putout(text)
   %repeat

%end

%endoffile