コードの改修 -- 名前付き共通領域の初期化の改善 マクロテーブル2017年08月01日 16:37

マクロテーブルに関する共通領域の初期化は、inittbl()で行っていましたが、 これをdata文で静的に初期化することとします。

Ratfor版のclook.riは以下の通りです。

# clook.ri
      common /clook/lastp,lastt,namptr,table
      integer lastp           # last used in namptr; init = 0
      integer lastt           # last used in table; init = 0
      integer namptr(MAXPTR)  # name pointers
      character table(MAXTBL) # actual text of names and defns
      data lastp/0/
      data lastt/0/

WATCOM fotran77版のfiles.fiは以下の通りです。

c clook.fi
      common /clook/lastp,lastt,namptr,table
      integer lastp           ! last used in namptr; init = 0
      integer lastt           ! last used in table; init = 0
      integer namptr(MAXPTR)  ! name pointers
      integer*1 table(MAXTBL) ! actual text of names and defns
      data lastp/0/
      data lastt/0/

files.ri、files.fiの変更により再コンパイルが必要になるファイルは、以下の通りです。

          instal.f
          lookup.f
          uninst.f

これらは、macroが動き出す前のファイルですので、macroを使用する版を再掲します。

instal()のRatfor版は以下の通りです。

# instal.r4 -- add name and definition to table
      subroutine instal(name,defn)
      character name(MAXTOK),defn(MAXDEF)
      integer length
      integer dlen,nlen
      include clook.ri

      nlen = length(name) + 1
      dlen = length(defn) + 1
      if (lastt+nlen+dlen > MAXTBL | lastp >= MAXPTR) {
         call putlin(name,ERROUT)
         call remark(':too many definitions.')
         }
      lastp = lastp + 1
      namptr(lastp) = lastt + 1
      call scopy(name,1,table,lastt+1)
      call scopy(defn,1,table,lastt+nlen+1)
      lastt = lastt + nlen + dlen
      return
      end

instal()のWATCOM fortran77版は以下の通りです。

c instal.f -- add name and definition to table
      include ratfor.def
      subroutine instal(name,defn)
      integer*1 name(MAXTOK),defn(MAXDEF)
      integer length
      integer dlen,nlen
      include clook.fi

      nlen = length(name) + 1
      dlen = length(defn) + 1
      if ((lastt+nlen+dlen .gt. MAXTBL) .or. (lastp .ge. MAXPTR)) then
         call putlin(name,ERROUT)
         call remark(':too many definitions.')
      end if
      lastp = lastp + 1
      namptr(lastp) = lastt + 1
      call scopy(name,1,table,lastt+1)
      call scopy(defn,1,table,lastt+nlen+1)
      lastt = lastt + nlen + dlen
      return
      end

lookup()のRatfor版は以下の通りです。

# lookup.r4 -- locate name, extract definition from table
      integer function lookup(name,defn)
      character name(MAXDEF),defn(MAXTOK)
      integer i,j,k
      include clook.fi

      for (i = lastp;i > 0; i = i - 1) {
         j = namptr(i)
         for (k = 1;name(k) == table(j) & name(k) != EOS; k = k + 1)
             j = j + 1
         if (name(k) == table(j)) {     # got one
             call scopy(table,j+1,defn,1)
             lookup = YES
             return
             }
         }
      lookup = NO
      return
      end

lookup()のWATCOM fortran77版は以下の通りです。

c lookup.f -- locate name, extract definition from table
      include ratfor.def
      integer function lookup(name,defn)
      integer*1 name(MAXDEF),defn(MAXTOK)
      integer i,j,k
      include clook.fi

      i = lastp
      while (i .gt. 0) do
         j = namptr(i)
         k = 1
         while ((name(k) .eq. table(j)) .and. (name(k) .ne. EOS)) do
             j = j + 1
             k = k + 1
         end while
         if (name(k) .eq. table(j)) then ! got one
             call scopy(table,j+1,defn,1)
             lookup = YES
             return
         end if
          i = i - 1
      end while
      lookup = NO
      return
      end

uninst()のRatfor版は以下の通りです。

