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

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 -- サンプルサブルーチン

for文にであったら、初期設定・終了条件・再設定を取り出して、再設定は再設定用スタックに積み、 ラベルL、L+1、L+2を作りだし、

          continue
          初期設定
        L if ( .not. (終了条件)) goto L+2

      L+1 continue
          再設定
          goto L
      L+2 continue

forcod()のRatofor版は以下の通り。

# forcod.r4 -- generate code for beginning of for
      include ratfor.def
      subroutine forcod(lab)
      integer lab
      character t,token(MAXTOK)

      lab = labgen(3)
      call outcon(0)
      t = gtoken(token,MAXTOK)
      if (token(1) != LPAREN) {
          call outstr(token)
          call eatup
          call synerr('missing left parenthesis.')
          }
      else {
          call forini
          call forcnd(lab)
          call forrei
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c forcod.f -- generate code for beginning of for
      include ratfor.def
      subroutine forcod(lab)
      integer lab
      integer*1 t,token(MAXTOK)

      lab = labgen(3)
      call outcon(0)
      t = gtoken(token,MAXTOK)
      if (token(1) .ne. LPAREN) then
          call outstr(token)
          call eatup
          call synerr('missing left parenthesis.')
      else
          call forini
          call forcnd(lab)
          call forrei
      end if
      return
      end

ここで、forini()は初期設定を取り出しコードを生成し、 同様にforcnd()は終了条件を取り出し必要なコードを生成し、さらに、 forrei()は再設定を取り出しコードを生成します。

forini()のRatofor版は以下の通り。

# forini.r4 -- generate code for initialize
      include ratfor.def
      subroutine forini
      character gtoken,stmnt(MAXLINE),t,token(MAXTOK)
      integer junk,sappnd

      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);t != SEMICOL & t != EOF;t = gtoken(token,MAXTOK))
          junk = sappnd(token,stmnt,MAXTOK)
      if (stmnt(1) != EOS) {
          call outtab
          call outstr(stmnt)
          call outdon
          }
      if (t != EOF)
          call synerr('unexpected EOF.')
      return
      end

WATCOM Fortran77版は以下の通り。

c forini.f -- generate code for beginning of for
      include ratfor.def
      subroutine forini
      integer*1 gtoken,stmnt(MAXLINE),t,token(MAXTOK)
      integer junk,sappnd

      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while ((t .ne. SEMICOL) .and. (t .ne. EOF)) do
          junk = sappnd(token,stmnt,MAXTOK)
          t = gtoken(token,MAXTOK)
      end while
      if (stmnt(1) .ne. EOS) then
          call outtab
          call outstr(stmnt)
          call outdon
      end if
      if (t .eq. EOF) then
          call synerr('unexpected EOF.')
      end if
      return
      end

ここで、sappnd()は、文字バッファーがあふれないように確認しながら、文字列を追加します。

sappnd()のRatofor版は以下の通り。

# sappnd.r4 -- append str to body
      include ratfor.def
      integer function sappnd(str,body,maxsiz)
      character str(ARB),body(maxsiz)
      integer maxsiz
      integer i,j,length

      i = 1
      j = length(body) + 1
      sappnd = YES
      while (str(i) != EOS) {
          if (j >= maxsiz) then
              sappnd = NO
              exit
          end if
          body(j) = str(i)
          i = i + 1
          j = j + 1
          }
      body(j) = EOS
      return
      end

WATCOM Fortran77版は以下の通り。

c sappnd.f -- append str to body
      include ratfor.def
      integer function sappnd(str,body,maxsiz)
      integer*1 str(ARB),body(maxsiz)
      integer maxsiz
      integer i,j,length

      i = 1
      j = length(body) + 1
      sappnd = YES
      while (str(i) .ne. EOS) do
          if (j .ge. maxsiz) then
              sappnd = NO
              exit
          end if
          body(j) = str(i)
          i = i + 1
          j = j + 1
      end while
      body(j) = EOS
      return
      end

outdon()は、生成しているコードを実際に出力先に書き出します。

outdon()のRatofor版は以下の通り。

# outdon.r4 -- finish off an output line
      include ratfor.def
      subroutine outdon

      include coutln.ri

      outbuf(outp+1) = NEWLINE
      outbuf(outp+2) = EOS
      call putlin(outbuf,STDOUT)
      outp = 0
      return
      end

WATCOM Fortran77版は以下の通り。

c outdon.f -- finish off an output line
      include ratfor.def
      subroutine outdon

      include coutln.fi

      outbuf(outp+1) = NEWLINE
      outbuf(outp+2) = EOS
      call putlin(outbuf,STDOUT)
      outp = 0
      return
      end

forcnd()のRatofor版は以下の通り。

