引数付きマクロ処理 -- 機能拡張(1)
2017-04-14


マクロが動くようになったので、バッチファイル"fim.bat"を作成し、マクロの展開に 使用する。

          @echo off
          rem fim.bat
          cd ..\src
          ..\exe\include < %1.f | ..\exe\macro > %1.for
          cd ..\bat

ここで、いくつかの有用な組み込み関数を追加する。追加する組み込み関数は、以下の通り。

簡単な例を以下に示す。

          define(EOF,-1)
          define(EOS,-2)
          define(MAXCARD,80)
          define(MAXLINE,[incr(MAXCARD)]) -- MAXLINEは81になる。
          define(FOO,0)
          define(STR1,ABCDE)
          define(STR2,12345)
          ifdef([BAR],STR1,STR2) -- BARは定義されていないので、"12345"が返る。
          ifdef([FOO],STR1,STR2) -- FOOは定義されているので、"ABCDE"が返る。
          substr(STR1,3,2) -- "CD"が返る。
          substr(STR2,3) -- "345"が返る。
          undef([FOO]) -- FOOを削除する。"[]"が必要である。
          define(compare,[ifelse($1,$2,YES,NO)]) -- 2つの引数が等しければ、YESを そうでなければNOを返すマクロ"compare"を定義する。

追加する組み込み関数のそれぞれの処理は、eval()の中で各処理ルーチンを呼び出す。新しいeval()は、以下の通り。

RATFOR版

# eval.r4 - expand args i through j: evaluate builtin or push back defn
      subroutine eval(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer iindex,length
      integer argno,k,m,n,t,td
      include cmacro.ri
      string digits "0123456789"

      t = argstk(i)
      td = evalst(t)
      if (td == DEFTYPE)
          call dodef(argstk,i,j)
      else if (td == INCTYPE)
          call doinc(argstk,i,j)
      else if (td == SUBTYPE)
          call dosub(argstk,i,j)
      else if (td == IFTYPE)
          call doif(argstk,i,j)
      else if (td == UDFTYPE)
          call doudf(argstk,i,j)
      else if (td == IFDTYPE) {
          call doifd(argstk,i,j)
          }
      else {
          for (k = t + length(evalst(t)) - 1; k > t); k = k - 1)
              if (evalst(k-1) != ARGFLAG)
                  call putbak(evalst(k))
              else {
                  argno = iindex(digits,evalst(k)) - 1
                  if (argno >= 0) {
                      n = i + argno + 1
                      m = argstk(n)
                      call pbstr(evalst(m))
                      }
                  k = k - 1     # skip over $
                  }
          if (k == t)           # do last character
              call putbak(evalst(k))
          }
      return
      end

WATCOM Fortran 77版は以下の通り。

c eval.f - expand args i through j: evaluate builtin or push back defn
      include ratfor.def
      subroutine eval(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer iindex,length
      integer argno,k,m,n,t,td,junk
      include cmacro.fi

      integer*1 digits(11)
      data digits(1)/LET0/
      data digits(2)/LET1/
      data digits(3)/LET2/
      data digits(4)/LET3/
      data digits(5)/LET4/
      data digits(6)/LET5/
      data digits(7)/LET6/
      data digits(8)/LET7/
      data digits(9)/LET8/
      data digits(10)/LET9/
      data digits(11)/EOS/

      t = argstk(i)
      td = evalst(t)
      if (td .eq. DEFTYPE) then
          call dodef(argstk,i,j)
      else if (td .eq. INCTYPE) then
          call doinc(argstk,i,j)
      else if (td .eq. SUBTYPE) then
          call dosub(argstk,i,j)
      else if (td .eq. IFTYPE) then
          call doif(argstk,i,j)
      else if (td .eq. UDFTYPE) then
          call doudf(argstk,i,j)
      else if (td .eq. IFDTYPE) then
          call doifd(argstk,i,j)
      else
          k = t + length(evalst(t)) - 1
          while (k .gt. t) do
              if (evalst(k-1) .ne. ARGFLAG) then
                  call putbak(evalst(k))
              else
                  argno = iindex(digits,evalst(k)) - 1
                  if (argno .ge. 0) then
                      n = i + argno + 1
                      m = argstk(n)
                      call pbstr(evalst(m))
                  end if
                  k = k - 1       ! skip over $
              end if
              k = k - 1
          end while
          if (k .eq. t) then
              call putbak(evalst(k))
          end if
      end if
      return
      end

メインルーチンmacroでは、追加した組み込み関数を登録する必要がある。

RATFOR版は以下の通り。


続きを読む

[コンピューター]
[RATFOR]

コメント(全2件)
コメントをする


記事を書く
 powered by ASAHIネット