文字バッファの表現と文書行の管理 ― 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,DELETE ― 2016年03月14日 08:53
個々のコマンドの処理は、コマンドごとの処理ルーチンで行う。 処理にあたって、行番号の省略値の設定を行うルーチン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
最近のコメント