アナクロなコンピューターエンジニアのつぶやき

以前、ファイル関連のモジュールを作成したとき、ファイルの読み込み機能"include"を使いました。これは 、Watcom Fortran77のソースプログラム中にファイルを読み込むものでした。これ以外の用途には使えません。 汎用的に使えると便利そうです。include -- ファイルの読み込みを紹介します。

テキストファイル中に、別ファイルを取り込みます。

RATFOR版は下記の通り。

# include.r4 -- replace include file by contents of file
      character line(MAXLINE), str(MAXLINE)
      integer equal, getlin, getwrd, fopen
      integer infile(NFILES), len, level, loc
      string incul "include"

      infile(1) = STDIN
      for (level = 1; level > 0; level = level - 1) {
          while (getlin(line,infile(level)) != EOF) {
              loc = 1
              len = getwrd(line,loc,str)

              if (equal(str,incul) .ne. 1)
                  call putlin(line,STDOUT)
              else {
                  level = level + 1
                  if (level .gt. NFILES)
                      call error('includes nested deeply.')
                  len = getwrd(line,loc,str)
                  if (fopen(infile(level),str,READ) .eq. ERR)
                      call cant(str)
                  }
              }
          if (level .gt. 1)
              call fclose(infile(level))
          
          }
      stop
      end

Watcom Fortran版は下記の通り。

c include.for -- replace include file by contents of file
      program include
      integer*1 line(82),str(82)        ! MAXLINE(82)
      integer*1 getlin
      integer getwrd
      integer equal,fopen
      integer infile(10),len,level,loc  ! NFILES(10)
      integer*1 incul(8)
      data incul /'i','n','c','l','u','d','e',-2/ ! EOS(-2)

      call initfile

      infile(1) = 5                     ! STDIN(5)
      level = 1
      while (level .gt. 0) do
          while (getlin(line,infile(level)) .ne. -1) do ! EOF(-1)
              loc = 1
              len = getwrd(line,loc,str)

              if (equal(str,incul) .ne. 1) then
                  call putlin(line,6)      ! STDOUT(6)
              else
                  level = level + 1
                  if (level .gt. 10) then ! NFILES(10)
                      call error('includes nested deeply.')
                  end if
                  len = getwrd(line,loc,str)
                  if (fopen(infile(level),str,82) .eq. -1) then ! READ(82) ERR(-1)
                      call cant(str)
                  endif
              end if
          end while
          if (level .gt. 1) then
              call fclose(infile(level))
          end if
          level = level - 1
      end while

      stop
      end

下請けルーチン、getwrd()は下記の通り。

# getwrd.r4 -- get non-blank word from in(i) into out, increment j
      integer function getwrd(in,i,out)
      character in(ARB),out(ARB)
      integer i,j
      
      while (in(i) == BLANK | in(i) == TAB) 
          i = i + 1

      j = 1
      while (in(i) != EOS & in(i) != BLANK
          & in(i) != TAB & in(i) .ne. NEWLINE) {
          out(j) = in(i)
          i = i + 1
          j = j + 1
          }
      out(j) = EOS
      getwrd = j - 1
      return
      end

Watcom Fortran77版は下記の通り。

c getwrd.for -- get non-blank word from in(i) into out, increment j
      integer function getwrd(in,i,out)
      integer*1 in(*),out(*)            ! ARB(*)
      integer i,j
      
      while ((in(i) .eq. 32) .or. (in(i) .eq. 9)) do ! BLANK(32) TAB(9)
          i = i + 1
      end while

      j = 1
      while (in(i) .ne. -2 .and. in(i) .ne. 32       ! EOS(-2) BLANK(32)
     1    .and. in(i) .ne. 9 .and. in(i) .ne. 10) do ! TAB(9) NEWLINE(10)
          out(j) = in(i)
          i = i + 1
          j = j + 1
      end while
      out(j) = -2                       ! EOS(-2)
      getwrd = j - 1
      return
      end