コマンドの処理 ７ docmd()(再掲)とメインルーチンedit: アナクロなコンピューターエンジニアのつぶやき

行の複写指令を含めたdocmd()を以下に示す。docmd()は指令文字を一つ一つ 比較しながら分岐を行い、各指令の前提条件確認し、指令を実行する。

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

# docmd.r4 -- handle all commands except globals
      integer function docmd(lin,i,glob,status)
      character lin(MAXLINE)
      integer i,glob,status

      integer append,doprnt,defalt,nextln,prevln,move,ckp,getone
      integer dodel,getrhs,subst,getfn,doread,dowrit
      integer line3
      character file(MAXLINE)
      integer pflag,gflag,optpat

      include clines.ri
      include cfile.ri
      include cpat.ri

      pflag = NO
      status = ERR
      if (lin(i) == APPENDCOM) {
          if (lin(i+1) == NEWLINE)
              status = append(line2,glob)
          }
      else if (lin(i) == CHANGE) {
          if (lin(i+1) == NEWLINE)
              if (defalt(curln,curln,status) == OK)
                  if (delete(line1,line2,status) == OK)
                      status = append(prevln(line1),glob)
          }
      else if (lin(i) == DELETE) {
          if (ckp(lin,i+1,pflag,status) == OK)
              if (defalt(curln,curln,status) == OK)
                  if (dodel(line1,line2,status) == OK)
                      if (nextln(curln) == 0)
                          curln = nextln(curln)
          }
      else if (lin(i) == INSERT) {
          if (lin(i+1) == NEWLINE)
              status = append(prevln(line2),glob)
          }
      else if (lin(i) == PRINTCUR) {
          if (ckp(lin,i+1,pflag,status) == OK) {
              call putdec(line2,1)
              call putc(NEWLINE)
              }
          }
      else if (lin(i) == COPYCMD) {
          i = i + 1
          if (getone(lin,i,line3,status) == EOF)
              status = ERR
          if (status == OK)
              if (ckp(lin,i,pflag,status) == OK)
                  if (defalt(curln,curln,status) == OK)
                      status = kopy(line3)
          }
      else if (lin(i) == MOVECOM) {
          i = i + 1
          if (getone(lin,i,line3,status) == EOF)
              status = ERR
          if (status == OK)
              if (ckp(lin,i,pflag,status) == OK)
                  if (defalt(curln,curln,status) ==OK)
                      status = move(line3)
          }
      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)
          }
      else if (lin(i) == ENTER) {
          if (nlines == 0) then
              if (getfn(lin,i,file) == OK) {
                  call scopy(file,1,savfil,1)
                  call clrbuf
                  call setbuf
                  status = doread(0,file)
              }
          }
      else if (lin(i) == PRINTFIL) {
          if (nlines == 0)
              if (getfn(lin,i,file) == OK) {
                  call scopy(file,1,savfil,1)
                  call putlin(savfil,STDOUT)
                  call putc(NEWLINE)
                  status = OK
              }
          }
      else if (lin(i) == READCOM) {
          if (getfn(lin,i,file) == OK)
              status = doread(line2,file)
          }
      else if (lin(i) ==WRITECOM) {
          if (getfn(lin,i,file) == OK)
              if (defalt(1,lastln,status) == OK)
                  status = dowrit(line1,line2,file)
              end if
          }
      else if (lin(i) == PRINT) {
          if (lin(i+1) == NEWLINE)
              if (defalt(curln,curln,status) == OK)
                  status = doprnt(line1,line2)
          }
      else if (lin(i) == QUIT) {
          if (lin(i+1) == NEWLINE & nlines == 0 & glob == NO)
              status = EOF
          }
      # else status is ERR
      end if

      if (status == OK & pflag == YES)
          status = doprnt(curln,curln)
      docmd = status
      return
      end

WATCOM fortran77版は以下の通り。

