コードの改修 -- 名前付き共通領域の初期化の改善 マクロテーブル ― 2017年08月01日 16:37
マクロテーブルに関する共通領域の初期化は、inittbl()で行っていましたが、 これをdata文で静的に初期化することとします。
Ratfor版のclook.riは以下の通りです。
# clook.ri common /clook/lastp,lastt,namptr,table integer lastp # last used in namptr; init = 0 integer lastt # last used in table; init = 0 integer namptr(MAXPTR) # name pointers character table(MAXTBL) # actual text of names and defns data lastp/0/ data lastt/0/
WATCOM fotran77版のfiles.fiは以下の通りです。
c clook.fi common /clook/lastp,lastt,namptr,table integer lastp ! last used in namptr; init = 0 integer lastt ! last used in table; init = 0 integer namptr(MAXPTR) ! name pointers integer*1 table(MAXTBL) ! actual text of names and defns data lastp/0/ data lastt/0/
files.ri、files.fiの変更により再コンパイルが必要になるファイルは、以下の通りです。
instal.f lookup.f uninst.f
これらは、macroが動き出す前のファイルですので、macroを使用する版を再掲します。
instal()のRatfor版は以下の通りです。
# instal.r4 -- add name and definition to table subroutine instal(name,defn) character name(MAXTOK),defn(MAXDEF) integer length integer dlen,nlen include clook.ri nlen = length(name) + 1 dlen = length(defn) + 1 if (lastt+nlen+dlen > MAXTBL | lastp >= MAXPTR) { call putlin(name,ERROUT) call remark(':too many definitions.') } lastp = lastp + 1 namptr(lastp) = lastt + 1 call scopy(name,1,table,lastt+1) call scopy(defn,1,table,lastt+nlen+1) lastt = lastt + nlen + dlen return end
instal()のWATCOM fortran77版は以下の通りです。
c instal.f -- add name and definition to table include ratfor.def subroutine instal(name,defn) integer*1 name(MAXTOK),defn(MAXDEF) integer length integer dlen,nlen include clook.fi nlen = length(name) + 1 dlen = length(defn) + 1 if ((lastt+nlen+dlen .gt. MAXTBL) .or. (lastp .ge. MAXPTR)) then call putlin(name,ERROUT) call remark(':too many definitions.') end if lastp = lastp + 1 namptr(lastp) = lastt + 1 call scopy(name,1,table,lastt+1) call scopy(defn,1,table,lastt+nlen+1) lastt = lastt + nlen + dlen return end
lookup()のRatfor版は以下の通りです。
# lookup.r4 -- locate name, extract definition from table integer function lookup(name,defn) character name(MAXDEF),defn(MAXTOK) integer i,j,k include clook.fi for (i = lastp;i > 0; i = i - 1) { j = namptr(i) for (k = 1;name(k) == table(j) & name(k) != EOS; k = k + 1) j = j + 1 if (name(k) == table(j)) { # got one call scopy(table,j+1,defn,1) lookup = YES return } } lookup = NO return end
lookup()のWATCOM fortran77版は以下の通りです。
c lookup.f -- locate name, extract definition from table include ratfor.def integer function lookup(name,defn) integer*1 name(MAXDEF),defn(MAXTOK) integer i,j,k include clook.fi i = lastp while (i .gt. 0) do j = namptr(i) k = 1 while ((name(k) .eq. table(j)) .and. (name(k) .ne. EOS)) do j = j + 1 k = k + 1 end while if (name(k) .eq. table(j)) then ! got one call scopy(table,j+1,defn,1) lookup = YES return end if i = i - 1 end while lookup = NO return end
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
uninst()のWATCOM fortran77版は以下の通りです。
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
また、inittbl()が不要になることで再コンパイルが必要になるファイルは、以下の通りです。
define.f macro.f
実際の変更点については割愛します。
最近のコメント