コードの改修 -- 名前付き共通領域の初期化の改善 ファイル入出力: アナクロなコンピューターエンジニアのつぶやき

ファイル入出力に関する共通領域の初期化は、initfile()で行っていましたが、 これをdata文で静的に初期化することとします。

Ratofr版のfiles.riは以下の通りです。

# files.ri -- file interface common valiables
      common /files/finuse,fbuf,flastcr,flastcw,fmode,fnew
      integer finuse(MAXFILES)          # inuse flag
      character fbuf(MAXFILES,MAXLINE)  # I/O buffer
      integer flastcr(MAXFILES)         # characters in read buffer
      integer flastcw(MAXFILES)         # characters in write buffer
      character fmode(MAXFILES)         # READ/WIRTE flag
      integer fnew(MAXFILES)            # NEWLINE flag
      data finuse/MAXFILES*NOUSE/
      data flastcr/MAXFILES*0/
      data flastcw/MAXFILES*MAXLINE/
      data fmode/MAXFILES*READ/
      data fnew/MAXFILES*NO/
      data finuse(STDIN)/INUSE/
      data flastcr(STDIN)/MAXLINE/
      data fmode(STDIN)/READ/
      data finuse(STDOUT)/INUSE/
      data flastcw(STDOUT)/0/
      data fmode(STDOUT)/WRITE/

WATCOM fotran77版のfiles.fiは以下の通りです。

c files.fi -- file interface common valiables
      common /files/finuse,fbuf,flastcr,flastcw,fmode,fnew
      integer finuse(MAXFILES)          ! inuse flag
      integer*1 fbuf(MAXFILES,MAXLINE)  ! I/O buffer
      integer flastcr(MAXFILES)         ! characters in read buffer
      integer flastcw(MAXFILES)         ! characters in write buffer
      integer*1 fmode(MAXFILES)         ! READ/WIRTE flag
      integer fnew(MAXFILES)            ! NEWLINE flag
      data finuse/MAXFILES*NOUSE/
      data flastcr/MAXFILES*0/
      data flastcw/MAXFILES*MAXLINE/
      data fmode/MAXFILES*READ/
      data fnew/MAXFILES*NO/
      data finuse(STDIN)/INUSE/
      data flastcr(STDIN)/MAXLINE/
      data fmode(STDIN)/READ/
      data finuse(STDOUT)/INUSE/
      data flastcw(STDOUT)/0/
      data fmode(STDOUT)/WRITE/

files.ri、files.fiの変更により再コンパイルが必要になるファイルは、以下の通りです。

          fopen.for
          fclose.for
          fgetc.for
          fputc.for

これらは、macroが動き出す前のファイルですので、macroを使用する版を再掲します。

fopen()のRatofor版は以下の通りです。

# fopen.r4 -- connect internal file descripter and external file
      include ratfor.def
      integer function fopen(uid, fn, act)
      integer uid
      character fn(ARB), act
      integer i
      character*MAXLINE cfn
      character*9 cact  # for 'READ'/'WRITE'/'READWRITE'
      include files.fi

      if (act == READ)
          cact = 'READ'
      else if (act == WRITE)
          cact = 'WRITE'
      else if (act == READWRITE)
          cact = 'READWRITE'
      else {             # error
           uid = ERR
           fopen = ERR
           return
           }
      end if
      call is2cs(fn,cfn,MAXNAME)
      for (i = 1; i <= MAXFILES; i = i + 1)
          if (finuse(i) == NOUSE) {
              open(unit=i, file=cfn, action=cact, err=99)
              finuse(i) = INUSE
              uid = i
              fopen = i
              if (act == READ) {
                  flastcr(i) = MAXLINE
                  fbuf(i,MAXLINE) = NEWLINE
                  fnew(i) = NO
                  fmode(i) = act
                  }
              else if (act .eq. WRITE) {
                  flastcw(i) = 0
                  fmode(i) = act
                  }
              else if (act .eq. READWIRTE) {
                  flastcr(i) = MAXLINE
                  flastcw(i) = 0
                  fbuf(i,MAXLINE) = NEWLINE
                  fnew(i) = NO
                  fmode(i) = act
                  }
              return
              }
   99 continue
      uid = ERR
      fopen = ERR
      return
      end

fopen()のWATCOM fortran77版は以下の通りです。

c fopen.f -- connect internal file descripter and external file
      include ratfor.def
      integer function fopen(uid, fn, act)
      integer uid
      integer*1 fn(ARB), act
      integer i
      character*MAXLINE cfn
      character*9 cact                  ! READ WRITE
      include files.fi

      if (act .eq. READ) then
          cact = 'READ'
      else if (act .eq. WRITE) then
          cact = 'WRITE'
      else if (act .eq. READWRITE) then
          cact = 'READWRITE'
      else                              ! error
           uid = ERR
           fopen = ERR
           return
      end if
      call is2cs(fn,cfn,MAXNAME)
      i = 1
      while (i .le. MAXFILES) do
          if (finuse(i) .eq. NOUSE) then
              open(unit=i, file=cfn, action=cact, err=99)
              finuse(i) = INUSE
              uid = i
              fopen = i
              if (act .eq. READ) then
                  flastcr(i) = MAXLINE
                  fbuf(i,MAXLINE) = NEWLINE
                  fnew(i) = NO
                  fmode(i) = act
              else if (act .eq. WRITE) then
                  flastcw(i) = 0
                  fmode(i) = act
              else if (act .eq. READWIRTE) then
                  flastcr(i) = MAXLINE
                  flastcw(i) = 0
                  fbuf(i,MAXLINE) = NEWLINE
                  fnew(i) = NO
                  fmode(i) = act
              end if
              return
          endif
          i = i + 1
      end while
   99 continue
      uid = ERR
      fopen = ERR
      return
      end

