concatとxprint ― 2015年04月19日 09:16
まずは、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
最近のコメント