文字バッファの表現と文書行の管理2016年03月06日 20:30

文字バッファの表現と文書行の管理

編集するテキストは、バッファbuf()にしまい込む。この中には、行と行をリンクさせる 指標も含む。

     buf(k+0)   PREV 前の行の指標
     buf(k+4)   NEXT 次の行の指標
     buf(k+8)   MARK 広域指定の処理に使用
     buf(k+9)   TEXT 文字列の第一文字
     buf(k+10)  ...  第二文字・・・

このバッファを操作するルーチンをは、下記の通り。

     setbuf()  バッファを初期化して、第0行をだけを含む状態にする。
     clrbuf()  作業ファイルを捨てる。現状の版では、何もしない。
     inject(lin) linのテキストをバッファに転写する。
               curlinは、最後に送り込まれた行を指させる。
     getind(n) 行番号nをその行を占める指標に変換する。
     gettxt()  行の内容を共通領域ctxtのtxtに転写する。
     relink(k1,k2,k3,k4) 指標のつなぎ替えを行う。k2の逆方向の指標にk1をささせる。
               k3の順方向の指標にはk4を指させる。

文字バッファbufは共通領域cbufに置かれる。 共通領域cbufのRATFOR版は、以下の通り。

# cbuf.ri
      common /cbuf/buf,lastbf
      character buf(MAXBUF) # buffer for pointers plus text
      integer lastbf        # last element used in buf

WATCOM Fortran77版は以下の通り。

c cbuf.fi
      common /cbuf/buf,lastbf
      integer*1 buf(20000000) ! MAXBUF(20000000) buffer for pointers plus text
      integer lastbf          ! last element used in buf

文字バッファの文書は必要に応じてバッファtxtに転写される。 バッファtxtは共通領域ctxtに置かれる。 共通領域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

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

# setbuf.r4 (in memory) -- initialize line storage buffer
      subroutine setbuf
      logical addset,junk
      include cbuf.ri
      include clines.ri

      call relink(LINE0,LINE0,LINE0,LINE0)
      lastbf = LINE0 + TEXT
      junk = addset(EOF,buf,lastbf,MAXBUF)
      curln = 0
      lastln = 0
      return
      end

WATCOM Fortran77版は以下の通り。

c setbuf.f (in memory) -- initialize line storage buffer
      subroutine setbuf
      integer addset,junk

      include cbuf.fi
      include clines.fi

      call relink(1,1,1,1)              ! LINE0(1)
      lastbf = 1 + 12                   ! LINE0(1) TEXT(12)
      junk = addset(-2,buf,lastbf,20000000) ! EOS(-2) MAXBUF(20000000)
      curln = 0
      lastln = 0
      return
      end

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

# clrbuf.r4 -- initialize for new file
      subroutine clrbuf

      return # nothing to do
      end

WATCOM Fortran77版は以下の通り。

c clrbuf.for -- initialize for new file
      subroutine clrbuf
      return ! nothing to do
      end

getind()のRATFOR版は、以下の通り。getbufptr()は、バッファbufから、integerの 指標を取り出すためのルーチンである。

# getind.r4 -- locate line index in buffer
      integer function getind(line)
      integer line
      integer j,k,getbufptr

      include cbuf.fi

      k = LINE0
      for (j = 0; j < line; j = j + 1)
          k = getbufptr(buf(k+NEXT))
      getind = k
      return
      end

WATCOM Fortran77版は以下の通り。

c getind.f -- locate line index in buffer
      integer function getind(line)
      integer line
      integer j,k,getbufptr

      include cbuf.fi

      k = 1                    ! LINE0(1)
      j = 0
      while (j .lt. line) do
          k = getbufptr(buf(k+4)) ! NEXT(4)
          j = j + 1
      end while
      getind = k
      return
      end

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

# getbufptr.r4
      integer function getbufptr(buf)
      integer buf

      getbufptr = buf
      return
      end

WATCOM Fortran77版は以下の通り。

c getbufptr.for
      integer function getbufptr(buf)
      integer buf

      getbufptr = buf
      return
      end

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

# 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

コマンドの処理 1 APPEND,DELETE2016年03月14日 08:53

コマンドの処理 1 APPEND,DELETE

個々のコマンドの処理は、コマンドごとの処理ルーチンで行う。 処理にあたって、行番号の省略値の設定を行うルーチンdefalt()を示す。

RATFOR版は、以下の通り。

# defalt.r4 -- set default line numbers
      integer function defalt(def1,def2,status)
      integer def1,def2,status

      include clines.ri

      status = EOF)
      if (nlines == 0) {
          line1 = def1
          line2 = def2
          }

      if (line1 > line2 | line1 <= 0)
          status = ERR
      else
          status = OK
      defalt = status
      return
      end

WATCOM Fortran77版は以下の通り。

c defalt.f -- set default line numbers
      integer function defalt(def1,def2,status)
      integer def1,def2,status

      include clines.fi

      status = -1                       ! EOF(-1)
      if (nlines .eq. 0) then
          line1 = def1
          line2 = def2
      end if

      if ((line1 .gt. line2) .or. (line1 .le. 0)) then
          status = -3                   ! ERR(-3)
      else
          status = -2                   ! OK(-2)
      end if
      defalt = status
      return
      end

