!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!                                                                       !!
!! CoCo Processor - Copyright (c) 1996 Imagine1, Inc.                    !!
!!                                                                       !!
!! Imagine1 claims that this software is not a complete implementation   !!
!! of the Conditional Compilation definition described in SC22WG5-N1192. !!
!! Permission to use, copy, modify, and distribute this software is      !!
!! freely granted, provided that this notice is preserved.               !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!?>?? integer, parameter :: DOS=1, UNIX=2, MAC=3
!?>?? integer, parameter :: your_system = 4 ! Edit here for other
!?>?? integer :: system = DOS ! Edit not required here!  Use override.
!?>??
!?>?? logical :: commenting = .false. !.true. to remove "!?>??" and update
!?>?? if (commenting) then
!?> ***********************************************************************
!?>
!?>                        CoCo Processor
!?>
!?> Periodic CoCo versions with new features and bug fixes will be
!?> sent to you if I have your email address.
!?>
!?>  creator   : David Epstein
!?>  e-mail    : david@imagine1.com
!?>  telephone : +1-541-383-4848
!?>  Web page  : http://www.imagine1.com/imagine1/
!?>
!?> HISTORY
!?> -------
!?>  (1) Simple Ccf Processor (1994 Oct)
!?>  (2) CCF 95 (1995 May)
!?>  (3) CoCo Processor (, this code!) (1996 Sep)
!?>
!?> BASIC IDEA
!?> ----------
!?> Since the Conditional Compilation language (CoCo) is a subset of
!?> Fortran, a simple CoCo processor is achieved by using a Fortran
!?> processor to execute the CoCo directives.
!?>
!?> DEFINITIONS
!?> -----------
!?>  coco1.f90: (this program!) Step #1 of a three step process.
!?>  coco3.f90: Step #3 of a three step process.
!?>  coco step2 program file: Output of Step #1 program, part of Step #2.
!?>  coco lines file: Output of Step #2.
!?>
!?> PROCESS
!?> -------
!?> 1. Compile this CoCo processor with your Fortran processor.
!?>     (a) This file, coco1.f90, is one of two required programs.
!?>     (b) Another file, coco3.f90, is the other required program.
!?>    You now have a CoCo processor.
!?> 2. Invoke coco1, the first part of this CoCo processor, and
!?>      (a) follow the prompts for required input or
!?>      (b) let the input come from the cocovars file which is
!?>          created automatically after your initial execution of
!?>          this CoCo processor.  Make sure to delete this file if
!?>          your input changes or you prefer interactive input.
!?> 3. Compile the coco step2 program file (coco2.f90 on DOS/UNIX/MAC).
!?> 4. Execute the coco step2 program to create the coco lines file.
!?> 5. The file produced in process 4. contains the line numbers for the
!?>    lines that are to be part of the post-CoCo-processing (assumingly
!?>    a Fortran processor, but possibly some other processor).
!?> 6. Execute the coco step3 program (coco3.f90) to produce desired
!?>    output.
!?>
!?> ALGORITHM
!?> ---------
!?> Turn ?? lines into Fortran lines by replacing ?? with blanks.
!?> Turn all other lines into output statements that writes the line
!?> number to the coco lines file.
!?>
!?> Special handling of CoCo variables is required due to Fortran
!?> requirement that the specification-part precedes the execution-part.
!?> All CoCo variable declaration lines are buffered until written to a
!?> module.  This module is also used to handle initialization of CoCo
!?> variables when the programmer wants to override initial values in
!?> the source (instead of modifying the source!)
!?>
!?> DESCRIPTION OF OUTPUT
!?> ---------------------
!?> The output from Step #3 shows the result of the CoCo If construct
!?> logic.  The lines in any false branches of a CoCo If construct are
!?> turned into Fortran comments by adding the three character "!?>" in
!?> columns one to three (as is seen on this very line).  The CoCo
!?> directives are also turned into Fortran comments using the same
!?> method.  THIS CAN ALL BE CHANGED by simply changing coco3.f90.
!?>
!?> DIFFERENCES BETWEEN THIS COCO AND THE COCO DEFINITION IN N1192
!?> --------------------------------------------------------------
!?> This simple CoCo processor differs from the full CoCo definition
!?> in two major areas:
!?>  (1) The Fortran INCLUDE line is not recognized in this processor.
!?>  (2) Constraints are not all checked in this processor.
!?>
!?> There are a few other restrictions with this processor, but they
!?> are not expected to be discovered at this early stage of the CoCo
!?> language standardization.  For example, the keywords INTEGER and
!?> LOGICAL are not expected to be split across lines.
!?>?? endif ! (commenting) then
!***************************************************************************
module m_step1_utils
 public :: WriteLine, StopIfIoError, HandleFirstWord, WriteCoCoVarsModule, &
           AddCoCoVarDeclLine, InitCoCoVarDeclLines, AppendTheProgram
 integer, private, parameter :: MAX_COCO_VAR_DECL_LINES = 20
 character(len=256), private, dimension(MAX_COCO_VAR_DECL_LINES) &
                             :: coco_var_lines
 integer, private            :: num_coco_var_decl_lines

 ! file names (len of 100 is a random selection and can be changed)
 character(len=100), public ::  &     !
                       in_file,  &    ! Input file to CoCo
                       out_file,  &   ! Output file after Step #3
                       step2_file, &  ! Step #2 file MODULE+PROGRAM
                       lines_file,  & ! Output from running Step #2
                       batch_file !!!!! Options (runs batch mode)
 integer, public, parameter :: BA_UNUM=30, & ! batch
                               IN_UNUM=31, & ! input
                               PR_UNUM=32, & ! program (scratch)
                               S2_UNUM=33    ! step2
