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

紹介しましたincludeですが、不具合が見つかりました。調べてみると、fgetc(),fputc()に原因がありました。不具合を改善したfgetc(),fputc()を掲載します。 これに関連して、files.fi,initfile(),fopen()も変更が必要です。

変更点は、以下の通りです。

1. 最後の文字位置をlastcr,lastcwで記憶
2. READWRITEでファイルを開けられるように対応
3. fnewで改行を超えたことを明示
4. getlin(),putlin()のバッファーをMAXLINE+1に変更

まずは、files.fi。

c files.fi -- file interface common valiables
      common /files/finuse(20),fbuf(20,81),flastcr(20),flastcw(20),
     1              fmode(20),fnew(20)
                          ! MAXFILES(20) MAXLINE(81)
      integer finuse      ! inuse flag
      integer*1 fbuf      ! I/O buffer
      integer flastcr     ! characters in read buffer
      integer flastcw     ! characters in write buffer
      integer*1 fmode     ! READ/WIRTE flag
      integer fnew        ! NEWLINE flag

変数、flastcに代わって、flastcr,flastcwを使用します。これは、READWRITEでファイルを開けた時に、正常に動作するようにするためです。 また、fnewを追加しました。これは、NEWLINEを超えた時にセットされ、次行を読み込むスイッチになります。

fopen()です。

c fopen.for -- connect intenal file descripter and external file
      integer function fopen(uid, fn, act)
      integer uid
      integer*1 fn(*), act
      integer i
      character*81 cfn                  ! MAXNAME(81)
      character*9 cact                  ! READ WRITE

      include 'files.fi'

      if (act .eq. 82) then             ! READ(LETR)
          cact = 'READ'
      else if (act .eq. 87) then        ! WRITE(LETW)
          cact = 'WRITE'
      else if (act .eq. 66) then        ! READWRITE(LETB)
          cact = 'READWRITE'
      else                              ! error
           uid = -1                     ! ERR(-1)
           fopen = -1                   ! ERR(-1)
           return
      end if

      call is2cs(fn,cfn,81)             ! MAXNAME(81) convert integer string to character string

      i = 1
      while (i .le. 20) do              ! MAXFIELS(20)
          if (finuse(i) .eq. 0) then    ! NOUSE(0)
              open(unit=i, file=cfn, action=cact, err=99)
              finuse(i) = 1             ! INUSE(1)
              uid = i
              fopen = i
              if (act .eq. 82) then     ! READ(LETR)
                  flastcr(i) = 80 + 1    ! MAXCARD(80)
                  fbuf(i,81) = 10       ! MAXLINE(81) NEWLINE(10)
                  fnew(i) = 0           ! NO(0)
                  fmode(i) = act        ! READ(LETR)
              else if (act .eq. 87) then ! WRITE(LETW)
                  flastcw(i) = 0
                  fmode(i) = act        ! WRITE(LETW)
              else if (act .eq. 66) then ! READWRITE(LETB)
                  flastcr(i) = 80 + 1    ! MAXCARD(80)
                  flastcw(i) = 0
                  fbuf(i,81) = 10       ! MAXLINE(81) NEWLINE(10)
                  fnew(i) = 0           ! NO(0)
                  fmode(i) = act        ! READWRITE(LETB)
              end if
              return
          endif
          i = i + 1
      end while
      
   99 continue
      uid = -1                          ! ERR(-1)
      fopen = -1                        ! ERR(-1)
      return
      end

flastcr,flastcwの初期設定と、READWRITEでファイルを開けた時の処理を追加しています。

fgetc()を次に示します。

c fgetc.for -- (extended version) get character from unit u
      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. 81) .or. (fnew(u) .eq. 1)) then ! MAXCARD(80) YES(1)
          read(u,10,end=9) (fbuf(u,i),i=1,80) ! MAXCARD(80)
   10     format(80a1)                  ! MAXCARD(80)
          flastcr(u) = 1
          fnew(u) = 0                   ! NO(0)
          i = 80                        ! MAXCARD(80)
          while (fbuf(u,i) .eq. 32) do  ! BALNK(32)
              i = i - 1
          end while
          fbuf(u,i + 1) = 10            ! NEWLINE(10)
      endif
      c = fbuf(u,flastcr(u))
      fgetc = fbuf(u,flastcr(u))
      if (c .eq. 10) then               ! NEWLINE(10)
          fnew(u) = 1                   ! YES(1)
      end if
      return
    9 continue
      c = -1                            ! EOF(-1)
      fgetc = -1                        ! EOF(-1)
      return
      end

fnewを使て、行末を超えたことを判断するロジックを追加しています。

fputc()は、以下の通りです。

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. (flastcw(u) .eq. 0)) then
          return                        ! buffer is empty, nothing to do
      end if
      if ((flastcw(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,flastcw(u))
   10     format(80a1)                  ! MAXCARD(80)
          flastcw(u) = 0
      end if
      if (c .ne. 10) then               ! NEWLINE(10)
          flastcw(u) = flastcw(u) + 1
          fbuf(u,flastcw(u)) = c
      end if
      return
      end

flastcwでロジックを組み立てています。

これ以外に、入出力ルーチンを念のため確認したところ,getlin(),putlin()を改修しました。

getlin()を以下に示します。

c getlin.for -- get line from infile

      integer function getlin(line,u)
      integer*1 line(81+1)                ! MAXLINE(81)+1
      integer u
      integer*1 c,fgetc
      integer col

      while (fgetc(u,c) .ne. -1) do     ! EOF(-1)
          col = 0
          while (c .ne. 10) do ! NEWLINE(10)
               col = col + 1
               line(col) = c
               c = fgetc(u,c)
          end while
          line(col + 1) = 10            ! NEWLINE(10)
          line(col + 2) = -2            ! EOS(-2)
          getlin = col
          return
      end while
      getlin = -1                       ! EOF(-1)
      return
      end

putlin()を以下に示します。

c putlin.for -- put lin to u
      subroutine putlin(lin,u)
      integer*1 lin(81+1)               ! MAXLINE(81)+1
      integer u,i

      i = 1
      while (lin(i) .ne. -2) do         ! EOS(-2)
          call fputc(u,lin(i))
          i = i + 1
      end while
      return
      end

以上の変更をしたのち、ライブラリーを再構築したのち、includeを作成してください。