doprnt()は、行を印刷する。このルーチンはコマンド処理ルーチンの中から頻繁に呼ばれる。

RATFOR版は、以下の通り。

# doprnt.r4 -- print lines from through to
      integer function doprnt(from,to)
      integer from,to

      integer gettxt
      integer i,junk

      include clines.ri
      include ctxt.ri

      if (from <= 0) then
          doprnt = ERR
      else
          for (i = from; i <= to; i = i + 1) {
              junk = gettxt(i)
              call putlin(txt,6)
              }
          curln = to
          doprnt = OK
      end if
      return
      end

WATCOM Fortran77版は以下の通り。

c doprnt.f -- print lines from through to
      integer function doprnt(from,to)
      integer from,to

      integer gettxt
      integer i,junk

      include clines.fi
      include ctxt.fi

      if (from .le. 0) then
          doprnt = -3 ! ERR(-3)
      else
          i = from
          while (i .le. to) do
              junk = gettxt(i)
              call putlin(txt,6)
              i = i + 1
          end while
          curln = to
          doprnt = -2 ! OK(-2)
      end if
      return
      end

行を追加するAPPENDコマンドを処理するappend()を示す。

RATFOR版は、以下の通り。

# append.r4 -- append lines after "line"
      integer function append(line,glob)
      integer line,glob
      character lin(MAXLINE)
      integer getlin,inject

      include clines.ri

      if (glob == YES)
          append = YES
      else {
          curln = line
          for (append = NOSTATUS; append == NOSTATUS; )
              if (getlin(lin,STDIN) == EOF)
                   append = EOF
              else if (lin(1) == PERIOD & lin(2) == NEWLINE)
                   append = OK
              else if (inject(lin) == ERR
                  append = ERR
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c append.f -- append lines after "line"
      integer function append(line,glob)
      integer line,glob

      integer*1 lin(82)                 ! MAXLINE(82)
      integer*1 getlin
      integer inject

      include clines.fi

      if (glob .eq. 1) then             ! YES(1)
          append = -3                   ! ERR(-3)
      else
          curln = line
          append = 0                    ! NOSTATUS(0)
          while (append .eq. 0) do      ! NOSTATUS(0)
              if (getlin(lin,5) .eq. -1) then ! EOF(-1)
                   append = -1          ! EOF(-1)
              else if ((lin(1) .eq. 46) ! PERIOD(46 '.')
     1             .and. (lin(2) .eq. 10)) then  ! NEWLINE(10)
                   append = -2          ! OK(-2)
              else if (inject(lin) .eq. -3) then ! ERR(-3)
                  append = -3           ! ERR(-3)
              end if
          end while
      end if
      return
      end

行を削除するDELETEコマンドでは、削除の確認のために行を打ち出すp印を 付けることができる。これを処理するckp()を示す。

RATFOR版は、以下の通り。

# ckp.r4 -- check for "p" after command
      integer function ckp(lin,i,pflag,stats)
      character lin(MAXLINE)
      integer i,j,pflag,status

      j = i
      if (lin(j) == PRINT)
          j = j + 1
          pflag = YES
      else
          pflag = NO
      if (lin(j) == NEWLINE)
          status = OK
      else
          status = ERR
      ckp = status
      return
      end

WATCOM Fortran77版は以下の通り。

c ckp.for -- check for "p" after command
      integer function ckp(lin,i,pflag,stats)
      integer*1 lin(82)                 ! MAXLINE(82)
      integer i,j,pflag,status

      j = i
      if (lin(j) .eq. 112) then         ! PRINT(100,'p')
          j = j + 1
          pflag = 1                     ! YES(1)
      else
          pflag = 0                     ! NO(0)
      end if
      if (lin(j) .eq. 10) then          ! NEWLINE(10)
          status = -2                   ! OK(-2)
      else
          status = -3                   ! ERR(-3)
      end if
      ckp = status
      return
      end

DELETEコマンドは、指定された行を削除するわけだが、 実際には行と行のつなぎ情報を操作するだけである。

RATFOR版。

# delcmd.r4 -- delete lines from though to
      integer function delcmd(from,to,status)
      integer from,to,status

      integer getind,nextln,prevln
      integer k1,k2

      include clines.ri

      if (from <= 0)
          status = ERR
      else {
          k1 = getind(prevln(from))
          k2 = getind(nextln(to))
          lastln  = lastln - (to - from + 1)
          curln = prevln(from)
          call relink(k1,k2,k1,k2)
          status = OK
          }
      delcmd = status
      return
      end

WATCOM Fortran77版。

c delcmd.f -- delete lines from though to
      integer function delcmd(from,to,status)
      integer from,to,status

      integer getind,nextln,prevln
      integer k1,k2

      include clines.fi

      if (from .le. 0) then
          status = -3                   ! ERR(-3)
      else
          k1 = getind(prevln(from))
          k2 = getind(nextln(to))
          lastln  = lastln - (to - from + 1)
          curln = prevln(from)
          call relink(k1,k2,k1,k2)
          status = -2                   ! OK(-2)
      end if
      delcmd = status
      return
      end