contains
 subroutine InitCoCoVarDeclLines()
    num_coco_var_decl_lines = 0
 endsubroutine InitCoCoVarDeclLines

 subroutine AddCoCoVarDeclLine(line)
   character(len=*), intent(in) :: line
    num_coco_var_decl_lines = num_coco_var_decl_lines + 1
    if (num_coco_var_decl_lines > MAX_COCO_VAR_DECL_LINES) then
       print *, "CoCo halts.  Limit of CoCo variable declaration lines"
       print *, MAX_COCO_VAR_DECL_LINES," exceeded on line:"
       print *, line
       print *
       print *, "Changing the value of MAX_COCO_VAR_DECL_LINES in your"
       print *, "simple CoCo processor will correct this situation."
       stop
    endif
    coco_var_lines(num_coco_var_decl_lines) = "  "//line(3:) ! remove ??
 endsubroutine AddCoCoVarDeclLine

 subroutine WriteLine(unit_num, line)
 intrinsic trim
   integer, intent(in)          :: unit_num
   character(len=*), intent(in) :: line
    write(unit=unit_num, fmt="(a)") trim(line)
 endsubroutine WriteLine

 subroutine StopIfIoError(eof, unit_num, filename) ! Check IOSTAT variable.
   integer, intent(in) :: eof, unit_num
   character(len=*), intent(in) :: filename
    if (eof > 0) then
       print *, "An IO error has occurred on unit number ",unit_num
       print *, " which is file ", filename
       print *, "Processing stops"
       stop
    endif
 endsubroutine StopIfIoError

 subroutine HandleFirstWord(line, is_decl, is_error, is_stop)
 ! Determine if the current CoCo line is a CoCo variable declaration
 ! line.  This simple CoCo processor expects the directive to fit on
 ! one line.
 intrinsic len_trim, char, ichar
   character(len=*), intent(inout) :: line
   logical, intent(out)            :: is_decl ! ??INTEGER or ??LOGICAL
   logical, intent(out)            :: is_error
   logical, intent(out)            :: is_stop
   character(len=64) :: word
   character(len= 1) :: ch
   integer, parameter :: ICHAR_LITTLE_A = ichar("a"), &
                         ICHAR_BIG_A    = ichar("A")
   integer :: pos, wpos, start_of_word_pos
   integer :: line_len
   logical :: has_comma, has_colon, has_init
    is_decl  = .false.
    is_error = .false.
    is_stop  = .false.
    has_init = .false.
    has_comma = .false.
    has_colon = .false.
    ! skip over the ?? and the blanks
    pos = 3
    line_len = len_trim(line)
    do
       if (pos>line_len .or. line(pos:pos)/=" ") then
          exit
       endif
       pos = pos + 1
    enddo

    ! collect the first word
    wpos = 0
    start_of_word_pos = pos
    pos = pos - 1
    do
       pos = pos + 1
       ch = line(pos:pos)
       if (pos>line_len .or. ch=="," .or. ch==" " .or. ch==":") then
          exit                 ! ',' for ',PARAMETER' and  ':' for '::'
       else
          wpos = wpos + 1
          if (ch>="A" .and. ch<="Z") then ! lower-case it
             ch = char(ICHAR_LITTLE_A+(ichar(ch)-ICHAR_BIG_A))
          endif
          word(wpos:wpos) = ch
       endif
    enddo
    select case (word(:wpos))
    case ("integer", "logical")
       is_decl = .true.
       ! Make sure this is not an assignment ??integer = etc
       do
          if (pos>line_len) then
             exit
          elseif (line(pos:pos) == "&") then
             print *, "WARNING: CoCo prefers decl on one line:"
             print *, line(:line_len)
             exit
          elseif (line(pos:pos) == ",") then
             has_comma = .true.
          elseif (line(pos:pos) == ":") then
             has_colon = .true.
          elseif (line(pos:pos) == "=") then
             if (has_colon) then
                has_init = .true.
             else
                is_decl = .false.
             endif
             exit
          else
          endif
          pos = pos + 1
       enddo

       if (is_decl .and. has_init .and. .not. has_comma) then
          if (line_len+12 > 132) then
             print *, "TROUBLE: CoCo decl line cannot be > 120.  Line:"
             print *, line(:line_len)
          endif
          line(start_of_word_pos+7:) = &
           ",public,save"//line(start_of_word_pos+7:)
       elseif (is_decl) then
          if (line_len+7 > 132) then
             print *, "TROUBLE: CoCo decl line cannot be > 125.  Line:"
             print *, line(:line_len)
          endif
          line(start_of_word_pos+7:) = ",public"//line(start_of_word_pos+7:)
       endif
    case ("error")
       is_error = .true.
       if (line_len+2 > 132) then
          print *, "TROUBLE: CoCo error line cannot be > 130.  On line:"
          print *, line(:line_len)
       endif
       line(start_of_word_pos:) = "print*,"//line(start_of_word_pos+5:)
    case ("stop")
       is_stop = .true.
    endselect
 endsubroutine HandleFirstWord

 subroutine WriteCoCoVarsModule(batch)
 ! Write the CoCoVars module.  CoCoVars contains all the CoCo variable
 ! declarations and a subroutine called CoCoInits.  CoCoInits contains
 ! assignments of any initial values for CoCo variables supplied either
 ! in the CoCo batch file or from standard input (interactive mode).
   logical, intent(in) :: batch
   integer           :: i
   integer           :: eof
   character(len=32) :: init_var, &  ! CoCo variable to be initialized
                        init_val     ! Initial value for CoCo variable
   character(len=99) :: line
    open (unit=S2_UNUM, action="write", status="replace", &
          position="rewind", iostat=eof, file=step2_file)
    call StopIfIoError(eof, S2_UNUM, step2_file)
    call WriteLine(S2_UNUM, "module CoCoVars")
    call WriteLine(S2_UNUM, "implicit none")
    call WriteLine(S2_UNUM, " public :: CoCoInits")

    do i = 1, num_coco_var_decl_lines
       call WriteLine(S2_UNUM, coco_var_lines(i))
    enddo

    call WriteLine(S2_UNUM, "contains")
    call WriteLine(S2_UNUM, " subroutine CoCoInits()")

    init_var = "foo" ! any foo other than '0' since '0' terminates loop
    do
       if (init_var == "0") then
          exit
       endif
       if (batch) then
          read (unit=BA_UNUM, fmt="(a)", iostat=eof) init_var
          if (eof<0) then
             print *, "Trying to read a line from CoCoVars file '", &
                      trim(batch_file), "'"
             print *, "Error: Batch file expecting var-val pairs or 0"
             stop
          elseif (init_var(1:1) /= "0") then
             read (unit=BA_UNUM, fmt="(A)", iostat=eof) init_val
             if (eof<0) then
                print *, "Trying to read a line from CoCoVars file '", &
                         trim(batch_file), "'"
                print *, "Error: Batch file expecting var-val pairs or 0"
                stop
             endif
             line = trim(init_var) // "=" // trim(init_val)
             call WriteLine(S2_UNUM, line)
          endif
       else
          print *, "Enter the name of a CoCo variable to be initialized"
          print *, " (or '0' when you are done initializing):"
          read *, init_var
          write (unit=BA_UNUM, fmt="(A)") trim(init_var)
          if (init_var /= "0") then
             print *, "Enter the value you want for this CoCo variable: "
             read *, init_val
             write (unit=BA_UNUM, fmt="(A)") trim(init_val)
             line = trim(init_var) // "=" // trim(init_val)
             call WriteLine(S2_UNUM, line)
          endif
       endif
    enddo
    call WriteLine(S2_UNUM, " endsubroutine CoCoInits")
    call WriteLine(S2_UNUM, "endmodule CoCoVars")
 endsubroutine WriteCoCoVarsModule

 subroutine AppendTheProgram()
   character(len=256) :: line
   integer :: eof
    rewind(unit=PR_UNUM)
    call WriteLine(S2_UNUM, "!Program that will output *true* line numbers")
    do
       read(unit=PR_UNUM, fmt="(a)", iostat=eof) line
       if (eof < 0) then
          exit
       endif
       call WriteLine(S2_UNUM, line)
    enddo
 endsubroutine AppendTheProgram