fclose()のRatofor版は以下の通りです。

# fclose.r4 -- disconnect internal filedescripter and extenal file
      include ratfor.def
      subroutine fclose(uid)
      integer uid
      include files.fi

      if (!(uid == STDIN) | (uid == STDOUT))) then
          if (fmode(uid) == WRITE) then
              call fputc(uid,EOF)        ! flush buffer
          end if
          close(unit=uid, status='keep')
          finuse(uid) = NOUSE
          uid = 0
      end if
      return
      end

fclose()のWATCOM fortran77版は以下の通りです。

c fclose.f-- disconnect internal filedescripter and extenal file
      include ratfor.def
      subroutine fclose(uid)
      integer uid
      include files.fi

      if (.not. ((uid .eq. STDIN) .or. (uid .eq. STDOUT))) then
          if (fmode(uid) .eq. WRITE) then
              call fputc(uid,EOF)        ! flush buffer
          end if
          close(unit=uid, status='keep')
          finuse(uid) = NOUSE
          uid = 0
      end if
      return
      end

fgetc()のRatofor版は以下の通りです。

c fgetc.f -- (extended version) get character from unit u
# fgetc.r4 -- (extended version) get character from unit u
      include ratfor.def
      character function fgetc(u,c)
      integer u
      character c
      integer i
      include files.fi

      flastcr(u) = flastcr(u) + 1
      if ((flastcr(u) > MAXLINE) | (fnew(u) == YES)) {
          read(u,10,end=9) (fbuf(u,i),i=1,MAXCARD)
   10     format(MAXCARD a1)
          flastcr(u) = 1
          fnew(u) = NO
          for (i = MAXCARD; (fbuf(u,i) == BLANK); i = i - 1)
              ;
          fbuf(u,i + 1) = NEWLINE
          }
      c = fbuf(u,flastcr(u))
      fgetc = fbuf(u,flastcr(u))
      if (c == NEWLINE)
          fnew(u) = YES
      return
    9 continue
      c = EOF
      fgetc = EOF
      return
      end

fgetc()のWATCOM fortran77版は以下の通りです。

c fgetc.f -- (extended version) get character from unit u
      include ratfor.def
      integer*1 function fgetc(u,c)
      integer u
      integer*1 c
      integer i
      include files.fi

      flastcr(u) = flastcr(u) + 1
      if ((flastcr(u) .gt. MAXLINE) .or. (fnew(u) .eq. YES)) then
          read(u,10,end=9) (fbuf(u,i),i=1,MAXCARD)
   10     format(MAXCARD a1)
          flastcr(u) = 1
          fnew(u) = NO
          i = MAXCARD
          while (fbuf(u,i) .eq. BLANK) do
              i = i - 1
          end while
          fbuf(u,i + 1) = NEWLINE
      endif
      c = fbuf(u,flastcr(u))
      fgetc = fbuf(u,flastcr(u))
      if (c .eq. NEWLINE) then
          fnew(u) = YES
      end if
      return
    9 continue
      c = EOF
      fgetc = EOF
      return
      end

fclose()のRatofor版は以下の通りです。

# fputc.r4 (extended version) -- put character on file
      include ratfor.def
      subroutine fputc(u,c)
      integer i,u
      character c
      include files.fi

      if ((c == EOF) & (flastcw(u) == 0))
          return                        ! buffer is empty, nothing to do
      if (flastcw(u) >= MAXCARD | c == NEWLINE | c == EOF) {
          write(u,10) (fbuf(u,i),i=1,flastcw(u))
   10     format(MAXCARD a1)
          flastcw(u) = 0
          }
      if (c != NEWLINE) {
          flastcw(u) = flastcw(u) + 1
          fbuf(u,flastcw(u)) = c
          }
      return
      end

fclose()のWATCOM fortran77版は以下の通りです。

c fputc.f (extended version) -- put character on file
      include ratfor.def
      subroutine fputc(u,c)
      integer i,u
      integer*1 c
      include files.fi

      if ((c .eq. EOF) .and. (flastcw(u) .eq. 0)) then
          return                        ! buffer is empty, nothing to do
      end if
      if (flastcw(u) .ge. MAXCARD .or. c .eq. NEWLINE .or. c .eq. EOF) then
          write(u,10) (fbuf(u,i),i=1,flastcw(u))
   10     format(MAXCARD a1)
          flastcw(u) = 0
      end if
      if (c .ne. NEWLINE) then
          flastcw(u) = flastcw(u) + 1
          fbuf(u,flastcw(u)) = c
      end if
      return
      end

また、initfile()が不要になることで修正・再コンパイルが必要になるファイルは、 以下の通りです。

          archive.for
          change.for
          compare2.for
          concat.for
          copy.for
          copyfile.for
          define.f
          edit.f
          find.for
          include.for
          macro.f
          makecopy.for
          ratfor.f
          sort.for
          typex.for
          unique.for
          xformat.f
          xprint.for

実際の変更点については割愛します。