c docmd.f -- handle all commands except globals
      integer function docmd(lin,i,glob,status)
      integer*1 lin(82)                 ! MAXLINE(82)
      integer i,glob,status

      integer append,doprnt,defalt,nextln,prevln,move,ckp,getone
      integer delcmd,getrhs,subst,getfn,doread,dowrit
      integer line3,pflag,gflag,optpat
      integer*1 file(82),sub(82)        ! MAXLINE(82) MAXPAT(82)

      include clines.fi
      include cfile.fi
      include cpat.fi

      pflag = 0                         ! NO(0)
      status = -3                       ! ERR(-3)
      if (lin(i) .eq. 97) then          ! APPENDCOM(97 'a')
          if (lin(i+1) .eq. 10) then    ! NEWLINE(10)
              status = append(line2,glob)
          end if
      else if (lin(i) .eq. 99) then     ! CHANGE(99,'c')
          if (lin(i+1) .eq. 10) then    ! NEWLINE(10)
              if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                  if (delete(line1,line2,status) .eq. -2) then ! OK(-2)
                      status = append(prevln(line1),glob)
                  end if
              end if
          end if
      else if (lin(i) .eq. 107) then    ! COPYCMD(107, 'k')
          i = i + 1
          if (getone(lin,i,line3,status) .eq. -1) then ! EOF(-1)
              call putdec(line3,1)
              call putc(10)
              status = -3               ! ERR(-3)
          end if 
          if (status .eq. -2) then           ! OK(-2)
              if (ckp(lin,i,pflag,status) .eq. -2) then ! OK(-2)
                  if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                      status = kopy(line3)
                  end if
              end if
          end if
      else if (lin(i) .eq. 100) then    ! DELETE(100,'d')
          if (ckp(lin,i+1,pflag,status) .eq. -2) then ! OK(-2)
              if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                  if (delcmd(line1,line2,status) .eq. -2) then ! OK(-2)
                      if (nextln(curln) .ne. 0) then
                          curln = nextln(curln)
                      end if
                   end if
              end if
          end if
      else if (lin(i) .eq. 105) then    ! INSERT(105,'i')
          if (lin(i+1) .eq. 10) then    ! NEWLINE(10)
              status = append(prevln(line2),glob)
          end if
      else if (lin(i) .eq. 61) then     ! PRINTCUR(61,'=')
          if (ckp(lin,i+1,pflag,status) .eq. -2) then ! OK(-2)
              call putdec(line2,1)
              call putc(10)             ! NEWLINE(10)
          end if
      else if (lin(i) .eq. 109) then    ! MOVECOM(109,'m')
          i = i + 1
          if (getone(lin,i,line3,status) .eq. -1) then ! EOF(-1)
              status = -3               ! ERR(-3)
          end if
          if (status .eq. -2) then      ! OK(-2)
              if (ckp(lin,i,pflag,status) .eq. -2) then ! OK(-2)
                  if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                      status = move(line3)
                  end if
              end if
          end if
      else if (lin(i) .eq. 115) then    ! SUBSTITUTE(115,'s')
          i = i + 1
          if (optpat(lin,i)) then
              if (getrhs(lin,i,sub,gflag) .eq. -2) then ! OK(-2)
                  if (ckp(lin,i+1,pflag,status) .eq. -2) then ! OK(-2)
                      if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                          status = subst(sub,gflag)
                      end if
                  end if
              end if
          end if
      else if (lin(i) .eq. 101) then    ! ENTER(101,'e')
          if (nlines .eq. 0) then
              if (getfn(lin,i,file) .eq. -2) then ! OK(-2)
                  call scopy(file,1,savfil,1)
                  call clrbuf
                  call setbuf
                  status = doread(0,file)
              end if
          end if
      else if (lin(i) .eq. 102) then    ! PRINTFIL(102,'f')
          if (nlines .eq. 0) then
              if (getfn(lin,i,file) .eq. -2) then ! OK(-2)
                  call scopy(file,1,savfil,1)
                  call putlin(savfil,6) ! STDOUT(6)
                  call putc(10)         ! NEWLINE(10)
                  status = -2           ! OK(-2)
              end if
          end if
      else if (lin(i) .eq. 114) then    ! READCOM(114,'r')
          if (getfn(lin,i,file) .eq. -2) then ! OK(-2)
              status = doread(line2,file)
          end if
      else if (lin(i) .eq. 119) then    ! WRITECOM(119'w')
          if (getfn(lin,i,file) .eq. -2) then ! OK(-2)
              if (defalt(1,lastln,status) .eq. -2) then
                  status = dowrit(line1,line2,file)
              end if
          end if
      else if (lin(i) .eq. 112) then    ! PRINT(112 'p')
          if (lin(i+1) .eq. 10) then    ! NEWLINE(10)
              if (defalt(curln,curln,status) .eq. -2) then ! OK(-2)
                  status = doprnt(line1,line2)
              end if 
          end if
      else if (lin(i) .eq. 113) then    ! QUIT(113 'q')
          if ((lin(i+1) .eq. 10) .and.  ! NEWLINE(10)
     1       (nlines .eq. 0) .and. (glob .eq. 0)) then ! NO(0)
              status = -1               ! EOF(-1)
          end if
      ! else status is ERR
      end if

      if ((status .eq. -2) .and. (pflag .eq. 1)) then ! OK(-2) YES(1)
          status = doprnt(curln,curln)
      end if
      docmd = status
      return
      end

