マクロ処理 -- 文字列の置換版 ― 2016年12月31日 20:06
これまで紹介した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
最近のコメント