アナクロなコンピューターエンジニアのつぶやき

文脈検索は、ptscan()で行う。これで使う文字パターンはoptpat()で作成する。

optpat()のRATFOR版は、以下の通り。

# optpat.r4 -- make pattern if specified at lin(i)
      integer function optpat(lin,i)
      character lin(MAXLINE)
      integer i
      integer makpat
      include cpat.ri

      if (lin(i) == EOS)
          i = ERR
      else if (lin(i+1) == EOS)
          i = ERR
      else if (lin(i+1) == lin(i)) # repeated delimiter
          i = i + 1                  # existing pattern alone
      else
          i = makpat(lin,i+1,lin(i),pat)
      if (pat(1) == EOS)
          i = ERR
      if (i == ERR) {
          pat(1) = EOS
          optpat = ERR
      } else
          optpat = OK
      return
      end

WATCOM Fortran77版は以下の通り。

c optpat.f -- make pattern if specified at lin(i)
      integer function optpat(lin,i)
      integer*1 lin(81)                 ! MAXLINE(81)
      integer i
      integer makpat
      include cpat.fi

      if (lin(i) .eq. -2) then ! EOS(-2)
          i = -3                        ! ERR(-3)
      else if (lin(i+1) .eq. -2) then   ! EOS(-2)
          i = -3                        ! ERR(-3)
      else if (lin(i+1) .eq. lin(i)) then ! repeated delimiter
          i = i + 1                     ! leave existing pattern alone
      else
          i = makpat(lin,i+1,lin(i),pat)
      end if

      if (pat(1) .eq. -2) then ! EOS(-2)
          i = -3
      end if
      if (i .eq. -3) then
          pat(1) = -2                   ! EOS(-2)
          optpat = -3                   ! ERR(-3)
      else
          optpat = -2                   ! OK(-2)
      end if
      return
      end

文脈検索するptscan()は以下のようになる。

RATFOR版は、以下の通り。

# ptscan.r4 -- scan for next occurrence of pattern
      integer function ptscan(way,num)
      integer way,num
      integer gettxt,nextln,prevln
      integer match
      integer k
      include cpat.ri
      include ctxt.ri
      include clines.ri

      num = curln
      loop
          if (way == FORWARD)
              num = nextln(num)
          else
              num = prevln(num)
          k = gettxt(num)
          if (match(txt,pat) == YES) {
              ptscan = OK
              return
          }
      until (num == curln)
      ptscan = ERR
      return
      end

WATCOM Fortran77版は以下の通り。

c ptscan.f -- scan for next occurrence of pattern
      integer function ptscan(way,num)
      integer way,num
      integer gettxt,nextln,prevln
      integer match
      integer k
      include cpat.fi
      include ctxt.fi
      include clines.fi

      num = curln
      loop
          if (way .eq. 1) then          ! FORWARD(1)
              num = nextln(num)
          else
              num = prevln(num)
          end if
          k = gettxt(num)
          if (match(txt,pat) .eq. 1) then ! YES(1)
              ptscan = -2               ! OK(-2)
              return
          end if
      until (num .eq. curln)
      ptscan = -3                       ! ERR(-3)
      return
      end

ここでincludeされるcpatは以下のとおり。

RATFOR版は、

# cpat.ri
      common /cpat/pat
      character pat(MAXPAT) # pattern

WATCOM Fortran77版は、

c cpat.fi
      common /cpat/pat
      integer*1 pat(1001)               ! MAXPAT(1001) pattern

また、ctxtは以下のとおり。

RATFOR版は、

# ctxt.ri
      common /ctxt/txt
      character txt(MAXLINE) # text line for matching and output

WATCOM Fortran77版は、

c ctxt.fi
      common /ctxt/txt
      integer*1 txt(81)               ! MAXLINE(81) text line for matching and output

ptscan()で使用する、nextln()、prevln()は、それぞれ、次の行、前の行を取り出してくる。

nextln()のRATFOR版は、

# nextln.r4 -- get line after "line"
      integer function nextln(line)
      integer line
      include clines.ri

      nextln = line + 1
      if (nextln > lastln) then
          nextln = 0
      end if
      return
      end

WATCOM Fortran77版は、

c nextln.f -- get line after "line"
      integer function nextln(line)
      integer line

      include clines.fi

      nextln = line + 1
      if (nextln .gt. lastln) then
          nextln = 0
      end if
      return
      end

prevln()のRATFOR版は、

# prevln.r4 -- get line before "line"
      integer function prevln(line)
      integer line

      include clines.ri

      prevln = line - 1
      if (prevln < 0) 
          prevln = lastln
      return
      end

WATCOM Fortran77版は、

c prevln.f -- get line before "line"
      integer function prevln(line)
      integer line

      include clines.fi

      prevln = line - 1
      if (prevln .lt. 0) then
          prevln = lastln
      end if
      return
      end