# forcnd.r4 -- get condition statementr of for
      include ratfor.def
      subroutine forcnd(lab)
      integer lab
      character gtoken,opstr(MAXTOK),stmnt(MAXTOK),t,token(MAXTOK)

      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);t != EOF & t != SEMICOL;t = gtoken(token,MAXTOK))
          if (islgop(token(1)) != YES) {
              call cnvop(token,opstr)
              junk = sappnd(opstr,stmnt,MAXTOK)
              }
          else
              junk = sappnd(token,stmnt,MAXTOK)
      if (stmnt(1) == EOS)
          call outcon(lab)
      else {
          call outnum(lab)
          call outtab
          call ifnot(stmnt,lab + 1)
          }
      if (t == EOF)
          call synerr('unexpected EOF.')
      return
      end

WATCOM Fortran77版は以下の通り。

c forcnd.f -- get condition statementr of for
      include ratfor.def
      subroutine forcnd(lab)
      integer lab
      integer*1 gtoken,opstr(MAXTOK),stmnt(MAXTOK),t,token(MAXTOK)

      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while ((t .ne. EOF) .and. (t .ne. SEMICOL)) do
          if (islgop(token(1)) .eq. YES) then
              call cnvop(token,opstr)
              junk = sappnd(opstr,stmnt,MAXTOK)
          else
              junk = sappnd(token,stmnt,MAXTOK)
          end if
          t = gtoken(token,MAXTOK)
      end while
      if (stmnt(1) .eq. EOS) then
          call outcon(lab)
      else
          call outnum(lab)
          call outtab
          call ifnot(stmnt,lab + 1)
      end if
      if (t .eq. EOF) then
          call synerr('unexpected EOF.')
      end if
      return
      end

ここで、islgop()は、tokenが論理演算子かどうかを判断します。

islgop()のRatofor版は以下の通り。

# islgop.r4 -- if c is operatr then return YES
      include ratfor.def
      integer function islgop(c)
      integer*1 c
      integer iindex
      integer*1 opcode(7)
      data opcode(1)/OPEQUAL/
      data opcode(2)/OPGTHAN/
      data opcode(3)/OPLTHAN/
      data opcode(4)/OPNOT/
      data opcode(5)/OPAND/
      data opcode(6)/OPOR/
      data opcode(7)/EOS/

      islgop = NO
      if (iindex(opcode,c) > 0)
          islgop = YES
      return
      end

WATCOM Fortran77版は以下の通り。

c islgop.f -- if c is operatr then return YES
      include ratfor.def
      integer function islgop(c)
      integer*1 c
      integer iindex
      integer*1 opcode(7)
      data opcode(1)/OPEQUAL/
      data opcode(2)/OPGTHAN/
      data opcode(3)/OPLTHAN/
      data opcode(4)/OPNOT/
      data opcode(5)/OPAND/
      data opcode(6)/OPOR/
      data opcode(7)/EOS/

      islgop = NO
      if (iindex(opcode,c) .gt. 0) then
          islgop = YES
      end if
      return
      end

forrei()のRatofor版は以下の通り。

# forrei.r4 -- save reinitialize statement of for
      include ratfor.def
      subroutine forrei
      character sappnd,stmnt(MAXTOK),t,token(MAXTOK)
      integer junk,nlpar

      nlpar = 0
      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);token(1) != EOF;t = gtoken(token,MAXTOK)) {
          if (nlpar == 0 & token(1) == RPAREN)
              exit
          junk = sappnd(token,stmnt,MAXTOK)
          if (token(1) == LPAREN)
              nlpar = nlpar + 1
          else if (token(1) == RPAREN)
              nlpar = nlpar - 1
          }
      call cspush(stmnt)
      return
      end

WATCOM Fortran77版は以下の通り。

c forrei.f -- save reinitialize statement of for
      include ratfor.def
      subroutine forrei
      integer*1 sappnd,stmnt(MAXTOK),t,token(MAXTOK)
      integer junk,nlpar

      nlpar = 0
      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while (token(1) .ne. EOF) do
          if (nlpar .eq. 0 .and. token(1) .eq. RPAREN) then
              exit
          end if
          junk = sappnd(token,stmnt,MAXTOK)
          if (token(1) .eq. LPAREN) then
              nlpar = nlpar + 1
          else if (token(1) .eq. RPAREN) then
              nlpar = nlpar - 1
          end if
          t = gtoken(token,MAXTOK)
      end while
      call cspush(stmnt)
      return
      end

cspush()は、再設定用スタックに、再設定を積みます。

cspush()のRatofor版は以下の通り。

# cspush.r4 -- push statment into code stack
      include ratfor.def
      subroutine cspush(stmnt)
      character stmnt(MAXTOK)
      integer length
      include cstack.ri
      
      cscnt = cscnt + 1
      if (cscnt > MAXTOK) then
          call error('Code stack overflow.')
      end if
      cslast = cslast + 1
      csstat(cscnt) = cslast
      call scopy(stmnt,1,csstck,cslast)
      cslast = cslast + length(stmnt) + 1
      return
      end

