c makpat.for -- make pattern from arg(from), teminate delim integer function makpat(arg,from,delim,pat) integer*1 arg(81),pat(81),delim ! MAXARG(81) MAXPAT(81) integer from integer*1 esc integer stclos,addset,getccl integer i,j,junk,lastcl,lastj,lj j = 1 lastj = 1 lastcl = 0 i = from while ((arg(i) .ne. delim) .and. (arg(i) .ne. -2)) do ! EOS(-2) lj = j if (arg(i) .eq. 63) then ! ANY(63 '?') junk = addset(63,pat,j,81) ! ANY(63 '?') MAXPAT(81) else if ((arg(i) .eq. 37) ! BOL(37 '%') 1 .and. (i .eq. from)) then junk = addset(37,pat,j,81) ! BOL(37 '%') MAXPAT(81) else if ((arg(i) .eq. 36) .and. (arg(i+1) .eq. delim)) then ! EOL(36 '$') junk = addset(36,pat,j,81) ! EOL(36 '%') MAXPAT(81) else if (arg(i) .eq. 91) then ! CCL(91 '[') if (getccl(arg,i,pat,j) .eq. 0) then ! NO(0) exit end if ! junk = addset(93,pat,j,81) ! COLEND(93 ']') MAXPAT(81) else if ((arg(i) .eq. 42) .and. (i .gt. from)) then ! CLOSURE(42 '*') lj = lastj if ((pat(lj) .eq. 37) ! BOL(37 '%') 1 .or. (pat(lj) .eq. 36) ! EOL(36 '$') 2 .or. (pat(lj) .eq. 42)) then ! CLOSURE(42 '*') exit end if lastcl = stclos(pat,j,lastj,lastcl) else junk = addset(97,pat,j,81) ! CHAR(97 'a') MAXPAT(81) junk = addset(esc(arg,i),pat,j,81) ! MAXPAT(81) end if lastj = lj i = i + 1 end while if (arg(i) .ne. delim) then ! terminated erarly makpat = -1 ! ERR(-1) else if (addset(-2,pat,j,81) .eq. 0) then ! no room EOS(-2) MAXPAT(81) NO(0) makpat = -1 ! ERR(-1) else makpat = i end if return end

getccl()のRATFOR版は下記の通り。

# getccl.r4 -- expand char class at atg(i) into pat(j)
      integer function getccl(arg,i,pat,j)
      character arg(MAXARG),pat(MAXPAT)
      integer i,j
      integer addset,junk,jstart
      
      i = i + 1
      if (arg(i) == NOT) {
          junk = addset(NCCL,pat,j,MAXPAT)
          i = i + 1
          }
      else
          junk = addset(CCL,pat,j,MAXPAT)
      jstart = j
      junk = addset(0,pat,j,MAXPAT) # leave room for count
      call filset(CCLEND,arg,i,pat,j,MAXPAT)
      pat(jstart) = j - jstart - 1
      if (arg(i) == CCLEND)
          getccl = OK
      else
          getccl = ERR
      return
      end

WATCOM Fortran77版は下記の通り。

c getccl.for -- expand char class at atg(i) into pat(j)
      integer function getccl(arg,i,pat,j)
      integer*1 arg(81),pat(81)         ! MAXARG(81) MAXPAT(81)
      integer i,j
      integer addset,junk,jstart
      
      i = i + 1
      if (arg(i) .eq. 33) then          ! NOT(33 '!')
          junk = addset(110,pat,j,81)   ! NCCL(110, 'n') MAXPAT(81)
          i = i + 1
      else
          junk = addset(91,pat,j,81)    ! CCL(91, '[') MAXPAT(81)
      end if
      
      jstart = j
      junk = addset(0,pat,j,81)         ! leave room for count MAXPAT(81)
      call filset(93,arg,i,pat,j,81)    ! COLEND(93 ']')  MAXPAT(81)
      pat(jstart) = j - jstart - 1      ! save count

      if (arg(i) .eq. 93) then          ! COLEND(93 ']')
          getccl = 1                    ! OK(1)
      else
          getccl = -1                   ! ERR(-1)
      end if
      return
      end

stclos()のRATFOR版は下記の通り。

# stclos.r4 -- insert closure entry at pat(j)
      integer function stclos(pat,j,lastj,lastcl)
      character pat(MAXPAT)
      integer j,junk,jp,jt,lastj,lastcl
      integer addset,
      
      for (jp = j - 1; jp >= lastj; jp = jp - 1) {  make a hole
          jt = jp + COLSIZE
          junk = addset(pat(jp),pat,jt,MAXPAT)
          }
      j = j + CLOSIZE
      stclos = lastj
      junk = addset(CLOSURE,pat,lastj,MAXPAT)  # put closure in it
      junk = addset(0,pat,lastj,MAXPAT)        # COUNT
      junk = addset(lastcl,pat,lastj,MAXPAT)   # PREVCL
      junk = addset(0,pat,lastj,MAXPAT)        # START
      return
      end

WATCOM Fortran77版は下記の通り。