!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!                                                                       !!
!! 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)
!
! Input file to CoCo
! Output file after Step #3
! Step #2 file MODULE+PROGRAM
! Output from running Step #2

character(len=100), public :: &

                       in file,  &
                       out file,  &
                       step2 file, &
                       lines file,  &
                       batch file !  !!!!  Options (runs batch mode)
! batch

! input
! program (scratch)

integer, public, parameter :: BA UNUM=30, &

                           IN UNUM=31, &
                           PR UNUM=32, &
                           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

! CoCo variable to be initialized
character(len=32) :: init var, &
                   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