translitの下請けルーチン: アナクロなコンピューターエンジニアのつぶやき

transllitの下請けルーチンは、複数ありますし、 また、それらのルーチンの下請けルーチンがあります。

まずは、makeset()。変換文字列fromとtoを作成するのに使います。

# makset.r4 -- make set from array(k) in set
      integer function makset(array, k, set, size)
      integer k, size
      character array(ARB), set(size)
      integer addset
      integer i, j

      i = k
      j = 1
      call filset(EOS, array, i,set, j, size)
      makset = addset(EOS, set, j, size)
      return
      end

Watcom Fortran77版は、下記の通り。

c makset.for -- make set from array(k) in set
      integer function makset(array, k, set, size)
      integer k, size
      integer*1 array(*), set(size)     ! ARB(*)
      integer addset
      integer i, j

      i = k
      j = 1
      call filset(-2, array, i, set, j, size) ! EOS(-2)
      makset = addset(-2, set, j, size) ! EOS(-2)
      return
      end

addset()は、文字列setのjの位置に文字を追加できれば追加します。 やっていることは、単純ですが、モジュールとしてまとめることで、 プログラムの見通しを良くするのに一役買っています。

# addset.r4 -- put c inset(j) if it fits, increment j
      integer function addset(c, set, j, maxsiz)
      character c, set(maxsiz)
      integer j, maxsiz

      if (j > maxsiz)
          addset = NO                    ! NO(0)
      else
          set(j) = c
          j = j + 1
          addset = YES                   ! YES(1)
      return
      end

Watcom Fortran77版は、下記の通り。

c addset.for -- put c inset(j) if it fits, increment j
      integer function addset(c, set, j, maxsiz)
      integer*1 c, set(maxsiz)
      integer j, maxsiz

      if (j .gt. maxsiz) then
          addset = 0                    ! NO(0)
      else
          set(j) = c
          j = j + 1
          addset = 1                    ! YES(1)
      endif
      return
      end

filset()は、略記法を考慮して、変換文字列を作り出します。

# filset.r4 -- expand set at array(i) into set(j), stop at delm
      subroutine filset(delim, array, i, set, j, maxset)
      character delim, array(ARB), set(maxset), esc
      integer i, j, maxset
      integer addset, iindex
      integer junk
      string lowalf "abcdefghijklmnopqrstuvwxyz"
      string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      string digits "0123456789"

      for ( ; array(i) != delim & array(i) != EOS; i = i + 1)
          if (array(i) .eq. ESCAPE)
              junk = addset(esc(array, i), set, j, maxset)
          else if (array(i) != DASH)
              junk = addset(array(i), set, j, maxset)
          else if (j <= 1 | array(i+1) == EOS)
              junk = addset(DASH, set, j, maxset) # set literal '-'
          else if (iindex(digits, set(j-1)) > 0)
              call dodash(digits, array, i, set, j, maxset)
          else if (iindex(lowalf, set(j-1)) > 0)
              call dodash(lowalf, array, i, set, j, maxset)
          else if (iindex(upalf, set(j-1)) > 0)
              call dodash(upalf, array, i, set, j, maxset)
          else
              junk = addset(DASH, set, j, maxset)
       return
       end

Watcom Fortran77版は、下記の通り。

