マクロ処理 -- 機能の追加 ― 2017年01月13日 21:19
機能を2つ追加します。定義してあるマクロを取り消す--undef と簡単な条件判断を 行う--ifdef です。
undefは、以下のように使います。定義していないマクロ名を指定しても無視されます。
define(EOF,-1) # マクロEOFの定義 : : : undef(EOF) # マクロEOFの削除
ifdefは、以下のように使います。
define(CPU1,1) : : : ifdef(CPU1,define(WORD,4)) # CPU1が定義されていれば、WORDは、4 ifdef(CPU2,define(WORD,8)) # CPU2が定義されていれば、WORDは、8
これらの機能を組み込むには、defineの変更が必要です。undef,ifdefを マクロテーブルに登録することと、undefルーチンuninst()の呼び出し、 ifdefの処理ロジックの追加が必要です。
RATFOR版は、
# define.r4 -- simple string replacement macro processor program define integer gettok character defn(MAXDEF),t,token(MAXTOK) integer lookup string defnam "define" string udenam "undef" string ifdnam "ifdef" character deftyp(2) data deftyp(1)/DEFTYPE/,deftyp(2)/EOS/ character udftyp(2) data udftyp(1)/UDFTYPE/,udftyp(2)/EOS/ character ifdtyp(2) data ifdtyp(1)/IFDTYPE/,ifdtyp(2)/EOS/ call initfile call inittbl call initbuf call instal(defnam,deftyp) call instal(udfnam,udftyp) call instal(ifdnam,ifdtyp) 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) { # get definition call getdef(token,MAXTOK,defn,MAXTOK) call instal(token,defn) } else if (defn(1) == UDFTYPE ) { call getnam(token,MAXTOK) if (lookup(token,defn) == YES) # and defined call uninst(token) } else if (defn(1) == IFDTYPE) { call getdef(token,MAXTOK,defn,MAXDEF)) if (lookup(token,junk) == YES) call pbstr(defn) } else call pbstr(defn) # push replacement stop end
WATCOM fortran 77版は、
c define.f -- simple string replacement macro processor program define integer gettok integer*1 defn(82),t,token(82),junk(82) ! MAXDEF(82) MAXTOK(82) MAXDEF(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/ ! EOF(-2) integer*1 udfnam(6) character $udfnam(6) equivalence (udfnam,$udfnam) data $udfnam(1)/'u'/ data $udfnam(2)/'n'/ data $udfnam(3)/'d'/ data $udfnam(4)/'e'/ data $udfnam(5)/'f'/ data udfnam(6)/-2/ ! EOS(-2) integer*1 ifdnam(6) character $ifdnam(6) equivalence (ifdnam,$ifdnam) data $ifdnam(1)/'i'/ data $ifdnam(2)/'f'/ data $ifdnam(3)/'d'/ data $ifdnam(4)/'e'/ data $ifdnam(5)/'f'/ data ifdnam(6)/-2/ ! EOS(-2) integer*1 deftyp(2) data deftyp(1)/-4/,deftyp(2)/-2/ ! DEFTYPE(-4) EOS(-2) integer*1 udftyp(2) data udftyp(1)/-5/,udftyp(2)/-2/ ! UDFTYPE(-5) EOS(-2) integer*1 ifdtyp(2) data ifdtyp(1)/-6/,ifdtyp(2)/-2/ ! IFDTYPE(-6) EOS(-2) call initfile call inittbl call initbuf call instal(defnam,deftyp) call instal(udfnam,udftyp) call instal(ifdnam,ifdtyp) 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 if (defn(1) .eq. -5) then ! UDFTYPE(-5) call getnam(token,82) ! MAXTOK(82) if (lookup(token,defn) .eq. 1) then ! YES(1) and defined call uninst(token) end if else if (defn(1) .eq. -6) then ! IFDTYPE(-6) call getdef(token,82,defn,82) ! MAXTOK(82) MAXDEF(82) if (lookup(token,junk) .eq. 1) then ! YES(1) call pbstr(defn) end if else call pbstr(defn) ! push replacement end if t = gettok(token,82) ! MAXTOK(82) end while stop end
getnam()は、マクロ名を取り出す。
RATFOR版は、以下の通り。
# getnam.r4 -- get name subroutine getnam(token,toksiz) integer toksiz character token(toksiz) 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.') for (nlpar = 0; nlpar >= 0; ) if (ngetc(c) == EOF) call error('missing right paren.') else if (c == LPAREN) nlpar = nlpar + 1 else if (c == RPAREN) nlpar = nlpar - 1 # else normal character indefn(i) return end
WATCOM fortran 77版は、
c getnam.f -- get name include ratfor.def subroutine getnam(token,toksiz) integer toksiz integer*1 token(toksiz) integer*1 gettok,ngetc integer*1 c integer i,nlpar if (ngetc(c) .ne. LPAREN) then call error('missing left paren.') else if (gettok(token,toksiz) .ne. ALPHA) then call error('non-alphanumeric name.') end if nlpar = 0 while (nlpar .ge. 0) do if (ngetc(c) .eq. EOF) then call error('missing right paren.') else if (c .eq. LPAREN) then nlpar = nlpar + 1 else if (c .eq. RPAREN) then nlpar = nlpar - 1 ! else normal character indefn(i) end if i = i + 1 end while return end
このモジュールをコンパイルするには、fid.batを使って、マクロを展開する 必要があります。
uninst()はマクロの定義を取り消します。
RATFOR版は、以下の通り。
# uninst.r4 -- undefine macro subroutine uninst(defnam) character defnam(MAXTOK) character name(MAXTOK),defn(MAXDEF) integer i,nlen,dlen integer length,equal include clook.fi lastt = 0 for (i = 1; i <= lastp; i = i + 1) { call scopy(table,namptr(i),name,1) if (equal(defnam,name) == NO) { nlen = length(name) + 1 call scopy(table,namptr(i) + nlen,defn,1) dlen = length(defn) + 1 namptr(i) = lastt + 1 call scopy(name,1,table,lastt+1) call scopy(defn,1,table,lastt+nlen+1) lastt = lastt + nlen + dlen } } lastp = lastp - 1 return end
WATCOM fortran 77版は、
c uninst.f -- purge macro include ratfor.def subroutine uninst(defnam) integer*1 defnam(MAXTOK) integer*1 name(MAXTOK),defn(MAXDEF) integer i,nlen,dlen integer length,equal include clook.fi lastt = 0 i = 1 while (i .le. lastp) do call scopy(table,namptr(i),name,1) if (equal(defnam,name) .eq. NO) then nlen = length(name) + 1 call scopy(table,namptr(i) + nlen,defn,1) dlen = length(defn) + 1 namptr(i) = lastt + 1 call scopy(name,1,table,lastt+1) call scopy(defn,1,table,lastt+nlen+1) lastt = lastt + nlen + dlen end if i = i + 1 end while lastp = lastp - 1 return end
getnam()uninst()にincludeするratfor.defは、以下の通り。
c ratfor.def -- ratfor constants define(LET0,48) define(LET1,49) define(LET2,50) define(LET3,51) define(LET4,52) define(LET5,53) define(LET6,54) define(LET7,55) define(LET8,56) define(LET9,57) define(LETA,65) define(LETB,66) define(LETC,67) define(LETD,68) define(LETE,69) define(LETF,70) define(LETG,71) define(LETH,72) define(LETI,73) define(LETJ,74) define(LETK,75) define(LETL,76) define(LETM,77) define(LETN,78) define(LETO,79) define(LETP,80) define(LETQ,81) define(LETR,82) define(LETS,83) define(LETT,84) define(LETU,85) define(LETV,86) define(LETW,87) define(LETX,88) define(LETY,89) define(LETZ,90) define(LETa,97) define(LETb,98) define(LETc,99) define(LETd,100) define(LETe,101) define(LETf,102) define(LETg,103) define(LETh,104) define(LETi,105) define(LETj,106) define(LETk,107) define(LETl,108) define(LETm,109) define(LETn,110) define(LETo,111) define(LETp,112) define(LETq,113) define(LETr,114) define(LETs,115) define(LETt,116) define(LETu,117) define(LETv,118) define(LETw,119) define(LETx,120) define(LETy,121) define(LETz,122) define(STDIN,5) define(STDOUT,6) define(ERROUT,6) define(EOF,-1) define(EOS,-2) define(TAB,9) define(NEWLINE,10) define(BLANK,32) define(BUFSIZE,1000) define(LETTER,97) define(DIGIT,48) define(MAXLINE,82) define(MAXDEF,82) define(MAXTOK,82) define(MAXPTR,500) define(MAXTBL,5000) define(ARGSIZE,82) define(DEFTYPE,-4) define(IFDTYPE,-5) define(UDFTYPE,-6) define(IFTYPE,-7) define(INCTYPE,-8) define(SUBTYPE,-9) define(LENTYPE,-10) define(EVALSIZE,1000) define(ALPHA,LETa) define(NO,0) define(YES,1) define(LPAREN,40) define(RPAREN,41) define(LBRACK,91) define(RBRACK,93) define(COMMA,44) define(DQUOTE,34) define(QUOTE,39) define(SEMICOL,59) define(CALLSIZE,1000) define(DOLLAR,36) define(ARGFLAG,36) define(DNL,36) define(EXCLAM,33)
最近のコメント