引数付きマクロ処理 -- 機能改善 ― 2017年04月21日 13:54
完成した"macro"を使ってみて、以下の不具合が見つかった。
- マクロの外で、'や"で囲まれた文字列(たいていの場合文字列定数)に含まれるマクロ名も置換されてしまう。
- マクロ"string"は、英数字しか展開できない。
- マクロ"string"の下請けマクロ"len","str"が、プログラム中の変数とぶつかる可能性が多々ある。
このうち2に関しては、Ratforプリプロセッサーに組み込むこととし、 1は、macroのメインルーチンを手直しして対応し、3は、マクロ名を手直しして対応する。
macroの、メインルーチンの修正点は、マクロの外を処理している最中に "や'が出現したら、対応する"や'が出現するまで読み込み、出力する。ただし、 対応する"や'が出現しない場合は、先頭の"だけを出力する。
RATFOR版は、以下の通り。
# macro.r4 -- expand macros with arguments
program macro
character gettok
character defn(MAXDEF),t,token(MAXTOK)
integer lookup,push
integer ap,argstk(ARGSIZE),callst(CALLSIZE),i,nlb,plev(CALLSIZE)
string balp "()"
string defnam "define"
character deftyp(2)
data deftyp(1)/DEFTYPE/,deftyp(2)/EOS/
string incnam "incr"
character inctype(2)
data inctyp(1)/INCTYPE/,inctyp(2)/EOS/
string subnam "substr"
character subtype(2)
data subtyp(1)/SUBTYPE/,subtyp(2)/EOS/
string ifnam "ifelse"
character iftype(2)
data iftyp(1)/IFTYPE/,iftyp(2)/EOS/
string udfnam "ifelse"
character udftype(2)
data udftyp(1)/UDFTYPE/,udftyp(2)/EOS/
string ifdnam "ifdef"
character ifdtype(2)
data ifdtyp(1)/IFDTYPE/,ifdtyp(2)/EOS/
include cmacro.fi
call initfile
call inittbl
call initbuf
call instal(defnam,deftyp)
call instal(incnam,inctyp)
call instal(subnam,subtyp)
call instal(ifnam,iftyp)
call instal(udfnam,udftyp)
call instal(ifdnam,ifdtyp)
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
if (token(1) == SQUOTE ! token(1) == DQUOTE) {
for (i = 2; ngetc(token(i)) != token(1); i = i + 1) {
if (token(i) == NEWLINE) {
token(i+1) = EOS
call pbstr(token(2))
i = 1
break
}
}
token(i+1) = EOS
}
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)
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版は以下の通り。
c macro.f -- expand macros with arguments
include ratfor.def
program macro
integer*1 gettok,ngetc
integer*1 defn(MAXDEF),t,token(MAXTOK)
integer lookup,push
integer ap,argstk(ARGSIZE),callst(CALLSIZE),i,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/
integer*1 incnam(5)
data incnam(1)/LETi/
data incnam(2)/LETn/
data incnam(3)/LETc/
data incnam(4)/LETr/
data incnam(5)/EOS/
integer*1 inctyp(2)
data inctyp(1)/INCTYPE/
data inctyp(2)/EOS/
integer*1 subnam(7)
data subnam(1)/LETs/
data subnam(2)/LETu/
data subnam(3)/LETb/
data subnam(4)/LETs/
data subnam(5)/LETt/
data subnam(6)/LETr/
data subnam(7)/EOS/
integer*1 subtyp(2)
data subtyp(1)/SUBTYPE/
data subtyp(2)/EOS/
integer*1 ifnam(7)
data ifnam(1)/LETi/
data ifnam(2)/LETf/
data ifnam(3)/LETe/
data ifnam(4)/LETl/
data ifnam(5)/LETs/
data ifnam(6)/LETe/
data ifnam(7)/EOS/
integer*1 iftyp(2)
data iftyp(1)/IFTYPE/
data iftyp(2)/EOS/
integer*1 udfnam(6)
data udfnam(1)/LETu/
data udfnam(2)/LETn/
data udfnam(3)/LETd/
data udfnam(4)/LETe/
data udfnam(5)/LETf/
data udfnam(6)/EOS/
integer*1 udftyp(2)
data udftyp(1)/UDFTYPE/
data udftyp(2)/EOS/
integer*1 ifdnam(6)
data ifdnam(1)/LETi/
data ifdnam(2)/LETf/
data ifdnam(3)/LETd/
data ifdnam(4)/LETe/
data ifdnam(5)/LETf/
data ifdnam(6)/EOS/
integer*1 ifdtyp(2)
data ifdtyp(1)/IFDTYPE/
data ifdtyp(2)/EOS/
include cmacro.fi
call initfile
call inittbl
call initbuf
call instal(defnam,deftyp)
call instal(incnam,inctyp)
call instal(subnam,subtyp)
call instal(ifnam,iftyp)
call instal(udfnam,udftyp)
call instal(ifdnam,ifdtyp)
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
if (token(1) .eq. SQUOTE .or. token(1) .eq. DQUOTE) then
i = 2
while (ngetc(token(i)) .ne. token(1)) do
if (token(i) .eq. NEWLINE) then
token(i+1) = EOS
call pbstr(token(2))
i = 1
exit
end if
i = i + 1
end while
token(i+1) = EOS
end if
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
マクロ"string"の下請けマクロ"len","str"は、以下のように変更した。
define(00length00,[ifelse($1,,0,[incr(00length00(substr($1,2)))])])
define(string,[integer*1 $1(00length00(substr($2,2)))
00string00($1,substr($2,2),0)
data $1(00length00(substr($2,2)))/EOS/
])
define(00string00,[ifelse($2,",, data $1(incr($3))/[LET]substr($2,1,1)/
[00string00($1,substr($2,2),incr($3))])])
コメント
_ Nelle ― 2017年05月02日 08:43
_ Anthony ― 2017年05月02日 09:43
Thanks for finally talking about >引数付きマクロ処理 --
機能改善: アナクロなコンピューターエンジニアのつぶやき <Loved it!
機能改善: アナクロなコンピューターエンジニアのつぶやき <Loved it!
_ manicure ― 2017年05月03日 15:20
I'm extremely inspired together with your writing talents as smartly as with the structure to your blog.
Is that this a paid topic or did you customize it your self?
Either way stay up the excellent high quality writing, it is rare to see a great
weblog like this one nowadays..
Is that this a paid topic or did you customize it your self?
Either way stay up the excellent high quality writing, it is rare to see a great
weblog like this one nowadays..
コメントをどうぞ
※メールアドレスとURLの入力は必須ではありません。 入力されたメールアドレスは記事に反映されず、ブログの管理者のみが参照できます。
トラックバック
このエントリのトラックバックURL: http://kida.asablo.jp/blog/2017/04/21/8495367/tb
I will certainly digg it and in my opinion suggest to my friends.
I'm sure they will be benefited from this website.