c filset.for -- expand set at array(i) into set(j), stop at delm
      subroutine filset(delim,array,i,set,j,maxset)
      integer*1 delim, array(*), set(maxset), esc ! ARB(*)
      integer i, j, maxset
      integer addset, iindex
      integer junk
      integer*1 lowalf(27), upalf(27), digits(11)
      data lowalf/'a','b','c','d','e','f','g','h','i','j','k','l','m',
     1        'n','o','p','q','r','s','t','u','v','w','x','y','z',-2/ ! EOS(-2)
      data upalf/'A','B','C','D','E','F','G','H','I','J','K','L','M',
     1        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',-2/ ! EOS(-2)
      data digits/'0','1','2','3','4','5','6','7','8','9',-2/ ! EOS(-2)

      while ((array(i) .ne. delim) .and. (array(i) .ne. -2)) do ! EOS(-2)
          if (array(i) .eq. 64) then    ! ESCAPE(64)
              junk = addset(esc(array,i),set,j,maxset)
          else if (array(i) .ne. 45) then  ! DASH(45)
              junk = addset(array(i),set,j,maxset)
          else if ((j .le. 1) .or. (array(i+1) .eq. -2)) then  ! EOS(-2)
              junk = addset(45, set, j, maxset) ! DASH(45)        ! set literal '-'
          else if (iindex(digits, set(j-1)) .gt. 0) then
              call dodash(digits, array, i, set, j, maxset)
          else if (iindex(lowalf, set(j-1)) .gt. 0) then
              call dodash(lowalf, array, i, set, j, maxset)
          else if (iindex(upalf, set(j-1)) .gt. 0) then
              call dodash(upalf, array, i, set, j, maxset)
          else
              junk = addset(45, set, j, maxset) ! DASH(45)
          endif
          i = i + 1
       end while
       return
       end

filset()の下請けルーチン、addset()、iindex()はすでに紹介してあります。

esc()は、脱出記号を処理します。具体的には、次の通り。

# esc.r4 -- map array(i) into escaped character if appropriate
      character function esc(array,i)
      character array(ARB)
      integer i
      
      if (array(i) != ESCAPE)
          esc = array(i)
      else if (array(i+1) == EOS) # @ not special at end
          esc = ESCAPE
      else {
          i = i + 1
          if (array(i) == LETN)
              esc = NEWLINE
          else if (array(i) == LETT)
              esc = TAB
          else
              esc = array(i)
          }
      return
      end

Watcom Fortran77版は、下記の通り。

c esc.for -- map array(i) into escaped character if appropriate
      integer*1 function esc(array,i)
      integer*1 array(*)                ! ARB(*)
      integer i
      
      if (array(i) .ne. 64) then        ! ESCAPE(64 @)
          esc = array(i)
      else if (array(i+1) .eq. -2) then ! EOS(-2)
          esc = 64                      ! ESCAPE(@)
      else
          i = i + 1
          if (array(i) .eq. 110) then   ! LETN(110)
              esc = 10                  ! NEWLINE(10)
          else if (array(i) .eq. 116) then ! LETT(116)
              esc = 9                   ! TAB(9)
          else
              esc = array(i)
          end if
      end if
      return
      end

dodash()は、略記を処理します。ここでもaddset()、esc()をうまく使っています。内容は次の通り。

# dodash.r4 -- expand array(i-1)-array(i+1) into set(j)... from valid
      subroutine dodash(valid, array, i, set, j, maxset)
      character valid(ARB), array(ARB), set(maxset)
      integer i, j, maxset
      integer addset, junk, iindex, limit, k
      character esc

      i = i + 1
      j = j - 1
      limit =iindex(valid,esc(array,i))
      for (k = iindex(valid, set(j)); k <= limit; k = k + 1)
          junk = addset(valid(k), set, j, maxset)
      return
      end

Watcom Fortran77版は、下記の通り。

c dodash.for -- expand array(i-1)-array(i+1) into set(j)... from valid
      subroutine dodash(valid, array, i, set, j, maxset)
      integer*1 valid(*), array(*), set(maxset) ! ARB(*)
      integer i, j, maxset
      integer addset, junk, iindex, limit, k
      integer*1 esc

      i = i + 1
      j = j - 1
      limit =iindex(valid,esc(array,i))
      k = iindex(valid,set(j))
      while (k .le. limit) do
          junk = addset(valid(k),set,j,maxset)
          k = K + 1
      end while
      return
      end

次回は、まだ説明していない、下請けルーチンを紹介し、translitを完成させます。