WATCOM Fortran77版は以下の通り。

c cspush.f -- push statment into code stack
      include ratfor.def
      subroutine cspush(stmnt)
      integer*1 stmnt(MAXTOK)
      integer length
      include cstack.fi
      
      cscnt = cscnt + 1
      if (cscnt .gt. MAXTOK) then
          call error('Code stack overflow.')
      end if
      cslast = cslast + 1
      csstat(cscnt) = cslast
      call scopy(stmnt,1,csstck,cslast)
      cslast = cslast + length(stmnt) + 1
      return
      end

再設定用スタックは、実際には、配列で表現されています。

cstackのRatofor版は以下の通り。

# cstack.ri -- code stack
      common /cstack/csstat,cscnt,cslast,csstck
      integer csstat(MAXTOK)            ! code pointer
      integer cscnt                     ! number of statments in stack; init = 0
      integer cslast                    ! last cstack filled; init = 0
      character csstck(MAXSTACK)        ! code stack
      data cscnt/0/
      data cslast/0/

WATCOM Fortran77版は以下の通り。

c cstack.fi -- code stack
      common /cstack/csstat,cscnt,cslast,csstck
      integer csstat(MAXTOK)            ! code pointer
      integer cscnt                     ! number of statments in stack; init = 0
      integer cslast                    ! last cstack filled; init = 0
      integer*1 csstck(MAXSTACK)        ! code stack
      data cscnt/0/
      data cslast/0/

forの終わりは、cspop()で再設定をスタックから取り出し、forsta()でコードを生成します。

forsta()のRatofor版は以下の通り。

# forsta.r4 -- generate code for end of for
      include ratfor.def
      subroutine forsta(lab)
      integer lab
      character stmnt(MAXTOK)

      call cspop(stmnt)
      if (stmnt(1) == EOS) {
          call outcon(lab + 2)
          call outtab
          call outgo(lab)
          call outcon(lab + 1)
          }
      else {
          call outcon(lab + 2)
          call outtab
          call outstr(stmnt)
          call outdon
          call outgo(lab)
          call outcon(lab + 1)
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c forsta.f -- generate code for end of for
      include ratfor.def
      subroutine forsta(lab)
      integer lab
      integer*1 stmnt(MAXTOK)

      call cspop(stmnt)
      if (stmnt(1) .eq. EOS) then
          call outcon(lab + 2)
          call outtab
          call outgo(lab)
          call outcon(lab + 1)
      else
          call outcon(lab + 2)
          call outtab
          call outstr(stmnt)
          call outdon
          call outgo(lab)
          call outcon(lab + 1)
      end if
      return
      end

cspop()のRatofor版は以下の通り。

# cspop.r4 -- pop statment into code stack
      include ratfor.def
      subroutine cspop(stmnt)
      character stmnt(MAXTOK)
      integer length
      integer p
      include cstack.fi
      
      if (cscnt <= 0)
          call error('Code stack underflow.')
      p = csstat(cscnt)
      call scopy(csstck(p),1,stmnt,1)
      cscnt = cscnt - 1
      cslast = cslast - length(stmnt) - 1
      return
      end

WATCOM Fortran77版は以下の通り。

c cspop.f -- pop statment into code stack
      include ratfor.def
      subroutine cspop(stmnt)
      integer*1 stmnt(MAXTOK)
      integer length
      integer p
      include cstack.fi
      
      if (cscnt .le. 0) then
          call error('Code stack underflow.')
      end if
      p = csstat(cscnt)
      call scopy(csstck(p),1,stmnt,1)
      cscnt = cscnt - 1
      cslast = cslast - length(stmnt) - 1
      return
      end

while文にであったら、whileの条件を取り出して、ラベルL、L+1を 作りだし、

          continue
        L if ( .not. (条件)) goto L+1

          goto L
      L+1 continue

whilec()のRatofor版は以下の通り。

# whilec.r4 -- generate code for beginning of while
      subroutine whilec(lab)
      integer lab

      call outcon(0)
      lab = labgen(2)
      call outnum(lab)
      call ifgo(lab+1)
      return
      end

WATCOM Fortran77版は以下の通り。

c whilec.f -- generate code for beginning of while
      subroutine whilec(lab)
      integer lab

      call outcon(0)
      lab = labgen(2)
      call outnum(lab)
      call ifgo(lab+1)
      return
      end

whileの終わりは、whiles()でコードを生成します。

whiles()のRatofor版は以下の通り。

# whiles.r4 -- generate code for end of while
      subroutine whiles(lab)
      integer lab

      call outgo(lab)
      call outcon(lab+1)
      return
      end

WATCOM Fortran77版は以下の通り。

c whiles.f -- generate code for end of while
      subroutine whiles(lab)
      integer lab

      call outgo(lab)
      call outcon(lab+1)
      return
      end