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

置換指令substituteは文字の置き換えを行う。形式は、

     (.,.)s/文型/更新型/gp

置換指令ののためのdocmdの該当部分は、以下の通り。

      else if (lin(i) == SUBSTITUTE) {
          i = i + 1
          if (optpat(lin,i) == OK)
              if (getrhs(lin,i,sub,gflag) == OK)
                  if (ckp(lin,i+1,pflag,status) == OK)
                      if (defalt(curln,curln,status) == OK)
                          status = subst(sub,gflag)
          }

optpat()で文型を取得し、getrhs()で更新型を取得する。実際の置換はsubst()で行う。

getrhs()のRATFOR版は以下の通り。

# getrhs.r4 -- get substitution string for "s" command
      integer function getrhs(lin,i,sub,gflag)
      character lin(MAXLINE),sub(MAXPAT)
      integer i,gflag,maksub

      getrhs = ERR
      if (lin(i) == EOS)
          return
      if (lin(i+1) == EOS)
          return
      i = maksub(lin,i+1,lin(i),sub)
      if (i == ERR)
          return
      if (lin(i+1) == GLOBAL) {
          i = i + 1
          gflag = YES
          }
      else
          gflag = NO
      getrhs = OK
      return
      end

WATCOM fortran77版は以下の通り。

c getrhs.for -- get substitution string for "s" command
      integer function getrhs(lin,i,sub,gflag)
      integer*1 lin(81),sub(81)         ! MAXLINE(81) MAXPAT(81)
      integer i,gflag,maksub

      getrhs = -3                       ! ERR(-3)
      if (lin(i) .eq. -2) then          ! EOS(-2)
          return
      end if
      if (lin(i+1) .eq. -2) then        ! EOS(-2)
          return
      end if
      i = maksub(lin,i+1,lin(i),sub)
      if (i .eq. -3) then               ! ERR(-3)
          return
      end if
      if (lin(i+1) .eq. 103) then       ! GLOBAL('g'103)
          i = i + 1
          gflag = 1                     ! YES(1)
      else
          gflag = 0                     ! NO(0)
      end if
      getrhs = -2                       ! OK(-2)
      return
      end

subst()のRAFOR版は以下の通り。

# subst.r4 -- substitute "sub" for occurrences of pattern
      integer function subst(sub,gflag)
      character sub(MAXPAT)
      integer gflag

      character new(MAXLINE)
      integer amatch,gettxt,inject,delete
      integer j,junk,lastm,line,m,status
      integer addset,subbed

      include clines.ri
      include cpat.ri
      include ctxt.ri

      subst = ERR
      if (line1 <= 0)
          return
      for (line = line1;line <= line2;line=line+1) {
          j = 1
          subbed = YES
          junk = gettxt(line)
          lastm = 0
          for (k = 1;txt(k) != EOS; ) {
              if (gflag == YES | subbed == NO)
                  m = amatch(txt,k,pat)
              else
                  m = 0
              if (m > 0 & lastm != m) { # replace machied text
                  subbed = YES
                  call catsub(txt,k,m,sub,new,j,MAXLINE)
                  lastm = m
                  }
              if ((m == 0) | m == k) then { # no match or null match
                  junk = addset(txt(k),new,j,MAXLINE)
                  k = k + 1
                  }
              else                      # skip matched text
                  k = m
              }
          if (subbed == YES)
              if (addset(EOS,new,j,MAXLINE) == NO) {
                  subst = ERR
                  break
                  }
              jumk = delete(line,line,status) # remembers dot
              subst = inject(new)
              if (subst == ERR)
                  break
              subst = OK
              }
          }
      return
      end

WATCOM fortran77版は以下の通り。

c subst.f -- substitute "sub" for occurrences of pattern
      integer function subst(sub,gflag)
      integer*1 sub(81)                 ! MAXPAT(81)
      integer gflag

      integer*1 new(82)                 ! MAXLINE(82)
      integer amatch,gettxt,inject,delcmd
      integer j,junk,lastm,line,m,status
      integer addset,subbed

      include clines.fi
      include cpat.fi
      include ctxt.fi

      subst = -3                        ! ERR(-3)
      if (line1 .le. 0) then
          return
      end if
      line = line1
      while (line .le. line2) do
          j = 1
          subbed = 1                    ! YES(1)
          junk = gettxt(line)
          lastm = 0
          k = 1
          while (txt(k) .ne. -2) do     ! EOS(-2)
              if (gflag .eq. 1 .or. subbed .eq. 0) then
                  m = amatch(txt,k,pat)
              else
                  m = 0
              end if
              if ((m .gt. 0) .and. (lastm .ne. m)) then ! replace machied text
                  subbed = 1            ! YES(1)
                  call catsub(txt,k,m,sub,new,j,82) ! MAXLINE(82)
                  lastm = m
              end if
              if ((m .eq.0) .or. (m .eq. k)) then ! no match or null match
                  junk = addset(txt(k),new,j,82) ! MAXLINE(82)
                  k = k + 1
              else                      ! skip matched text
                  k = m
              end if
          end while
          if (subbed .eq. 1) then       ! YES(1)
              if (addset(-2,new,j,82) .eq. 0) then ! EOS(-2) MAXLINE(82) NO(0)
                  subst = -3            ! ERR(-3)
                  exit
              end if
              jumk = delcmd(line,line,status) ! remembers dot
              subst = inject(new)
              if (subst .eq. -3) then ! ERR(-3)
                  exit
              end if
              subst = -2                ! OK(-2)
          end if
          line = line + 1
      end while
      return
      end