endmodule m_step1_utils

program CoCoStep1
 use m_step1_utils
  integer :: eof           ! for iostat=eof
  logical :: batch           ! TRUE if batch_file exists
  integer :: line_count        ! count the input lines
  character(len=  8) :: line_str ! line_count as a string
  character(len=256) :: line
  logical :: decl_line ! true if ??integer or ??logical
  logical :: error_line
  logical :: stop_line

   ! set filenames
!?>?? if (system == DOS .or. system == UNIX .or. system == MAC) then
   step2_file = "coco2.f90"
   lines_file = "cocoline.txt"
   batch_file = "cocovars.txt"
!?>?? else ! system other than dos or unix
!?>??    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!?>??    print *, "Edit below filenames for other file system"
!?>??    stop
!?>??    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!?>   step2_file = "coco2 filename for your system"
!?>   lines_file = "cocoline filename for your system"
!?>   batch_file = "cocovars filename for your system"
!?>?? endif

   inquire(file=batch_file, exist=batch)
   if (batch) then
      open (unit=BA_UNUM, action="read", &
            status="old", position="rewind", file=batch_file)
      read (unit=BA_UNUM, fmt="(a)", iostat=eof) in_file
      call StopIfIoError(eof, BA_UNUM, batch_file)
      if (.not.(eof<0)) then
         read (unit=BA_UNUM, fmt="(a)", iostat=eof) out_file
         call StopIfIoError(eof, BA_UNUM, batch_file)
         if (.not.(eof<0)) then
          ! got in_file name and out_file name
         else
            print *, "Trying to read a line from CoCoVars file '", &
                     trim(batch_file), "'"
            print *, "Error: Batch file expects input and output filenames"
            stop
         endif
      else
         print *, "Trying to read a line from CoCoVars file '", &
                  trim(batch_file), "'"
         print *, "Error: Batch file expects input and output filenames"
         stop
      endif
   else
      print *, "Enter the name of the file for CoCo processing:"
      read *, in_file
      print *, "Enter the name you want for the output file:"
      read *, out_file
      if (in_file == out_file) then
         print *, "FATAL: Input filename cannot equal output filename"
         stop
      endif
      open (unit=BA_UNUM, action="write", status="replace", &
            position="rewind", iostat=eof, file=batch_file)
      call StopIfIoError(eof, BA_UNUM, batch_file)
      write(unit=BA_UNUM, fmt="(A)") trim(in_file)
      write(unit=BA_UNUM, fmt="(A)") trim(out_file)
   endif

   open (unit=IN_UNUM, action="read", &
         status="old", position="rewind", iostat=eof, file=in_file)
   call StopIfIoError(eof, IN_UNUM, in_file)
   open (unit=PR_UNUM, action="readwrite", &
         status="scratch", position="rewind", iostat=eof)
   call StopIfIoError(eof, PR_UNUM, "CoCo scratch file")

   call WriteLine(PR_UNUM, "program CoCoIt")
   call WriteLine(PR_UNUM, " use CoCoVars  ! Has CoCo vars and init values")
   call WriteLine(PR_UNUM, " implicit none")
   call WriteLine(PR_UNUM, "  call CoCoInits()  ! Init CoCo vars")
   call WriteLine(PR_UNUM,&
    "open (unit=34, action=""write"", status=""replace"", &")
   call WriteLine(PR_UNUM,&
    "      position=""rewind"", file=""" //trim(lines_file)// """)")

!?>?? if (commenting) then
!?> ************************************************************************
!?> **  Read each line of the input file looking for                      **
!?> **    1) CoCo lines                                                   **
!?> **    2) Other lines                                                  **
!?> **                                                                    **
!?> **    1) CoCo lines -                                                 **
!?> **        a) CoCo variable declarations are buffered until written    **
!?> **           to the CoCo module.                                      **
!?> **        b) All other CoCo lines are turned into Fortran lines by    **
!?> **           replacing the ?? in columns 1 and 2 with blanks.         **
!?> **    2) Other lines -                                                **
!?> **        Create an output statement for their line number.           **
!?> ************************************************************************
!?>?? endif ! (commenting) then
   line_count = 0
   call InitCoCoVarDeclLines()
   do ! until end of file
      read (unit=IN_UNUM, fmt="(a)", iostat=eof) line
      if (eof<0) then
         exit
      endif
      line_count = line_count + 1

      ! In coco3.f90, note that DIR_CODE = "!?>"  ! len=3!
      if (line(1:5) == "!?>??") then  ! remove the !?> and continue
         line = line(4:)
      endif
      ! ?? is a CoCo line
      if (line(1:2) == "??") then
         ! if a CoCo var declaration, save this line for the CoCo module;
         ! else replace the ?? with blanks (turn into a Fortran statement)
         call HandleFirstWord(line, decl_line, error_line, stop_line)
         if (error_line) then
            call WriteLine(PR_UNUM, "write(unit=34, fmt=""(a)"") ""ERROR""")
         elseif (stop_line) then
            call WriteLine(PR_UNUM, "write(unit=34, fmt=""(a)"") ""STOP""")
         endif
         if (decl_line) then
            call AddCoCoVarDeclLine(line)
         else
            line(1:2) = "  "
            call WriteLine(PR_UNUM, line)
         endif
      else ! not a CoCo line
         write(unit=line_str, fmt="(i8)") line_count
         call WriteLine(PR_UNUM, &
                        "write(unit=34, fmt=""(a)"") """//line_str//"""")
      endif
   enddo
   call WriteLine(PR_UNUM, "endprogram CoCoIt")

   ! Write the module file which contains all the CoCo var decls/inits
   call WriteCoCoVarsModule(batch)
   call AppendTheProgram() ! The step2 file now has MODULE + PROGRAM

   ! Close files and we are done
   close(unit=BA_UNUM, status="keep")
   close(unit=IN_UNUM, status="keep")
   close(unit=S2_UNUM, status="keep")

   ! Reminder of Step #2
   if (.not. batch) then
      print *
      print *, "CoCo is creating ", trim(step2_file)
      print *, " as the Step2 file to compile and run before coco3."
   endif
endprogram CoCoStep1
