引数付きマクロ処理(一部修正) ― 2017年01月26日 21:27
マクロの定義に、引数が使えるようになると、利便性が非常に向上する。簡単な例を 示す。まずは、マクロの定義は、以下のようになる。マクロ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
最近のコメント