引数付きマクロ処理(一部修正): アナクロなコンピューターエンジニアのつぶやき

マクロの定義に、引数が使えるようになると、利便性が非常に向上する。簡単な例を 示す。まずは、マクロの定義は、以下のようになる。マクロgetc,putcの定義の中、$1が マクロの引数にである。引数は、$1から$9までである。

          define(STDIN,5)
          define(STDOUT,6)
          define(getc,getch(STDIN,$1))
          define(putc,putch(STDOUT,$1))

プログラム中では、以下のように、記述する。

          c = getc(c)
          call putc(c)

これが展開されると、以下のようになる。

          c = getch(5,c)
          call putch(6,c)

もう少し長いマクロの例を以下に示す。

          define(BLANK,32)
          define(TAB,9)
          define(skipbl,while($1($2) == BLANK | $1($2) == TAB)
               $2 = $2 + 1)

プログラム中では、

          skipbl(s,i)

展開されると、

          while(s(i) == 32 | s(i) == 9)
              i = i + 1

読み込み中にマクロに出会ったら、引数も含めてマクロ評価用スタックに積む。 引数の中にマクロ呼び出しがあったら、新しいマクロ評価用スタック領域を取り、 スタックに積む。そして、マクロを完全に評価して、入力に送り返す。そして、元の マクロの評価を続ける。

マクロ評価用スタックevalstは配列で表現され、マクロの名前、定義型、 引数が入る。一方、配列argstkは、evalstに格納された文字列の場所の 位置を示す。いくつものモジュールで共通の用いられるevalstは以下の通り。

RATFOR版は、

# cmacro.ri
      common /cmacro/cp,ep,evalst(EVALSIZE)
      integer cp       # current call stack pointer
      integer ep       # next free position in evalst
      character evalst # evaluation stack

WATCOM fortran 77版は、

! cmacro.fi
      common /cmacro/cp,ep,evalst(EVALSIZE)
      integer cp       ! current call stack pointer
      integer ep       ! next free position in evalst
      integer*1 evalst ! evaluation stack

このマクロでは、マクロや組み込み操作は出現したとき、 その場で全て展開することになっているので、それではまずいことがある。 たとえば、defをdefineの同義語として定義したいとき、

      define(def,define($1,$2))

とすれば良さそうだが、うまくいかない。まず、マクロ名"def"が、評価用スタックに積まれる。 次に、置き換え文字列"define($1,$2)"が評価されてしまい、"def"に対応する置き換え文字列が 空となってしまう。 これでは、目的を達成できないので、"["と"]"でくくられた範囲は、評価を遅らせる仕組みを 付け加える。

      define(def,[define($1,$2)])
      def(ABC,DEF)

とすると

      ABC

は、変換されて、

      DEF

となる。実は、引数なしのマクロプログラムのソースは、defineを通せない。 プログラム中のマクロ定義ではない"define"文字列がマクロの定義と 見間違えられてしまうのである。

引数なしのマクロには、"()"がつかない、これを特別扱いしないように、 "()"がついていないマクロに出会ったら、"()"を入力に送り返し、あたかも"()"が つぃているかのように振る舞わせる。

以上を踏まえた、引数付きマクロのRATFOR版は、以下の通り。

