文書整形 -- 指令の解析: アナクロなコンピューターエンジニアのつぶやき

指令の解析は容易であり、comtyp()で行う。メインルーチンから呼び出される comand()から、最初にcomtyp()が呼び出される。comand()は、comtyp()の返す値に従い、 必要な処理を行っていく。comand()は以下の通りである。

RATFORでは、

# comand.r4 -- perform formatting command
      subroutine comand( buf )
      character buf(MAXLINE)
      integer comtyp, getval
      integer ct, spval, val
      integer argtyp

      include cpage.ri
      include cparam.ri

      ct = comtyp(buf)
      if (ct == UNKOWN) # igore unknown commands
          return

      val = getval(buf,argtyp)
      if (ct == FI) {
          call brk
          fill = YES
          }
      else if (ct == NF) {
          call brk
          fill = NOC
          }
      else if (ct == BR)
          call brk
      else if (ct == LS)
          call set(lsval,val,argtyp,1,1,HUGE)
      else if (ct == HE)
          call gettl(buf,header)
      else if (ct == FO)
          call gettl(buf,footer)
      else if (ct == SP) {
          call set(spval,val,argtyp,1,0,HUGE)
          call space(spval)
          }
      else if (ct == BP) {
          if (lineno > 0)
              call space(HUGE)
          call set(curpage,val,argtyp,curpage+1,-HUGE,HUGE)
          newpag = curpag
          }
      else if (ct == PL) {
          call set(plval,val,argtyp,PAGELEN,m1val+m2val+m3val+m4val+1,HUGE)
          bottom = plval - m3val - m4val
          }
      else if (ct == IN) {
          call set(inval,val,argtyp,0,0,rmval-1)
          tival = inval
          }
      else if (ct == RM)
          call set(rmval,val,argtyp,PAGEWIDTH,tival+1,HUDGE)
      else if (ct == TI) {
          call brk
          call set(tival,val,argtyp,0,0,rmval-1)
          }
      else if (ct == CE) {
          call brk
          call set(ceval,val,argtyp,1,0,HUGE)
          }
      else if (ct .eq. 14) then ! UL(14)
          call set(ulval,val,argtyp,1,0,HUGE)

      return
      end

WATCOM fortran 77では、

c comand.f -- perform formatting command
      subroutine comand( buf )
      integer*1 buf(82)                 ! MAXLINE(82)
      integer comtyp, getval
      integer ct, spval, val
      integer*1 argtyp

      include cpage.fi
      include cparam.fi

      ct = comtyp(buf)
      if (ct .eq. 0) then               ! UNKOWN(0)
          return
      end if

      val = getval(buf,argtyp)
      if (ct .eq. 4) then               ! FI(4)
          call brk
          fill = 1                      ! YES(1)
      else if (ct .eq. 9) then          ! NF(9)
          call brk
          fill = 0                      ! NOC(0)
      else if (ct .eq. 2) then          ! BR(2)
          call brk
      else if (ct .eq. 8) then          ! LS(8)
          call set(lsval,val,argtyp,1,1,1000) ! HUGE(1000)
      else if (ct .eq. 6) then          ! HE(6)
          call gettl(buf,header)
      else if (ct .eq. 5) then          ! FO(5)
          call gettl(buf,footer)
      else if (ct .eq. 12) then         ! SP(12)
          call set(spval,val,argtyp,1,0,1000) ! HUGE(1000)
          call space(spval)
      else if (ct .eq. 1) then          ! BP(1)
          if (lineno .gt. 0) then
              call space(1000)          ! HUGE(1000)
          end if
          call set(curpage,val,argtyp,curpage+1,-1000,1000) ! HUGE(1000)
          newpag = curpag
      else if (ct .eq. 10) then         ! PL(10)
          call set(plval,val,argtyp,66, ! PAGELEN(66)
     1        m1val+m2val+m3val+m4val+1,1000) ! HUGE(1000)
          bottom = plval - m3val - m4val
      else if (ct .eq. 7) then          ! IN(7)
          call set(inval,val,argtyp,0,0,rmval-1)
          tival = inval
      else if (ct .eq. 11) then         ! RM(11)
          call set(rmval,val,argtyp,60,tival+1,1000) ! PAGEWIDTH(60) HUGE(1000)
      else if (ct .eq. 13) then         ! TI(13)
          call brk
          call set(tival,val,argtyp,0,0,rmval-1) 
      else if (ct .eq. 3) then          ! CE(3)
          call brk
          call set(ceval,val,argtyp,1,0,1000) ! HUGE(1000)
      else if (ct .eq. 14) then ! UL(14)
          call set(ulval,val,argtyp,1,0,1000) ! HUGE(1000)
      end if

      return
      end

実際の指令の解析は、comtyp()が行う。

RATFOR版は、以下の通り。

c comtyp.r4 -- decode command type
      integer function comtyp(buf)
      character buf(MAXLINE)

      if (buf(2) == LETB & buf(3) == LETP)
         comtyp = BP
      else if (buf(2) == LETB & buf(3) == LETR)
         comtyp = BR
      else if (buf(2) == LETC & buf(3) == LETE)
         comtyp = CE
      else if (buf(2) == LETF & buf(3) == LETI)
         comtyp = FI
      else if (buf(2) == LETF & buf(3) == LETO)
         comtyp = FO
      else if (buf(2) == LETH & buf(3) == LETE)
         comtyp = HE
      else if (buf(2) == LETI & buf(3) == LETN)
         comtyp = IN
      else if (buf(2) == LETL & buf(3) == LETS)
         comtyp = LS
      else if (buf(2) == LETN & buf(3) == LETF)
         comtyp = NF
      else if (buf(2) == LETP & buf(3) == LETL)
         comtyp = PL
      else if (buf(2) == LETR & buf(3) == LETM)
         comtyp = RM
      else if (buf(2) == LETS & buf(3) == LETP)
         comtyp = SP
      else if (buf(2) == LETT & buf(3) ==  LETI)
         comtyp = TI
      else if (buf(2) == LETU & buf(3) == LETL)
         comtyp = UL
      else
         comtyp = UNKOWN
      end if
      return
      end