# uninst.r4 -- undefine macro
      subroutine uninst(defnam)
      character defnam(MAXTOK)
      character name(MAXTOK),defn(MAXDEF)
      integer i,nlen,dlen
      integer length,equal
      include clook.fi

      lastt = 0
      for (i = 1; i <= lastp; i = i + 1) {
          call scopy(table,namptr(i),name,1)
          if (equal(defnam,name) == NO) {
              nlen = length(name) + 1
              call scopy(table,namptr(i) + nlen,defn,1)
              dlen = length(defn) + 1
              namptr(i) = lastt + 1
              call scopy(name,1,table,lastt+1)
              call scopy(defn,1,table,lastt+nlen+1)
              lastt = lastt + nlen + dlen
              }
          }
      lastp = lastp - 1
      return
      end

uninst()のWATCOM fortran77版は以下の通りです。

c uninst.f -- purge macro
      include ratfor.def
      subroutine uninst(defnam)
      integer*1 defnam(MAXTOK)
      integer*1 name(MAXTOK),defn(MAXDEF)
      integer i,nlen,dlen
      integer length,equal
      include clook.fi

      lastt = 0
      i = 1
      while (i .le. lastp) do
          call scopy(table,namptr(i),name,1)
          if (equal(defnam,name) .eq. NO) then
              nlen = length(name) + 1
              call scopy(table,namptr(i) + nlen,defn,1)
              dlen = length(defn) + 1
              namptr(i) = lastt + 1
              call scopy(name,1,table,lastt+1)
              call scopy(defn,1,table,lastt+nlen+1)
              lastt = lastt + nlen + dlen
          end if
          i = i + 1
      end while
      lastp = lastp - 1
      return
      end

また、inittbl()が不要になることで再コンパイルが必要になるファイルは、以下の通りです。

          define.f
          macro.f

実際の変更点については割愛します。

コードの改修 -- ファイルのオープン(一部修正)2017年08月10日 17:07

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

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

Ratforプレプロセッサー -- 変換の実例2017年08月16日 20:29

Ratforが動き出しましたので、実際に、Ratforデーコーディングしたコードが、 そのように、変換されるかをご紹介します。

Software Toolsで最初に紹介されている、copyはどのようになるでしょうか。 まずは、元となるRatforのコードをしめします。

# copy.r4 -- copy input characters to output
include ratfor.mac
program copy
character getc
character c

while (getc(c) != EOF)
    call putc(c)
stop
end

これを、include、macro、ratforを等した結果は、以下のようになります。

      programcopy
      integer*1getc
      integer*1c
      continue
50000 if (.not. (getc(c) .ne. -1)) goto 50001
      callputc(c)
      goto 50000
50001 continue
      stop
      end

いくつか注意すべき点があります。"programcopy"、"callputc"は、コンパイルエラーになりそうですが、 そうはなりません。それぞれ、"program copy"、"call putc"とWATCOM Fortran 77コンパイラーは、 解釈しますので、コンパイルエラーを生じません。

この程度の変換では、返還後のコードを人が解釈するには、抵抗を感じませんが、複雑になると抵抗を 感じます。たとえば、getfns.r4を見てみますと、

getfns.r4は以下の通りですが、

# getfns.r4 -- get file names into fname, check for duplicates
include ratfor.mac
subroutine getfns()
integer equal,getarg,i,j
character junk(2)
include carch

errcnt = 0
for (i = 1; i <= MAXFILES; i = i + 1)
     if (getarg(i+2,fname(1,i),NAMESIZE) == EOF)
         break
nfiles = i - 1
if (i > MAXFILES)
    if (getarg(i+2,junk,2) != EOF)
        call error('too many files.')
for (i = 1; i <= nfiles; i = i + 1)
    fstat(i) = NO
for (i = 1; i < nfiles; i = i + 1)
    for (j = i + 1; j <= nfiles; j = j + 1)
        if (equal(fname(1,i),fname(1,j)) == YES) {
            call putlin(fname(1,i),ERROUT)
            call error(': duplicate file name.')
            }
return
end

返還後はの要になります。

      subroutinegetfns()
      integerequal,getarg,i,j
      integer*1junk(2)
      common/carch/fname(81,20),fstat(20),nfiles,errcnt
      integer*1fname
      integerfstat
      integernfiles
      integererrcnt
      errcnt=0
      continue
      i=1
50000 if (.not. (i .le. 20))goto 50001
      if (.not. (getarg(i+2,fname(1,i),81) .eq. -1)) goto 50003
      goto 50001
50003 continue
50002 continue
      i=i+1
      goto 50000
