# inject.f -- put text from line after curln integer function inject(lin) character lin(MAXLINE) integer addset,junk integer getind,nextln integer i,k1,k2,k3 include cbuf.ri include clines.ri for (i = 1; lin(i) != EOS; ) { k3 = lastbf lastbf = lastbf + TEXT while (lin(i) != EOS) { junk = addset(lin(i),buf,lastbf,MAXBUF) i = i + 1 if (lin(i-1) == NEWLINE) break } if (addset(EOS,buf,lastbf,MAXBUF) == NO) { inject = ERR break } k1 = getind(curln) k2 = getind(nextln(curln)) call relink(k1,k3,k3,k2) call relink(k3,k2,k1,k3) curln = curln + 1 lastln = lastln + 1 inject = OK } return end

WATCOM Fortran77版は以下の通り。

c inject.f -- put text from line after curln
      integer function inject(lin)
      integer*1 lin(*)
      integer addset,junk
      integer getind,nextln
      integer i,k1,k2,k3
      include cbuf.fi
      include clines.fi

      i = 1
      while (lin(i) .ne. -2) do         ! EOS(-2)
          k3 = lastbf
          lastbf = lastbf + 12          ! TEXT(12)
          while (lin(i) .ne. -2) do     ! EOS(-2)
              junk = addset(lin(i),buf,lastbf,20000000) ! MAXBUF(20000000)
              i = i + 1
              if (lin(i-1) .eq. 10) then ! NEWLINE(10)
                  exit
              end if
          end while
          if (addset(-2,buf,lastbf,20000000) .eq. 0) then ! NO(0) MAXBUF(20000000)
              inject = -3               ! ERR(-3)
              exit
          end if
          k1 = getind(curln)
          k2 = getind(nextln(curln))

          call relink(k1,k3,k3,k2)
          call relink(k3,k2,k1,k3)
          curln  = curln + 1
          lastln = lastln  + 1
          inject = -2                   ! OK(-2)
      end while
      return
      end

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

# relink.r4 -- rewrite two harf links
      subroutine relink(a,x,y,b)
      integer a,b,x,y

      include cbuf.ri

      call setbufptr(a,buf(x+PREV))
      call setbufptr(b,buf(y+NEXT))
      return
      end

WATCOM Fortran77版は以下の通り。

c relink.f -- rewrite two harf links
      subroutine relink(a,x,y,b)
      integer a,b,x,y

      include cbuf.fi

      call setbufptr(a,buf(x+0))  ! PREV(0)
      call setbufptr(b,buf(y+4))  ! NEXT(4)
      return
      end

ここで、setbufptr()は指標をセットするルーチン。

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

# setbufptr.r4
      subroutine setbufptr(ptr,buf)
      integer ptr,buf

      buf = ptr
      return
      end

WATCOM Fortran77版は以下の通り。

c setbufptr.for
      subroutine setbufptr(ptr,buf)
      integer ptr,buf

      buf = ptr
      return
      end