WATCOM fortran77版は、以下の通り。

c comtyp.for -- decode command type
      integer function comtyp(buf)
      integer*1 buf(82)                 ! MAXLINE(82)

      if ((buf(2) .eq. 98) .and. (buf(3) .eq. 112)) then      ! LETB('b',98) LETP('p',112)
         comtyp = 1                         ! BP(1)
      else if ((buf(2) .eq. 98) .and. (buf(3) .eq. 114)) then ! LETB('b',98) LETR('r',114)
         comtyp = 2                     ! BR(2)
      else if ((buf(2) .eq. 99) .and. (buf(3) .eq. 101)) then ! LETC('c',99) LETE('r',101)
         comtyp = 3                     ! CE(3)
      else if ((buf(2) .eq. 102) .and. (buf(3) .eq. 105)) then ! LETF('f',102) LETI('i',105)
         comtyp = 4                     ! FI(4)
      else if ((buf(2) .eq. 102) .and. (buf(3) .eq. 111)) then ! LETF('f',102) LETO('o',111)
         comtyp = 5                     ! FO(5)
      else if ((buf(2) .eq. 104) .and. (buf(3) .eq. 101)) then ! LETH('h',104) LETE('e',101)
         comtyp = 6                     ! HE(6)
      else if ((buf(2) .eq. 105) .and. (buf(3) .eq. 110)) then ! LETI('i',105) LETN('n',110)
         comtyp = 7                     ! IN(7)
      else if ((buf(2) .eq. 108) .and. (buf(3) .eq. 115)) then ! LETL('l',108) LETS('n',115)
         comtyp = 8                     ! LS(8)
      else if ((buf(2) .eq. 110) .and. (buf(3) .eq. 102)) then ! LETN('n',110) LETF('f',102)
         comtyp = 9                     ! NF(9)
      else if ((buf(2) .eq. 112) .and. (buf(3) .eq. 108)) then ! LETP('n',112) LETL('l',108)
         comtyp = 10                    ! PL(10)
      else if ((buf(2) .eq. 114) .and. (buf(3) .eq. 109)) then  ! LETR('r',114) LETM('m',109)
         comtyp = 11                    ! RM(11)
      else if ((buf(2) .eq. 115) .and. (buf(3) .eq. 112)) then  ! LETS('s',115) LETP('p',112)
         comtyp = 12                    ! SP(12)
      else if ((buf(2) .eq. 116) .and. (buf(3) .eq. 105)) then  ! LETT('t',116) LETI('i',105)
         comtyp = 13                    ! TI(13)
      else if ((buf(2) .eq. 117) .and. (buf(3) .eq. 108)) then  ! LETU('u',117) LETL('l',108)
         comtyp = 14                    ! UL(14)
      else
         comtyp = 0                     ! UNKOWN(0)
      end if
      return
      end

指令の引数は、getval()で取得する。取得した値は、set()で設定する。

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

# getval.r4 - evaluate optional numeric argument
      integer function getval(buf,argtyp)
      character buf(MAXLINE)
      integer ctoi
      integer argtyp, i

      i = 1                        # skip command name
      while (buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINW)
          i = i + 1
      call skipbl(buf,i)           # find argument
      argtyp = buf(i)
      if (argtyp == PLUS | argtyp == MINUS)
         i = i + 1
      getval = ctoi(buf,i)
      return
      end

WATCOM fortran版は、以下の通り。

c getval.for - evaluate optional numeric argument
      integer function getval(buf,argtyp)
      integer*1 buf(82)                 ! MAXLINE(82)

      integer ctoi
      integer argtyp, i

      i = 1                             ! skip command name
      while ((buf(i) .ne. 32)           ! BLANK(32)
     1    .and. (buf(i) .ne. 9)         ! TAB(9)
     2    .and. (buf(i) .ne. 10)) do    ! NEWLINE(10)
          i = i + 1
      end while
      call skipbl(buf,i)                ! find argument
      argtyp = buf(i)
      if ((argtyp .eq. 43) .or. (argtyp .eq. 45)) then ! PLUS('+',43) MINUS('-',45)
         i = i + 1
      end if
      getval = ctoi(buf,i)
      return
      end

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

# set.r4 -- set parameter and check range
      subroutine set( param, val, argtyp, defval, minval, maxval )
      integer param, val, defval, minval, maxval
      character argtyp
      integer max,min

      if (argtyp == NEWLINE)
         param = defval
      else if (argtyp == PLUS)
         param = param + val
      else if (argtyp == MINUS)
         param = param - val
      else
         param = val

      param = min( param, maxval )
      param = max( param, minval )

      return
      end

WATCOM fortran版は、以下の通り。

c set.for -- set parameter and check range
      subroutine set( param, val, argtyp, defval, minval, maxval )
      integer param, val, defval, minval, maxval
      integer*1 argtyp
      integer max,min

      if (argtyp .eq. 10) then          ! defaulted  NEWLINE(10)
         param = defval
      else if (argtyp .eq. 43) then     ! relative + PLUS('+',43)
         param = param + val
      else if (argtyp .eq. 45) then     ! relative - NIMUS('-',45)
         param = param - val
      else
         param = val
      endif
      param = min( param, maxval )
      param = max( param, minval )

      return
      end