50001 continue
      nfiles=i-1
      if (.not. (i .gt. 20)) goto 50005
      if (.not. (getarg(i+2,junk,2) .ne. -1)) goto 50007
      callerror(15Htoo many files.)
50007 continue
50005 continue
      continue
      i=1
50009 if (.not. (i .le. nfiles))goto 50010
      fstat(i)=0
50011 continue
      i=i+1
      goto 50009
50010 continue
      continue
      i=1
50012 if (.not. (i .lt. nfiles))goto 50013
      continue
      j=i+1
50015 if (.not. (j .le. nfiles))goto 50016
      if (.not. (equal(fname(1,i),fname(1,j)) .eq. 1)) goto 50018
      callputlin(fname(1,i),6)
      callerror(22H: duplicate file name.)
50018 continue
50017 continue
      j=j+1
      goto 50015
50016 continue
50014 continue
      i=i+1
      goto 50012
50013 continue
      return
      end

この程度になると、読む気が起きません。印刷して鉛筆でジャンプ先に印をつける必要があるようです。

Ratforファイルの公開2017年08月19日 10:51

Ratfor関連のファイルを公開します。 ファイルは、下記からダウンロードできます。

ratfor.zip (3,827,191Byte)

このファイルの内容は、以下の通りです。

ディレクトリー構成
\
|- Readme.txt -- このファイル
|- fortran -- WATCOM fortran 77版に関するのファイルを収めたサブディレクトリー
|    |- make -- コンパイルに関するバッチファイルを納めたサブディレクトリー
|    |    |- r4.bat -- マクロを使ってで書かれたソースをinclude->macroと前処理し
|    |    |            WATCOM fortran 77コンパイルできるソースに変換する
|    |    |- fc.bat -- WATCOM fortran 77で書かれたソースをコンパイルする
|    |    |- fo.bat -- オブジェクトファイルをライブラリーに登録する
|    |    |- fl.bat -- オブジェクトファイルをリンクする
|    |    +- alldone.bat -- 全ソースファイルをコンパイルし実行モジュールを作成する
|    |- src -- 全ソースファイルを納めたサブディレクトリー
|    |- for -- include->macro前処理後のソースファイルを納めたサブディレクトリー
|    |         WATCOM Fortran 77でコンパイルできるファイル
|    |- obj
|    |    |- *.obj -- メインプログラムのオブジェクトファイル
|    |    |- ratfor.lib -- メインプログラム以外のオブジェクトファイルを納めたライブラリー
|    |    |- ratfor.bak -- ratfor.libのバックアップ
|    |    |                オブジェクトファイルを追加・削除すると作成される
|    |    +- ratfor.lst -- ratfor.libに納められた、オブジェクトのリスト
|    +- exe -- 実行モジュールを納めたサブディレクトリー
+- ratfor -- Ratfor版に関するファイルを納めたサブディレクトリー
     |- make -- コンパイルに関するバッチファイルを納めたサブディレクトリー
     |    |- r4.bat -- Ratforで書かれたソースをinclude->macroと前処理し
     |    |            WATCOM fortran 77でコンパイルする
     |    |- fo.bat -- オブジェクトファイルをライブラリーに登録する
     |    |- fl.bat -- オブジェクトファイルをリンクする
     |    +- alldone.bat -- 全ソースファイルをコンパイルし実行モジュールを作成する
     |- src -- 全ソースファイルを納めたサブディレクトリー
     |- for -- include->macroと前処理後のソースファイルを納めたサブディレクトリー
     |         WATCOM Fortran 77でコンパイルできるファイル
     |- obj
     |    |- ratfor.lib -- メインプログラム以外のオブジェクトファイルを納めたライブラリー
     |    |- ratfor.bak -- ratfor.libのバックアップ
     |    |                オブジェクトファイルを追加・削除すると作成される
     |    +- ratfor.lst -- ratfor.libに納められた、オブジェクトのリスト
     |- exe -- 実行モジュールを納めたサブディレクトリー
     +- myproj -- サンプルプログラムを収めたディレクトリー
          |- r4.bat -- Ratforで書かれたソースをinclude->macroと前処理し
          |            WATCOM fortran 77でコンパイルする
          |- fo.bat -- オブジェクトファイルをライブラリーに登録する
          |- fl.bat -- オブジェクトファイルをリンクする
          |- hello.r4 -- サンプルプログラム(メイン)
          |- message.r4 -- サンプルプログラム(サブルーチン)
          +- mylib.lib -- サンプルサブルーチン