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

ファイルの内容見出しの手続きtable()を紹介します。

table()は、書庫を開き、書庫内の各ファイルについて、引数のファイルと一致する ならば、ファイル情報を書き出します。

table()のRATFOR版は以下の通り。

# table.r4 -- print table of archive contents
      subroutine table(aname)
      integer*1 aname(NAMESIZE)
      integer*1 in(MAXLINE),lname(NAMESIZE)
      integer filarg,fopen,gethdr
      integer afd,size,i
      
      if (fopen(afd,aname,82) == ERR)
          call cant(aname)
      while (gethdr(afd,in,lname,size) != EOF) {
          if (filarg(lname) == YES)
              call tprint(lname)
          call fskip(afd,size)
          }
      call notfnd
      return
      end

WATCOM fortran77版は、以下の通り。

c table.for -- print table of archive contents
      subroutine table(aname)
      integer*1 aname(81)               ! NAMESIZE(81)
      integer*1 in(81),lname(81)       ! MAXLINE(81) NAMESIZE(81)
      integer filarg,fopen,gethdr
      integer afd,size

      if (fopen(afd,aname,82) .eq. -1) then  ! READ(LETR) ERR(-1)
          call cant(aname)
      end if
      while (gethdr(afd,in,lname,size) .ne. -1) do ! EOF(-1)
          if (filarg(lname) .eq. 1) then ! YES(1)
              call tprint(lname)
          endif
          call fskip(afd,size)
      end while
      call notfnd
      return
      end

tprint()は、ヘッダーから必要項目、ファイル名とサイズを書き出します。

RATFOR版は下記の通り。

# tprint.r4 -- print table entry for one member
      subroutine tprint(buf)
      character buf(ARB)

      call putlin(buf,STDOUT)
      call putc(NEWLINE)
      return
      end

WATCOM Fortran77版は下記の通り。

c tprint.for -- print table entry for one member
      subroutine tprint(buf)
      integer*1 buf(*)                  ! ARB(*)
      
      call putlin(buf,6)                ! STDOUT(6)
      call putc(10)                     ! NEWLINE(10)
      return
      end

ヘッダーを取り出すのは、gethdr()です。 書庫ファイルの終わりに達した時はEOFを返します。

RATFOR版は下記の通り。

# gethdr.r4 -- get header into from fd
      integer function gethdr(fd,buf,name,size)
      integer fd,i,len,size
      character buf(MAXLINE),name(NAMESIZE),temp(NAMESIZE)
      integer getlin,getwrd,ctoi,equal
      string hdr "-h-"

      if (getlin(buf,fd) == EOF) {
          gethdr = NO
          return
          }
      i = 1
      len = getwrd(buf,i,temp)
      if (equal(temp,hdr) == YES)
          call error('archive not in proper format.')
      gethdr = YES
      len = getwrd(buf,i,name)
      size = ctoi(buf,i)
      return
      end

WATCOM Fortran77版は下記の通り。

c gethdr.for -- get header into from fd
      integer function gethdr(fd,buf,name,size)
      integer fd,size
      integer*1 buf(81),name(81),temp(81) ! MAXLINE(81) NAMESIZE(81)
      integer getlin,getwrd,ctoi,equal
      integer*1 hdr(4)
      data hdr/'-','h','-',-2/

      if (getlin(buf,fd) .eq. -1) then  ! EOF(-1)
          gethdr = -1                   ! EOF(-1)
          return
      end if
      i = 1
      len = getwrd(buf,i,temp)
      if (equal(temp,hdr) .eq. 0) then  ! NO(0)
          call error('archive not in proper format.')
      end if
      gethdr = 1                        ! YES(1)
      len = getwrd(buf,i,name)
      size = ctoi(buf,i)
      return
      end

fskip()は、ファイルfdをn文字読みどばします。

RATFOR版は下記の通り。

# fskip.r4 -- skip n characters on the fd
      subroutine fskip(fd,n)
      integer fd,n
      
      character fgetc,c
      integer i
      
      for (i = 1;i <= n; i = i + 1)
          if (fgetc(fd,c) == EOF)
              break
      return
      end

WATCOM Fortran77版は下記の通り。

c fskip.for -- skip n characters on the fd
      subroutine fskip(fd,n)
      integer fd,n
      integer*1 fgetc,c
      integer i,junk

      i = 1
      while (i .le. n) do
          if (fgetc(fd,c) .eq. -1) then ! EOF(-1)
              exit
          end if
          i = i + 1
      end while
      return
      end

filarg()は書庫から取り出したファイル名が引数にあるかどうかを 判断します。ただし、引数がない場合は常にありと判断します。

RATFOR版は下記の通り。

# filarg.r -- check if name maches argument list
      integer function filarg(name)
      character name(ARB)
      integer equal,i

      include carch.fi

      if (nfiles <= 0) then
          filarg = YES
          return
      end if

      for (i = 1;i <= nfiles; i = i + 1)
          if (equal(name,fname(1,i)) == YES) {
              fstat(i) = YES
              filarg   = YES
              return
              }
      filarg = NO
      return
      end

WATCOM Fortran77版は下記の通り。

c filarg.f -- check if name maches argument list
      integer function filarg(name)
      integer*1 name(*)                 ! ARB(*)
      integer equal,i

      include carch.fi

      if (nfiles .le. 0) then
          filarg = 1                    ! YES(1)
          return
      end if

      i = 1
      while (i .le. nfiles) do
          if (equal(name,fname(1,i)) .eq. 1) then ! YES(1)
              fstat(i) = 1              ! YES(1)
              filarg   = 1              ! YES(1)
              return
          endif
          i = i + 1
      end while
      filarg = 0                        ! NO(0)
      return
      end

notfnd()は指定されたファイルが見つからなかったときに、メッセージを 書き出します。

RATFOR版は下記の通り。

#�notfnd.r -- print "not find" message
      subroutine notfnd
      integer i

      include carch.fi

      for (i = 1;i <= nfiles; i = i + 1)
          if (fstat(i) == NO) {
              call putlin(fname(1,i),ERROUT)
              call remark(':not in archive.')
              errcnt = errcnt + 1
              }
      return
      end

WATCOM Fortran77版は下記の通り。

c notfnd.f -- print "not find" message
      subroutine notfnd
      integer i

      include carch.fi

      i = 1
      while (i .le. nfiles) do
          if (fstat(i) .eq. 0) then     ! NO(0)
              call putlin(fname(1,i),6) ! ERROUT(6)
              call remark(':not in archive.')
              errcnt = errcnt + 1
          end if
          i = i + 1
      end while
      return
      end

次回は、残ったルーチンについて説明します。