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

まずは、concatから。

concatは、引数にファイルを指定します。指定したファイルをひとつながりにして標準出力に書き出します。

     concat file1 file2 file2 ...

concatのメイン部分は下記の通り。引数がなくなるまで取り出し、 取り出してはファイルをオープンし標準出力に書き出します。

RATFOR版は下記の通り。

# concat.r4 -- concatenate named files onto standard output
      character name(NAMESIZE)
      integer getarg, fopen
      integer fin,i

      call initfile()

      for (i = 1; getarg(i,name,NAMESIZE) != EOF; i = i + 1) {
          fin = fopen(fin,name,READ)
          if (fin == ERR)
              call cant(name)
          end if
          call fcopy(fin,STDOUT)
          call fclose(fin)
     }
     stop
     end

WATCOM fortran77版は下記の通り。

c concat.for -- concatinate named files onto standard output
      program concat
      integer getarg,fopen
      integer fin,i
      integer*1 name(81)                  ! NAMESIZE(81)
 
      call initfile()
 
      i = 1
      while (getarg(i,name,81) .ne. -1) do  ! NAMESIZE(81) EOF(-1)
          if (fopen(fin,name,82) .eq. -1) then ! READ(LETR) ERR(-1)
              call cant(name)
          end if
          call fcopy(fin,6)             ! STDOUT(6)
          call fclose(fin)
          i = i + 1
      end while
      stop
      end

実際の書き出しはfcopy()が行います。fcopy()は次の通り。

まずは、RATFOR版。

# fcopy.r4 -- copy file in to file out
      subroutine fcopy(in,out)
      integer in,out
      character buf(MAXLINE+1)
      integer getlin
      
      while (getlin(buf,in) != EOF)
          call putlin(buf,out)
      return
      end

このように、単純に入力を出力に書き出します。

WATCOM Fortran77版。

c fcopy.for -- copy file in to file out
      subroutine fcopy(in,out)
      integer in,out
      integer*1 buf(81+1) ! MAXLINE(81)+1
      integer getlin
      
      while (getlin(buf,in) .ne. -1) do ! EOF(-1)
          call putlin(buf,out)
      end while
      return
      end

次に、xprintです。xprintは、ファイルを、1ページに、ファイル名とページ番号を適当に書き出すものです。

引数がなかった場合は、標準入力から読み込みます。この時はヘッダー部分にファイル名を書きません。

xprintのメインは下記の通り。

まずは、RATFOR版。

# xprint (default input STDIN)-- print files with headings
      character name(NAMESIZE)
      integer getarg,fopen
      integer fin,i
      string null ""

      call initfile()
      for (i = 1; getarg(i,name,NAMESIZE) != EOF; i = i + 1) {
          if (fopen(fin,name,READ) == ERR)
              call cant(name)
          end if
          call fprint(name,fin)
          call fclose(fin)
          }
      if (i == 1)
          call fprint(null,STDIN)

      stop
      end

WATCOMFortran77版は下記の通り。

c xprint (default input STDIN)-- print files with headings
      program xprint
      integer*1 name(81)                ! NAMESIZE(81)
      integer getarg,fopen
      integer fin,i
      integer*1 null
      data null/' '/

      call initfile()
      i = 1
      while(getarg(i,name,81) .ne. -1) do ! NAMESIZE(81) ERR(-1)
          if (fopen(fin,name,82) .eq. -1) then ! READ(LETR) ERR(-1)
              call cant(name)
          end if
          call fprint(name,fin)
          call fclose(fin)
          i = i + 1
      end while
      
      if (i .eq. 1) then
          call fprint(null,5)           ! STDIN(5)
      end if
      stop
      end

使い方は、下記の通り。

     xprint file

実際の書き出しは、fprint()が行います。fprint()は下記の通り。

RATFOR版です。

# fprint.r4 -- print file name from fin
      subroutine fprint(name,fin)
      character name(NAMESIZE),line(MAXLINE+1)
      integer fin,lineno,pageno
      integer getlin

      lineno = 0
      pageno = 0
      while (getlin(line,fin) != EOF) {
          if (lineno == 0) {
              call skip(MARGIN1)
              pageno = pageno + 1
              call head(name,pageno)
              call skip(MARGIN2)
              loneno = MARGIN1 + MARGIN2 + 1
              }
          call putlin(line,STDOUT)
          lineno = lineno + 1
          if (lineno >= BOTTOM) {
              call skip(PAGELEN-lineno)
              lineno = 0
              }
          }
      if (lineno > 0)
          call skip(PAGELEN-lineno)
      return
      end

WATCOM Fortran77版は下記の通り。

c fprint.for -- print file name from fin
      subroutine fprint(name,fin)
      integer*1 name(81)                ! NAMESIZE(81)
      integer fin
      integer*1 line(81+1)              ! MAXLINE(81)
      integer getlin,lineno,pageno

      lineno = 0
      pageno = 0
      while (getlin(line,fin) .ne. -1) do ! EOF(-1)
          if (lineno .eq. 0) then
              call skip(2)              ! MARGIN1(2)
              pageno = pageno + 1
              call head(name,pageno)
              call skip(3)              ! MARGIN2(3)
              loneno = 2 + 3 + 1
          endif
          call putlin(line,6) ! STDOUT(6)
          lineno = lineno + 1
          if (lineno .ge. 62) then      ! BOTTOM(62)
              call skip(66-lineno)      ! PAGELEN(66)
              lineno = 0
          endif
      end while
      if (lineno .gt. 0) then
          call skip(66-lineno)          ! PAGELEN(66)
      end if
      return
      end

MARGIN1,MARGIN2,BOTTOM,PAGELENはLetterサイズの用紙に合わせてありますので、 A4に書き出すときは変更が必要です。また、1行80文字で書き出すので、A4縦では はみ出してしまいますので、注意が必要です。

下請けルーチンのskip()は下記の通り。指定された分だけ改行を出力します。

RATFOR版。

# skip.r4 -- output n blank lines
      subroutine skip(n)
      integer i,n

      for (i = 1; i <= n; i = i + 1)
          call putc(NEWLINE)
      return
      end

WATCOM Fortran77版。

c skip.for -- output n blank lines
      subroutine skip(n)
      integer i,n

      i = 1
      while (i .le. n) do
          call putc(10)                 ! NEWLINE(10)
          i = i + 1
      end while
      return
      end

また、ヘッダーを書くhead()は下記の通り。

RATFOR版。

# head.r4 -- print top of page header
      subroutine head(name,pageno)
      character name(NAMESIZE)
      integer pageno
      string page "  page "

      call putlin(name,STDOUT)
      call putlin(page,STDOUT)
      call putdec(pageno,1)
      call putc(NEWLINE)
      return
      end

WATCOMM Fortran版。

c head.for -- print top of page header
      subroutine head(name,pageno)
      integer*1 name(81)                ! NAMESIZE(81)
      integer pageno
      integer*1 page(8)
      data page/' ',' ','p','a','g','e',' ',-2/ ! EOS(-2)

      call putlin(name,6)               ! STDOUT(6)
      call putlin(page,6)               ! STDOUT(6)
      call putdec(pageno,1)
      call putc(10)                     ! NEWLINE(10)
      return
      end