# macro.r4 -- expand macros with arguments
      program macro
      character gettok
      integer*1 defn(MAXDEF),t,token(MAXTOK)
      integer lookup,push
      integer ap,argstk(ARGSIZE),callst(CALLSIZE),nlb,plev(CALLSIZE)

      string balp "()"
      string defnam "define"
      character deftyp(2)
      data deftyp(1)/DEFTYPE/,deftyp(2)/EOS/

      include cmacro.fi

      call initfile
      call inittbl
      call instal(defnam,deftyp)
      cp = 0
      ap = 1
      ep = 1
      for (t = gettok(token,MAXTOK); t !=  EOF; t = gettok(token,MAXTOK)) {
          if (t == ALPHA) {
              if (lookup(token,defn) == NO)
                  call puttok(token)
              else {                    # defined; put it in eval stack
                  cp = cp + 1
                  if (cp > CALLSIZE) then
                      call error('call stack overflow.')
                  callst(cp) = ap
                  ap = push(ep,argstk,ap)
                  call puttok(defn)     # stack definition
                  call putchr(EOS)
                  ap = push(ep,argstk,ap)
                  call puttok(token)    # stack name
                  call putchr(EOS)
                  ap = push(ep,argstk,ap)
                  t = gettok(token,MAXTOK) # peek at next
                  call pbstr(token)
                  if (t != LPAREN)      # add ( ) if not present
                      call pbstr(balp)
                  plev(cp) = 0
                  }
              }
          else if (t == LBRACK) {       # strip one level of [ ]
              nlb = 1
              repeat {
                  t = gettok(token,MAXTOK)
                  if (t == LBRACK)
                      nlb = nlb + 1
                  else if (t == RBRACK) {
                      nlb = nlb - 1
                      if (nlb == 0)
                          break
                      }
                  else if (t == EOF)
                      call error('EOF in string.')
                  call puttok(token)
                  }
          else if (cp == 0)             # not in a macro at all
              call puttok(token)
          else if (t == LPAREN)
              if (plev(cp) > 0)
                  call puttok(token)
              plev(cp) = plev(cp) + 1
          else if (t == RPAREN) {
              plev(cp) = plev(cp) - 1
              if (plev(cp) .gt. 0) then
                  call puttok(token)
              else {                    # end of argument list
                  call putchr(EOS)
                  call eval(argstk,callst(cp),ap-1)
                  ap = callst(cp)       # pop eval stack
                  ep = argstk(ap)
                  cp = cp - 1
                  }
          else if ((t == COMMA) $ (plev(cp) == 1)) {
              call putchr(EOS)
              ap = push(ep,argstk,ap)
              }
          else
              call puttok(token)
          }
      if (cp != 0)
          call error('unexpected EOF.')
      stop
      end

WATCOM fortran 77版は、

! macro.f -- expand macros with arguments
      include ratfor.def
      program macro
      integer*1 gettok
      integer*1 defn(MAXDEF),t,token(MAXTOK)
      integer lookup,push
      integer ap,argstk(ARGSIZE),callst(CALLSIZE),nlb,plev(CALLSIZE)

      integer*1 balp(3)
      data balp(1)/LPAREN/
      data balp(2)/RPAREN/
      data balp(3)/EOS/

      integer*1 defnam(7)
      data defnam(1)/LETd/
      data defnam(2)/LETe/
      data defnam(3)/LETf/
      data defnam(4)/LETi/
      data defnam(5)/LETn/
      data defnam(6)/LETe/
      data defnam(7)/EOS/

      integer*1 deftyp(2)
      data deftyp(1)/DEFTYPE/
      data deftyp(2)/EOS/
      include cmacro.fi

      call initfile
      call inittbl
      call instal(defnam,deftyp)
      cp = 0      ! current call stack pointer
      ap = 1      ! next free position in argstk
      ep = 1      ! next free position in evalst
      t = gettok(token,MAXTOK) 
      while (t .ne. EOF) do
          if (t .eq. ALPHA) then
              if (lookup(token,defn) .eq. NO) then
                  call puttok(token)
              else                          ! defined; put it in eval stack
                  cp = cp + 1
                  if (cp .gt. CALLSIZE) then
                      call error('call stack overflow.')
                  end if
                  callst(cp) = ap
                  ap = push(ep,argstk,ap)
                  call puttok(defn)         ! stack definition
                  call putchr(EOS)
                  ap = push(ep,argstk,ap)
                  call puttok(token)        ! stack name
                  call putchr(EOS)
                  ap = push(ep,argstk,ap)
                  t = gettok(token,MAXTOK)  ! peek at next
                  call pbstr(token)
                  if (t .ne. LPAREN) then   ! add ( ) if not present
                      call pbstr(balp)
                  end if
                  plev(cp) = 0
              end if
          else if (t .eq. LBRACK) then      ! strip one level of [ ]
              nlb = 1
              loop
                  t = gettok(token,MAXTOK)
                  if (t .eq. LBRACK) then
                      nlb = nlb + 1
                  else if (t .eq. RBRACK) then
                      nlb = nlb - 1
                      if (nlb .eq. 0) then
                          exit
                      end if
                  else if (t .eq. EOF) then
                      call error('EOF in string.')
                  end if
                  call puttok(token)
              end loop
          else if (cp .eq. 0) then          ! not in a macro at all
              call puttok(token)
          else if (t .eq. LPAREN) then
              if (plev(cp) .gt. 0) then
                  call puttok(token)
              end if
              plev(cp) = plev(cp) + 1
          else if (t .eq. RPAREN) then
              plev(cp) = plev(cp) - 1
              if (plev(cp) .gt. 0) then
                  call puttok(token)
              else                         ! end of argument list
                  call putchr(EOS)
                  call eval(argstk,callst(cp),ap-1)
                  ap = callst(cp)          ! pop eval stack
                  ep = argstk(ap)
                  cp = cp - 1
              end if
          else if ((t .eq. COMMA) .and. (plev(cp) .eq. 1)) then
              call putchr(EOS)
              ap = push(ep,argstk,ap)
          else
              call puttok(token)
          end if
          t = gettok(token,MAXTOK)
      end while

      if (cp .ne. 0) then
          call error('unexpected EOF.')
      end if

      stop
      end

下請けルーチンputtok()のRATFOR版は、以下の通り。

# puttok.r4 -- put a token either on output or into evaluation stack
      subroutine puttok(str)
      character str(MAXTOK)
      integer i

      for (i = 1; str(i) != EOS; i = i + 1)
          call putchr(str(i))
      return
      end

WATCOM fortran 77版は、

! puttok.f -- put a token either on output or into evaluation stack
      include ratfor.def
      subroutine puttok(str)
      integer*1 str(MAXTOK)
      integer i

      i = 1
      while (str(i) .ne. EOS) do
          call putchr(str(i))
          i = i + 1
      end while
      return
      end

下請けルーチンputchr()のRATFOR版は、以下の通り。

# putchr -- put single char on output or into eveluation stack
      subroutine putchr(c)
      character c
      include cmacror.ri

      if (cp == 0)
          call putc(c)
      else {
          if (ep > EVALSIZE)
              call error('eveluation stack overflow.')
          evalst(ep) = c
          ep = ep + 1
          }
      return
      end

WATCOM fortran 77版は、

! putchr -- put single char on output or into eveluation stack
      include ratfor.def
      subroutine putchr(c)
      integer*1 c
      include cmacro.fi

      if (cp .eq. 0) then
          call putc(c)
      else
          if (ep .gt. EVALSIZE) then
              call error('eveluation stack overflow.')
          end if
          evalst(ep) = c
          ep = ep + 1
      end if
      return
      end

下請けルーチン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 {
          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版は、

! 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
      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
          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

下請けルーチンdodef()のRATFOR版は、以下の通り。

# dodef.rf -- install definition in table
      subroutine dodef(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer a2,a3
      include cmacro.ri

      if (j-i .gt. 2) {
          a2 = argstk(i+2)
          a3 = argstk(i+3)
          call instal(evalst(a2),evalst(a3))  # subarrays
          }
      return
      end

WATCOM fortran 77版は、

! dodef.f -- install definition in table
      include ratfor.def
      subroutine dodef(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer a2,a3
      include cmacro.fi

      if (j-i .gt. 2) then
          a2 = argstk(i+2)
          a3 = argstk(i+3)
          call instal(evalst(a2),evalst(a3))  ! subarrays
      end if
      return
      end