editのRATFOR版は以下の通り。

# edit.r4 (in memory) -- text editor
      program edit
      integer*1 getlin,lin(MAXLINE)
      integer getlst,doglob,docmd,ckglob,doread
      integer i,status,cursav
      integer getarg

      include cfile.fi
      include clines.fi
      include cpat.fi

      call initfile
      call setbuf

      pat(1) = EOS
      status = ERR

      if (getarg(1,savfil,MAXLINE != EOF)
          if (doread(0,savfil) == ERR)
              call remark('?.')

      while (getlin(lin,STDIN) != EOF) {
          i = 1
          cursav = curln
          if (getlst(lin,i,status) == OK)
              if (ckglob(lin,i,status) == OK)
                  status = doglob(lin,i,cursav,status)
              else if (status != ERR)
                  status = docmd(lin,i,NO,status)
              ! else error, do nothing

          if (status == ERR) {
               call remark('?.')
               curln = cursav
               }
          else if (status == EOF)
               break
          ! else OK, loop
          }
      call clrbuf

      stop
      end

WATCOM fortran77版は以下の通り。

c edit.f (in memory) -- text editor
      program edit
      integer*1 getlin,lin(82)          ! MAXLINE(82)
      integer getlst,doglob,docmd,ckglob,doread
      integer i,status,cursav
      integer getarg

      include cfile.fi
      include clines.fi
      include cpat.fi

      call initfile
      call setbuf

      pat(1) = -2                       ! EOS(-2)
      status = -3                       ! ERR(-3)

      if (getarg(1,savfil,82) .ne. -1) then  ! MAXLINE(82) EOF(-1)
          if (doread(0,savfil) .eq. -3) then ! ERR(-3)
              call remark('?.')
          end if
      end if

      while (getlin(lin,5) .ne. -1) do  ! STDIN(5) EOF(-1)
          i = 1
          cursav = curln
          if (getlst(lin,i,status) .eq. -2) then       ! OK(-2)
              if (ckglob(lin,i,status) .eq. -2) then   ! OK(-2)
                  status = doglob(lin,i,cursav,status)
              else if (status .ne. -3) then            ! ERR(-3)
                  status = docmd(lin,i,0,status)       ! NO(0)
              ! else error, do nothing
              end if
          end if
          if (status .eq. -3) then      ! ERR(-3)
               call remark('?.')
               curln = cursav
          else if (status .eq. -1) then ! EOF(-1)
               exit
          ! else OK, loop
          end if
      end while
      call clrbuf

      stop
      end