引数付きマクロ処理 -- 機能拡張(2): アナクロなコンピューターエンジニアのつぶやき

組み込み関数"ifelse"の実装は以下の通り。

RATFOR版

# doif.f -- select one of two arguments
      include ratfor.def
      subroutine doif(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer equal
      integer a2,a3,a4,a5

      include cmacro.ri

      if (j-i < 5)
          return

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      a5 = argstk(i + 5)

      if (equal(evalst(a2),evalst(a3)) == YES)
          call pbstr(evalst(a4))
      else
          call pbstr(evalst(a5))
      return
      end

WATCOM Fortran 77版は以下の通り。

c doif.f -- select one of two arguments
      include ratfor.def
      subroutine doif(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer equal
      integer a2,a3,a4,a5

      include cmacro.fi

      if (j-i .lt. 5) then
          return
      end if

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      a5 = argstk(i + 5)

      if (equal(evalst(a2),evalst(a3)) .eq. YES) then
          call pbstr(evalst(a4))
      else
          call pbstr(evalst(a5))
      end if
      return
      end

組み込み関数"incr"は、引数を数値化して、下請けルーチンpbnum()で+1し、文字列化して入力に戻す。"incr"の実装は 以下の通り。

RATFOR版

# doinc.r4 -- increment argument by 1
      include ratfor.def
      subroutine doincr(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi
      integer k

      include cmacro.ri

      k = argstk(i+2)
      call pbnum(ctoi(evalst,k)+1)
      return
      end

WATCOM Fortran 77版は以下の通り。

c doinc.f -- increment argument by 1
      include ratfor.def
      subroutine doinc(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi
      integer k

      include cmacro.fi

      k = argstk(i+2)
      call pbnum(ctoi(evalst,k)+1)
      return
      end

下請けルーチンpbnum()は以下の通り。

RATFOR版は以下の通り。

# pbnum.r4 -- convert number to string, push back on input
      include ratfor.def
      subroutine pbnum(n)
      integer n
      integer mod
      integer m,num
      string digits "0123456789"

      num = n
      repeat {
          m = mod(num,10)
          call putbak(digits(m+1))
          num = num/10
          } until (num == 0)
      return
      end

WATCOM Fortran 77版は以下の通り。

c pbnum.f -- convert number to string, push back on input
      include ratfor.def
      subroutine pbnum(n)
      integer n
      integer mod
      integer m,num
      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/

      num = n
      loop
          m = mod(num,10)
          call putbak(digits(m+1))
          num = num/10
      until (num .eq. 0)
      return
      end

組み込み関数"substr"の実装は、以下の通り。

RATFOR版は以下の通り。

# dosub.r4 -- select substring
      include ratfor.def
      subroutine dosub(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi,length,min
      integer ap,fc,k,nc

      include cmacro.ri

      if (j-i < 3)
          return
      if (j-i < 4)
          nc = MAXTOK
      else {
          k = argstk(i+4)
          nc = ctoi(evalst,k)           # number of characters
          }
      k = argstk(i+3)                   # origin
      ap = argstk(i+2)                  # target string
      fc = ap + ctoi(evalst,k) - 1      # first char of substring
      if ((fc >= ap) & (fc < ap+length(evalst(ap)))) { # subarrays
          k = fc + min(nc,length(evalst(fc))) - 1
          for ( ; k >= fc ; k = k -1)
              call putbak(evalst(k))
          }
      return
      end

WATCOM Fortran 77版は以下の通り。

c dosub.f -- select substring
      include ratfor.def
      subroutine dosub(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi,length,min
      integer ap,fc,k,nc

      include cmacro.fi

      if (j-i .lt. 3) then
          return
      end if
      if (j-i .lt. 4) then
          nc = MAXTOK
      else
          k = argstk(i+4)
          nc = ctoi(evalst,k)      ! number of characters
      end if
      k = argstk(i+3)              ! origin
      ap = argstk(i+2)             ! target string
      fc = ap + ctoi(evalst,k) - 1 ! first char of substring
      if ((fc .ge. ap) .and. (fc .lt. ap+length(evalst(ap)))) then ! subarrays
          k = fc + min(nc,length(evalst(fc))) - 1
          while (k .ge. fc) do
              call putbak(evalst(k))
              k = k - 1
          end while
      end if
      return
      end

組み込み関数"undef"の実装は、以下の通り。

RATFOR版

# doudf.f -- undefine macro
      include ratfor.def
      subroutine doudf(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer a2

      include cmacro.r4

      if (j-i .lt. 1)
          return

      a2 = argstk(i + 2)
      call uninst(evalst(a2))
      return
      end

WATCOM Fortran 77版は以下の通り。

c doudf.f -- undefine macro
      include ratfor.def
      subroutine doudf(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer a2

      include cmacro.fi

      if (j-i .lt. 1) then
          return
      end if

      a2 = argstk(i + 2)
      call uninst(evalst(a2))
      return
      end

組み込み関数"ifdef"の実装は、以下の通り。

RATFOR版

# doifd.r4 -- define if macro is defined
      include ratfor.def
      subroutine doifd(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer lookup
      integer a2,a3,a4
      character junk(MAXDEF)

      include cmacro.fi

      if (j-i .lt. 4)
          return

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      if (lookup(evalst(a2),junk) .eq. YES)
          call pbstr(evalst(a3))
      else
          call pbstr(evalst(a4))
      return
      end

WATCOM Fortran 77版は以下の通り。

# doifd.r4 -- define if macro is defined
      include ratfor.def
      subroutine doifd(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer lookup
      integer a2,a3,a4
      character junk(MAXDEF)

      include cmacro.fi

      if (j-i .lt. 4)
          return

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      if (lookup(evalst(a2),junk) .eq. YES)
          call pbstr(evalst(a3))
      else
          call pbstr(evalst(a4))
      return
      end

マクロの応用を紹介する。

文字列の長さを返す"len"。再帰的定義になっているが、込み入ってない。

          define(len,[ifelse($1,,0,[incr(len(substr($1,2)))])])

文字列を定義する"string"。

           string(name,"STRING")

とすると

           integer name(6)
           data name(1)/LETS/
           data name(2)/LETT/
           data name(3)/LETR/
           data name(4)/LETN/
           data name(5)/LETG/

           data name(6)/EOS/

と展開される。"string"の定義は、以下の通り。

          define(string,[integer $1(len(substr($2,2)))
          str($1,substr($2,2),0)
                data $1(len(substr($2,2)))/EOS/
          ])

下請けルーチンの"str"は、以下の通り。

          define(str,[ifelse($2,",,      data $1(incr($3))/[LET]substr($2,1,1)/
          [str($1,substr($2,2),incr($3))])])

macro.r4中の

      string(balp,"()")