コードの改修 -- 名前付き共通領域の初期化の改善 マクロテーブル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

実際の変更点については割愛します。