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

WATCOM fortran 77版Ratforプリプロセッサが、動き出しましたので、 実際に、Ratforで書かれたツールの動作テストを行っています。やはり、例外なく、 プログラムのミスで不具合が出ていますので、これを修正しながら、Ratfor版の ツールの完成を目指しています。

基本的なファイル操作fopen()に不具合がありましたので、改修したコードを 掲載します。

改修したRatfor版のfopen()は以下の通りです。

# fopen.r4 -- connect internal file despter and external file
include ratfor.mac
integer function fopen(uid,fn,act)
integer act,uid
character fn(ARB)
[character]*MAXLINE cfn
include files

call is2cs(fn,cfn,MAXLINE)
for (uid = 1; uid <= MAXFILES; uid = uid + 1)
    if (finuse(uid) == NOUSE) {
        if (act == READ) {
            open(unit=uid,file=cfn,action='[READ]',status='[OLD]',err=99)
            uid = uid
            finuse(uid) = INUSE
            flastcr(uid) = MAXLINE
            fbuf(uid,MAXLINE) = NEWLINE
            fnew(uid) = NO
            fmode(uid) = act
            }
        else if (act == WRITE) {
            open(unit=uid,file=cfn,action='[WRITE]',status='[UNKNOWN]',err=99)
            uid = uid
            finuse(uid) = INUSE
            flastcw(uid) = 0
            fmode(uid) = act
            }
        else if (act == READWRITE) {
            open(unit=uid,file=cfn,action='[READWRITE]',status='[OLD]',err=99)
            uid = uid
            finuse(uid) = INUSE
            flastcr(uid) = MAXLINE
            flastcw(uid) = 0
            fbuf(uid,MAXLINE) = NEWLINE
            fnew(uid) = NO
            fmode(uid) = act
            }
        else {             # error
            uid = ERR
            fopen = ERR
            return
            }
        fopen = uid
        return
        }
99 continue
uid = ERR
fopen = ERR
return
end

WATCOM fotran77版のfopen()は以下の通りです。

c fopen.f -- connect internal file descripter and external file
      include ratfor.def
      integer function fopen(uid,fname,act)
      integer uid
      integer*1 act,fname(ARB)
      character*MAXLINE cfn
      include files.fi

      call is2cs(fname,cfn,MAXLINE)
      uid = 1
      while (uid .le. MAXFILES) do
          if (finuse(uid) .eq. NOUSE) then
              if (act .eq. READ) then
                  open(unit=uid,file=cfn,action='READ',
     1                 status='OLD',err=99)
                  fopen = uid
                  finuse(uid) = INUSE
                  flastcr(uid) = MAXLINE
                  fbuf(uid,MAXLINE) = NEWLINE
                  fnew(uid) = NO
                  fmode(uid) = act
              else if (act .eq. WRITE) then
                  open(unit=uid,file=cfn,action='WRITE',
     1                 status='UNKNOWN',err=99)
                  fopen = uid
                  finuse(uid) = INUSE
                  flastcw(uid) = 0
                  fmode(uid) = act
              else if (act .eq. READWRITE) then
                  open(unit=uid,file=cfn,action='READWRITE',
     1                 status='OLD',err=99)
                  fopen = uid
                  finuse(uid) = INUSE
                  flastcr(uid) = MAXLINE
                  flastcw(uid) = 0
                  fbuf(uid,MAXLINE) = NEWLINE
                  fnew(uid) = NO
                  fmode(uid) = act
              else                      ! error
                   uid = ERR
                   fopen = uid
              end if
              return
          endif
          uid = uid + 1
      end while
   99 continue
      uid = ERR
      fopen = ERR
      return
      end

これ以外にも、単純なタイプミスも含めて、多くの修正点があります。 近くに、まとめてご紹介できるよう考えています。