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

前回取り上げたcopyプログラムで使用している、getc()とputc()を紹介します。

まずは、getc()。RATFOR版は以下の通り。

# getc.r4 (simple version) -- get one characters from standard input
      character function getc(c)
      character c
      
      character buf(MAXLINE)
      integer i, lastc
      data lastc /MAXLINE/, buf(MAXLINE) /NEWLINE/
      # note : MAXLINE = MACCARD + 1

      lastc = lastc + 1
      if (lastc > MAXLINE) {
          read(STDIN, 100,end=10) (buf(i),i = 1,MAXCARD)
              100 format(MAXCARD a1)
          lastc = 1
          }
      c = buf(lastc)
      getc = c
      return

   10 c = EOF
      getc = EOF
      return
      end

RATFORのif文が出てきています。"{" -- "}"で複数の文をブロック化しています。

Watcom Fortran 77では、if文が、"if () then -- else -- endif"に拡張されています。

Watcom Fortran 77版では、character型がありますが、数値定数を代入することができません。 integer*1型に文字を格納することとします。

c getc.for -- (simple version) get character from standard input
      integer*1 function getc(c)
      integer*1 c
      
      integer col,lastc
      integer*1 buf(81)  ! MAXLINE(81)
      data lastc/81/     ! MAXLINE(81)
      
      lastc = lastc + 1
      if (lastc .gt. 81) then                      ! MAXLINE(81)
          read(5,100,end=999) (buf(col),col=1,80)  ! MAXCARD(80)
  100     format(80a1)                             ! MAXCARD(80)
          lastc = 1
      endif

      c    = buf(lastc)
      getc = buf(lastc)
      return

  999 continue
      c    = -1 ! EOF(-1)
      getc = -1 ! EOF(-1)
      return
      end

これで、良さそうなのですが、問題が一つあります。それは、本来の行末に空白文字が 追加され、１行が８０文字になってしまうのです。この問題を回避したのが、次の版です。

c getc2.for -- (extended version) get character from standard input
      integer*1 function getc(c)
      integer*1 c

      integer col,lastc
      integer*1 buf(82) ! MAXLINE(81)+1
      data lastc/81/    ! MAXLINE(81)
      data buf(81)/10/  ! MAXLINE(81) NEWLINE(10)
      data buf(82)/-2/  ! MAXLINE(81)+1 EOS(-2)

      lastc = lastc + 1
      if (buf(lastc) .eq. -2) then                ! EOS(-2)
          read(5,100,end=999) (buf(col),col=1,80) ! MAXCARD(80)
  100     format(80A1)                            ! MAXCARD(80)
          lastc = 1
          col = 80
          while (buf(col) .eq. 32) do  ! BLANK(32)
              col = col - 1
          end while
          buf(col+1) = 10         ! NEWLINE(10)
          buf(col+2) = -2         ! EOS(-2)
      endif

      c    = buf(lastc)
      getc = buf(lastc)
      return

  999 continue
      c    = -1 ! EOF(-1)
      getc = -1 ! EOF(-1)
      return
      end

一行読みとった後、行末から、行頭に向かって空白をスキャンし、空白以外の文字が出てきたら、 改めて、行末のマーキングをします。これで、余分な行末の空白の処理ができるようになりましたが、 一つ問題があります。全くの空白のみの行は、長さ０の行になってしまいます。今回は、これはまれな事とし、 めをつぶることとしました。

次は、サブルーチンputc()です。RATFOR版は次の通り。

# putc.r4 (simple version) -- put characters on standard output
      subroutine putc(c)
      character c

      character buf(MAXCARD)
      integer i,lastc
      data lastc /0/

      if (lastc >= MAXCARD | c == NEWLINE) {
          for (i = lastc+1; i <= MAXCARD; i = i + 1)
              buf(i) = BLANK
          write(STDOUT,100) (buf(i), i = 1, MAXCARD)
              100 format(MAXCARD a1)
          lastc = 0
          }
      if (c != NEWLINE)
          lastc = lastc + 1
          buf(lastc) = c
          }
      return
      end

for文が出てきています。これは、Watcom Fortran77にありません。 Cと同じように、初期設定、終了条件、再設定がコンパクトに書けます。 Watcom Fortran77では、while () do -- end whileを使用します。

c putc.for (simple version) -- put sharacter on standard output
      subroutine putc(c)
      integer*1 c

      integer*1 buf(80) ! MAXCARD(80)
      integer i,lastc
      data lastc/0/

      if ((lastc .ge. 80) .or. (c .eq. 10)) then ! MAXCARD(80) NEWLINE(10)
          i = lastc + 1
          while (i .le. 80) do             ! MAXCARD(80)
              buf(i) = 32                  ! BLANK(32)
              i = i + 1
          end while
          write(6,100) (buf(i),i=1,80)     ! MAXCARD(80)
  100     format(80a1)                     ! MAXCARD(80)
          lastc = 0
      endif
      if (c .ne. 10) then                  ! NEWLINE(10)
          lastc = lastc + 1
          buf(lastc) = c
      endif
      return
      end

一行８０文字にするために、空白文字を詰め合わせています。これでは、元の空白文字なのか、 詰め物か判別できませんし、固定長レコードにする、意味がWindowsにはありません。 行末の無駄な空白文字を書き出さないよう、lastc文字分しか書き出さないように変更しました。

c putc2.for (extended version 1) -- put sharacter on standard output
      subroutine putc(c)
      integer*1 c

      integer*1 buf(80) ! MAXCARD(80)
      integer i,lastc
      data lastc/0/

      if ((lastc .ge. 80) .or. (c .eq. 10)) then ! MAXCARD(80) NEWLINE(10)
          write(6,100) (buf(i),i=1,lastc)
  100     format(80a1)                     ! MAXCARD(80)
          lastc = 0
      endif
      if (c .ne. 10) then                  ! NEWLINE(10)
          lastc = lastc + 1
          buf(lastc) = c
      endif
      return
      end