前回作成したファイルのオープン、クローズルーチンと併せて使用する、ファイル読み書きルーチンを示します。

はじめに、一文字書き出しルーチンfputc()です。putc()を拡張しています。

c fputc.for (extended version) -- put character on file
      subroutine fputc(u,c)
      integer i, u
      integer*1 c

      include 'files.fi'

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

次に、一文字読み込みルーチンfgetc()です。これは、getc()を拡張しています。

c fgetc.for -- (extended version) get character from unit u
      integer*1 function fgetc(u,c)
      integer u
      integer*1 c
      integer col, i

      include 'files.fi'

      flastc(u) = flastc(u) + 1
      if (flastc(u) .ge. 80 .or. fbuf(u,flastc(u)) .eq. -2) then ! MAXCARD(80) EOS(-2)
          read(u,10,end=9) (fbuf(u,i),i=1,80) ! MAXCARD(80)
   10     format(80a1)                  ! MAXCARD(80)
          flastc(u) = 1
          col = 80
          while (fbuf(u,col) .eq. 32) do ! BALNK(32)
              col = col - 1
          end while
          fbuf(u,col+1) = 10            ! NEWLINE(10)
          fbuf(u,col+2) = -2            ! EOS(-2)
      endif
      c = fbuf(u,flastc(u))
      fgetc = fbuf(u,flastc(u))
      return
    9 continue
      c = -1                            ! EOF(-1)
      fgetc = -1                        ! EOF(-1)
      return
      end

ここで、問題が生じました。fgetc(5,c)とgetc(c)が交互に呼ばれたらどうなるでしょうか。また、fputc(6,c)とputc(c)が、 交互に呼ばれたらどうなるでしょうか。悲劇が起きます。原因は、どこにあるでしょうか。原因究明は次回に致します。