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

これまで紹介したRATFORのプログラムリストには、記号定数が ふんだんに使われてきた。記号定数は最終的には、定数に置換する必要がある。 これを行う事をマクロ展開という。また、それを行うプログラムをマクロプロセッサー という。このプログラムは、プリグラム中に書き込まれたマクロを展開し書き出す。

まずはじめに、文字列の置換版 -- define を紹介する。

defineでの、マクロの定義は次のようになる。

       define(EOF,-1)

このように定義されたマクロは、ソースファイルに下記のように使われる。

       define(EOF,-1)
       
       program copy # copy from STDIN to STDOUT
       
       call initfile
       
       while(getc(c) != EOF)
           call putc(c)
       stop
       end

これをマクロ展開すると、

       
       
       program copy # copy from STDIN to STDOUT
       
       call initfile
       
       while(getc(c) != -1)
           call putc(c)
       stop
       end

このようなカンタンな場合から、マクロプロセッサーをはじめる。

マクロプロセッサーのあらすじは、次のようになるだろう。

      while(gettok(綴り) != EOF) {
          綴りの表を引く
          if (綴り == "define")
              新しい綴りとその値を登録
          else if (綴りが表にあった)
              入力を綴りに対応する置き換え文字列に切り替える
          else
              綴りをそのまま出力する

ここで、gettok()は以下の通り。

RATFOR版は、

# gettok.r4 -- get alphanumeric string non-alpha for define
      character function gettok(token,toksiz)
      integer toksiz
      character token(toksiz)
      character ngetc,type
      integer i

      for (i = 1; i < toksiz; i = i + 1) {
          gettok = type(ngetc(token(i)))
          if (gettok != LETTER) & (gettok != DIGIT)
              break
          }

      if (i >= toksiz)
          call error('token too long.')

      if (i > 1) {            # some alpha was seen
          call putbak(token(i))
          i = i - 1
          gettok = ALPHA
      # else single character token
      token(i+1) = EOS
      return
      end

RATFOR版は、

c  gettok.for -- get alphanumeric string or single non-alpha for define
      integer*1 function gettok(token,toksiz)
      integer toksiz
      integer*1 token(toksiz)
      integer*1 ngetc,type
      integer i

      i = 1
      while (i .lt. toksiz) do
          gettok = type(ngetc(token(i)))
          if ((gettok .ne. 97) .and.    ! ALPHA(97)
     1        (gettok .ne. 48)) then    ! DIGIT(48)
              exit
          end if
          i = i + 1
      end while

      if (i .ge. toksiz) then
          call error('token too long.')
      end if

      if (i .gt. 1) then                ! some alpha was seen
          call putbak(token(i))
          i = i - 1
          gettok = 97                   ! ALPHA(97)
      ! else single character token
      end if
      token(i+1) = -2                   ! EOS(-2)
      return
      end

gettok()では、綴り取り出すときに、先読みを行う。当然、先読みした分は、 元に戻す必要もある。これらの統一的に行うのに、ngetc()、putbak()を使う。

読みすぎた文字は、putbak()で元に戻す。putbak()は、ngetc()と共有の バッファーを持っている。このバッファーには、putbak()で戻された文字が 蓄えられる。ngetc()はこのバッファーに残りがあれば、そこから文字を取り出し、 さもなくば、getc()で文字を読み込む。

putbak()は、以下の通り。

RATFOR版は、

# putbak.r4 -- push character back onto input
      subroutine putbak(c)
      character c
      include cdefio.ri
      
      bp = bp + 1
      if (bp > BUFSIZE)
         call error('too many character pushed back.')
      buf(bp) = c
      return
      end

WATCOM fortran 77版は、

c putbak.f -- push character back onto input
      subroutine putbak(c)
      integer*1 c
      include cdefio.fi
      
      bp = bp + 1
      if (bp .gt. 1000) then            ! BUFSIZE(1000)
         call error('too many character pushed back.')
      end if
      buf(bp) = c

      return
      end

putbak()、ngetc()共通のデータ領域cdefioは、以下の通り。

RATFOR版は、

# cdefio.ri
      common /cdefio/bp,buf(BUFSIZE)
      integer bp    # next available character; init = 0
      character buf # pushed back character

WATCOM fortran 77版は、

c cdefio.fi
      common /cdefio/bp,buf(1000)       ! BUFSIZE(1000)
      integer bp    ! next available character; init = 0
      character buf ! pushed back character

文字列を入力に送り返すことは、多々あるわけでないが、putbak()を 複数回呼び出すことで、実現できる。pbstr()は、以下の通り。

RATFOR版は、

# pbstr.r4 -- push string back onto input
      subroutine pbstr(in)
      character in(MAXLINE)
      integer length
      integer i

      for (i = length( in ); i > 0; i = i - 1)
          call putbak(in(i))
      return
      end

WATCOM fortran 77版は、

c pbstr.for -- push string back onto input
      subroutine pbstr(in)
      integer*1 in(82)                  ! MAXLINE(82)
      integer length
      integer i

      i = length( in )
      while (i .gt. 0) do
          call putbak(in(i))
          i = i - 1
      end while
      return
      end

ngetc()は、以下の通り。

RATFOR版は、

# ngetc.r4 -- get a (possibly pushed back) character
      character function ngetc( c )
      character c
      character getc
      include cdefio.ri

      if (bp > 0)
         c = buf(bp)
      else {
         bp = 1
         buf(bp) = getc(c)
         }
      if (c != EOF)
         bp = bp - 1
      ngetc = c
      return
      end

WATCOM fortran 77版は、

!  ngetc.f -- get a (possibly pushed back) character
      integer*1 function ngetc( c )
      integer*1 c
      integer*1 getc

      include cdefio.fi

      if (bp .gt. 0) then
         c = buf(bp)
      else
         bp = 1
         buf(bp) = getc(c)
      end if
      if (c .ne. -1) then               ! EOF(-1)
         bp = bp - 1
      end if
      ngetc = c
      return
      end

cdefioの初期化は、initbuf()で行う。

RATFOR版は、

# initbuf.r4
      subroutine initbuf
      include cdefio.ri

      bp = 0
      buf(1) = EOS
      return
      end

WATCOM fortran 77版は、

c initbuf.f
      subroutine initbuf
      include cdefio.fi

      bp = 0
      buf(1) = -2                       ! EOS(-2)
      return
      end

defineのメインルーチンは、以下の通りである。

gettok()で 綴りを切り出す。gettok()がALPHA以外を返したら、マクロではないから、そのまま、 出力する。綴りの表は、lookup()を使って引く。表に載っていなかったら、それは、 そのまま出力する。表に載っていて、それがDEFTYPEであったら、新しいマクロを getdef()で取り出し。マクロ表にinstall()で登録する。 登録されているマクロ名であれば、置き換え文字列を 入力に送り返す。

RATFOR版は以下の通り。

# define.r4 -- simple string replacement macro processor
      program define
      integer gettok
      character defn(MAXDEF),t,token(MAXTOK)
      integer lookup

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

      call initfile
      call inittbl
      call initbuf
      call instal(defnam,deftyp)

      for(t = gettok(token,MAXTOK);t != EOF;t = gettok(token,MAXTOK))
          if (t != ALPHA)               # output non-alpha tokens
              call putlin(token,STDOUT)
          else if (lookup(token,defn) == NO)
              call putlin(token,STDOUT)
          else if (defn(1) == DEFTYPE) then # get definition
              call getdef(token,MAXTOK,defn,MAXTOK)
              call instal(token,defn)
          else
              call pbstr(defn)          # push replacement
          end if
      end while
      stop
      end

WATCOM fortran 77版は以下の通り。

c define.f -- simple string replacement macro processor
      program define
      integer gettok
      integer*1 defn(82),t,token(82)    ! MAXDEF(82) MAXTOK(82)
      integer lookup
      integer*1 defnam(7)
      character $defnam(7)
      equivalence (defnam,$defnam)
      data $defnam(1)/'d'/
      data $defnam(2)/'e'/
      data $defnam(3)/'f'/
      data $defnam(4)/'i'/
      data $defnam(5)/'n'/
      data $defnam(6)/'e'/
      data defnam(7)/-2/                ! EOS(-2)
      integer*1 deftyp(2)
      data deftyp(1)/-4/,deftyp(2)/-2/  ! DEFTYPE(-4) EOS(-2)

      call initfile
      call inittbl
      call initbuf
      call instal(defnam,deftyp)

      t = gettok(token,82)              ! MAXTOK(82)
      while (t .ne. -1) do              ! EOF(-1)
          if (t .ne. 97) then           ! ALPHA(97) output non-alpha tokens
              call putlin(token,6)      ! STDOUT(6)
          else if (lookup(token,defn) .eq. 0) then ! NO(0) and undefined
              call putlin(token,6)      ! STDOUT(6)
          else if (defn(1) .eq. -4) then ! DEFTYPE(-4) get definition
              call getdef(token,82,defn,82) ! MAXTOK(82) MAXDEF(82)
              call instal(token,defn)
          else
              call pbstr(defn)          ! push replacement
          end if
          t = gettok(token,82)          ! MAXTOK(82)
      end while
      stop
      end

マクロを取り出すgetdef()は、以下の通り。

RATFOR版は以下の通り。

# getdef.r4 (for no argument) -- get name and definition
      subroutine getdef(token,toksiz,defn,defsiz)
      integer toksiz, defsiz
      character token(toksiz),defn(defsiz)
      character gettok,ngetc
      character c
      integer i,nlpar

      if (ngetc(c) != LPAREN)
          call error('missing left paren.')
      else if (gettok(token,toksiz) != ALPHA)
          call error('non-alphanumeric name.')
      else if (ngetc(c) != COMMA)
          call error('missing comma in DEFINE.')
      ! else got (name,

      nlpar = 0
      for (i = 1;nlpar >= 0; i = i + 1)
          if (i > defsiz)
              call error('definition too long.')
          else if (ngetc(defn(i)) == EOF)
              call error('missing right paren.')
          else if (defn(i) == LPAREN)
              nlpar = nlpar + 1
          else if (defn(i) == RPAREN
              nlpar = nlpar - 1
          ! else normal character indefn(i)
      defn(i-1) = EOS
      return
      end

WATCOM fortran 77版は以下の通り。

c getdef.f (for no argument) -- get name and definition
      subroutine getdef(token,toksiz,defn,defsiz)
      integer toksiz, defsiz
      integer*1 token(toksiz),defn(defsiz)
      integer*1 gettok,ngetc
      integer*1 c
      integer i,nlpar

      if (ngetc(c) .ne. 40) then        ! LPAREN(40)
          call error('missing left paren.')
      else if (gettok(token,toksiz) .ne. 97) then ! ALPHA(97)
          call error('non-alphanumeric name.')
      els eif (ngetc(c) .ne. 44) then   ! COMMA(44)
          call error('missing comma in DEFINE.')
      ! else got (name,
      end if

      nlpar = 0
      i = 1
      while (nlpar .ge. 0) do
          if (i .gt. defsiz) then
              call error('definition too long.')
          else if (ngetc(defn(i)) .eq. -1) then ! EOF(-1)
              call error('missing right paren.')
          else if (defn(i) .eq. 40) then ! LPAREN(40)
              nlpar = nlpar + 1
          else if (defn(i) .eq. 41) then ! RPAREN(41)
              nlpar = nlpar - 1
          ! else normal character in defn(i)
          end if
          i = i + 1
      end while
      defn(i-1) = -2                    ! EOS(-2)
      return
      end