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

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

Ratfor版のcdefio.riは以下の通りです。

# cdefio.ri
      common /cdefio/bp,buf
      integer bp              # next available character; init = 0
      character buf(BUFSIZE)  # pushed back character
      data bp/0/

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

c cdefio.fi
      common /cdefio/bp,buf
      integer bp              ! next available character; init = 0
      integer*1 buf(BUFSIZE)  ! pushed back character
      data bp/0/

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

          ngetc.f
          putbak.f

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

ngetc()のRatfor版は以下の通りです。

# ngetc.r4 -- get a (possibly pushed back) character
      character function ngetc( c )
      character c
      character getc
      include cdefio.ri

      if (bp > 0)
         c = buf(bp)
      else {
         bp = 1
         buf(bp) = getc(c)
         }
      if (c != EOF)
         bp = bp - 1
      ngetc = c
      return
      end

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

c  ngetc.f -- get a (possibly pushed back) character
      include ratfor.def
      integer*1 function ngetc( c )
      integer*1 c
      integer*1 getc
      include cdefio.fi

      if (bp .gt. 0) then
         c = buf(bp)
      else
         bp = 1
         buf(bp) = getc(c)
      end if
      if (c .ne. EOF) then
         bp = bp - 1
      end if
      ngetc = c
      return
      end

putbak()のRatfor版は以下の通りです。

# putbak.r4 -- push character back onto input
      subroutine putbak(c)
      character c
      include cdefio.ri
      
      bp = bp + 1
      if (bp > BUFSIZE)
         call error('too many character pushed back.')
      buf(bp) = c
      return
      end

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

c putbak.f -- push character back onto input
      include ratfor.def
      subroutine putbak(c)
      integer*1 c
      include cdefio.fi
      
      bp = bp + 1
      if (bp .gt. BUFSIZE) then
         call putdec(bp,1)
         call putc(NEWLINE)
         call error('too many character pushed back.')
      end if
      buf(bp) = c

      return
      end

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

          define.f
          macro.f

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