Ratforプリプロセッサー -- コード生成 "if"と"if-else": アナクロなコンピューターエンジニアのつぶやき

"if"文に出会ったら、2つのラベル、LとL+1を生成し、

          if(.not(条件)) goto L

ifcode()のRatofor版は以下の通り。

# ifcode.r4 -- generate initial code for if
      subroutine ifcode(lab)
      integer lab
      integer labgen

      lab = labgen(2)
      call ifgo(lab)
      return
      end

WATCOM Fortran77版は以下の通り。

c ifcode.f -- generate initial code for if
      subroutine ifcode(lab)
      integer lab
      integer labgen

      lab = labgen(2)
      call ifgo(lab)
      return
      end

ifgo()は、

          if(.not.(条件)) goto lab

ifgo()のRatofor版は以下の通り。

# ifgo.r4 -- generate "if (.not. (...)) goto lab"
      include ratfor.def
      subroutine ifgo(lab)
      integer lab
      string ifnot "if (.not. "

      call outtab           # get to column 7
      call outstr(ifnot)    # "if (.not. "
      call balpar           # collect and output condition
      call outch(RPAREN)    # ")"
      call outch(BLANK)     # " "
      call outgo(lab)       # "goto lab"
      return
      end

WATCOM Fortran77版は以下の通り。

c ifgo.f -- generate "if (.not. (...)) goto lab"
      include ratfor.def
      subroutine ifgo(lab)
      integer lab
      integer*1 ifnot(11)
      data ifnot(1)/LETi/
      data ifnot(2)/LETf/
      data ifnot(3)/BLANK/
      data ifnot(4)/LPAREN/
      data ifnot(5)/PERIOD/
      data ifnot(6)/LETn/
      data ifnot(7)/LETo/
      data ifnot(8)/LETt/
      data ifnot(9)/PERIOD/
      data ifnot(10)/BLANK/
      data ifnot(11)/EOS/

      call outtab                       ! get to column 7
      call outstr(ifnot)                ! "if (.not. "
      call balpar                       ! collect and output condition
      call outch(RPAREN)                ! ")"
      call outch(BLANK)                 ! " "
      call outgo(lab)                   ! "goto lab"
      return
      end

elseの開始、ifまたはelse ifの終了は、

          goto L + 1
        L continue

elseif()のRatofor版は以下の通り。

# elseif.f -- generate code for end of if before else
      subroutine elseif(lab)
      integer lab

      call outgo(lab+1)
      call outcon(lab)
      return
      end

WATCOM Fortran77版は以下の通り。

c elseif.f -- generate code for end of if before else
      subroutine elseif(lab)
      integer lab

      call outgo(lab+1)
      call outcon(lab)
      return
      end

labgen()は、必要な数だけのラベルを生成します。ラベルは、50000からとします。

labgen()のRatofor版は以下の通り。

# labgen.r4 -- generates n consecutive labels, return first one
      integer function labgen(n)
      integer n
      integer label
      data label/50000/

      labgen = label
      label = label + n
      return
      end

WATCOM Fortran77版は以下の通り。

c labgen.f -- generates n consecutive labels, return first one
      integer function labgen(n)
      integer n
      integer label
      data label/50000/

      labgen = label
      label = label + n
      return
      end

balpar()は、条件を(複数行に渡っているのもまとめて)取り出し、出力します。 また、cnvop()で、演算子"<"、"<="、">"、">="、"=="、"!="、"&"、"|"を ".lt."、".le."、".gt."、".ge."、".eq."、".ne."、".and."、".or."に変換します。

balpar()のRatofor版は以下の通り。

# balpar.r4 -- copy balanced paren string
      include ratfor.def
      subroutine balpar
      character gtoken
      character t,token(MAXTOK)
      integer nlpar
      integer iindex
      string opcode "=> 0)
              call cnvop(token,opstr)   # convert logical operator
              call outstr(opstr)
          else
              call outstr(token)
          } until (nlpar <= 0)
      if (nlpar != 0)
          call synerr('missing parenthesis in condition.')
      return
      end

WATCOM Fortran77版は以下の通り。

c balpar.f -- copy balanced paren string
      include ratfor.def
      subroutine balpar
      integer*1 gtoken
      integer*1 opstr(MAXTOK),t,token(MAXTOK)
      integer nlpar

      if (gtoken(token,MAXTOK) .ne. LPAREN) then
          call synerr('missing left paren.')
          return
      end if
      call outstr(token)
      nlpar = 1
      loop
          t = gtoken(token,MAXTOK)
          if ((t .eq. SEMICOL) .or. (t .eq. LBRACE) .or.
     1        (t .eq. RBRACE) .or. (t .eq. EOF)) then
              call pbstr(token)
              exit
          end if
          if (t .eq. NEWLINE) then      ! delete newlines
              token(1) = EOS
          else if (t .eq. LPAREN) then
              nlpar = nlpar + 1
          else if (t .eq. RPAREN) then
              nlpar = nlpar - 1
          ! else nothing special
          end if
          if (islgop(token(1)) .eq. YES) then
              call cnvop(token,opstr)   ! convert logical operator
              call outstr(opstr)
          else
              call outstr(token)
          endif
      until (nlpar .le. 0)
      if (nlpar .ne. 0) then
          call synerr('missing parenthesis in condition.')
      end if
      return
      end

cnvop()のRatofor版は以下の通り。

# cnvop.r4 -- convert logical oprator to FORTRAN style string
      include ratfor.def
      subroutine cnvop(token,opstr)
      integer*1 token(MAXTOK),opstr(MAXTOK)
      integer*1 ntoken(MAXTOK),t
      integer*1 gtoken

      string opeq " .eq. "
      string opne " .en. "
      string opgt " .gt. "
      string opge " .ge. "
      string oplt " .lt. "
      string ople " .le. "
      string opnot " .not. "
      string opand " .and. "
      string opor " .or. "

      t = gtoken(ntoken,MAXTOK)
      if (t .eq. OPEQUAL) then
          if (token(1) .eq. OPEQUAL) then
              call scopy(opeq,1,opstr,1)
          else if (token(1) .eq. OPGTHAN) then
              call scopy(opge,1,opstr,1)
          else if (token(1) .eq. OPLTHAN) then
              call scopy(ople,1,opstr,1)
          else if (token(1) .eq. OPNOT) then
              call scopy(opne,1,opstr,1)
          end if
      else
          call pbstr(ntoken)
          if (token(1) .eq. OPGTHAN) then
              call scopy(opgt,1,opstr,1)
          else if (token(1) .eq. OPLTHAN) then
              call scopy(oplt,1,opstr,1)
          else if (token(1) .eq. OPNOT) then
              call scopy(opnot,1,opstr,1)
          else if (token(1) .eq. OPAND) then
              call scopy(opand,1,opstr,1)
          else if (token(1) .eq. OPOR) then
              call scopy(opor,1,opstr,1)
          end if
      end if
      return
      end

WATCOM Fortran77版は以下の通り。

c cnvop.f -- convert logical oprator to FORTRAN style string
      include ratfor.def
      subroutine cnvop(token,opstr)
      integer*1 token(MAXTOK),opstr(MAXTOK)
      integer*1 ntoken(MAXTOK),t
      integer*1 gtoken

      integer*1 opeq(7)
      data opeq(1)/BLANK/
      data opeq(2)/PERIOD/
      data opeq(3)/LETe/
      data opeq(4)/LETq/
      data opeq(5)/PERIOD/
      data opeq(6)/BLANK/
      data opeq(7)/EOS/
      integer*1 opne(7)
      data opne(1)/BLANK/
      data opne(2)/PERIOD/
      data opne(3)/LETn/
      data opne(4)/LETe/
      data opne(5)/PERIOD/
      data opne(6)/BLANK/
      data opne(7)/EOS/
      integer*1 opgt(7)
      data opgt(1)/BLANK/
      data opgt(2)/PERIOD/
      data opgt(3)/LETg/
      data opgt(4)/LETt/
      data opgt(5)/PERIOD/
      data opgt(6)/BLANK/
      data opgt(7)/EOS/
      integer*1 opge(7)
      data opge(1)/BLANK/
      data opge(2)/PERIOD/
      data opge(3)/LETg/
      data opge(4)/LETe/
      data opge(5)/PERIOD/
      data opge(6)/BLANK/
      data opge(7)/EOS/
      integer*1 oplt(7)
      data oplt(1)/BLANK/
      data oplt(2)/PERIOD/
      data oplt(3)/LETl/
      data oplt(4)/LETt/
      data oplt(5)/PERIOD/
      data oplt(6)/BLANK/
      data oplt(7)/EOS/
      integer*1 ople(7)
      data ople(1)/BLANK/
      data ople(2)/PERIOD/
      data ople(3)/LETl/
      data ople(4)/LETe/
      data ople(5)/PERIOD/
      data ople(6)/BLANK/
      data ople(7)/EOS/
      integer*1 opnot(8)
      data opnot(1)/BLANK/
      data opnot(2)/PERIOD/
      data opnot(3)/LETn/
      data opnot(4)/LETo/
      data opnot(5)/LETt/
      data opnot(6)/PERIOD/
      data opnot(7)/BLANK/
      data opnot(8)/EOS/
      integer*1 opand(8)
      data opand(1)/BLANK/
      data opand(2)/PERIOD/
      data opand(3)/LETa/
      data opand(4)/LETn/
      data opand(5)/LETd/
      data opand(6)/PERIOD/
      data opand(7)/BLANK/
      data opand(8)/EOS/
      integer*1 opor(7)
      data opor(1)/BLANK/
      data opor(2)/PERIOD/
      data opor(3)/LETo/
      data opor(4)/LETr/
      data opor(5)/PERIOD/
      data opor(6)/BLANK/
      data opor(7)/EOS/

      t = gtoken(ntoken,MAXTOK)
      if (t .eq. OPEQUAL) then
          if (token(1) .eq. OPEQUAL) then
              call scopy(opeq,1,opstr,1)
          else if (token(1) .eq. OPGTHAN) then
              call scopy(opge,1,opstr,1)
          else if (token(1) .eq. OPLTHAN) then
              call scopy(ople,1,opstr,1)
          else if (token(1) .eq. OPNOT) then
              call scopy(opne,1,opstr,1)
          end if
      else
          call pbstr(ntoken)
          if (token(1) .eq. OPGTHAN) then
              call scopy(opgt,1,opstr,1)
          else if (token(1) .eq. OPLTHAN) then
              call scopy(oplt,1,opstr,1)
          else if (token(1) .eq. OPNOT) then
              call scopy(opnot,1,opstr,1)
          else if (token(1) .eq. OPAND) then
              call scopy(opand,1,opstr,1)
          else if (token(1) .eq. OPOR) then
              call scopy(opor,1,opstr,1)
          end if
      end if
      return
      end

ここまでに出てきた、下層の下請けルーチン、outtab()、outstr()、outch()、outgo()は、 以下の通りです。

outtab()のRatofor版は以下の通り。

# outtab.r4 -^- get past column 6
      include ratfor.def
      subroutine outtab

      include coutln.ri

      while (outp .lt. 6) do
          call outch(BLANK)
      end while
      return
      end

WATCOM Fortran77版は以下の通り。

c outtab.f -^- get past column 6
      include ratfor.def
      subroutine outtab

      include coutln.fi

      while (outp .lt. 6) do
          call outch(BLANK)
      end while
      return
      end

outstr()のRatofor版は以下の通り。

# outstr.r4 -- output string
      include ratfor.def
      subroutine outstr(str)
      character str(ARB)
      integer i,j
      character c

      for (i = 1; str(i) != EOS; i = I + 1) {
          c = str(i)
          if (c != SQUOTE & c != DQUOTE)
              call outch(c)
          else {
              i = i + 1
              for (j = i;str(j) != c;j = j + 1) # find end
                  ;
              call outnum(j-i)
              call outch(LETH)
              for ( ; i < j; i = i + 1)
                  call outch(str(i))
              }
      return
      end

WATCOM Fortran77版は以下の通り。

c outstr.f -- output string
      include ratfor.def
      subroutine outstr(str)
      integer*1 str(ARB)
      integer i,j
      integer*1 c

      i = 1
      while (str(i) .ne. EOS) do
          c = str(i)
          if ((c .ne. SQUOTE) .and. (c .ne. DQUOTE)) then
              call outch(c)
          else
              i = i + 1
              j = i                     ! find end
              while (str(j) .ne. c) do
                  j = j + 1
              end while
              call outnum(j-i)
              call outch(LETH)
              while (i .lt. j) do
                  call outch(str(i))
                  i = i + 1
              end while
          end if 
          i = i + 1
      end while
      return
      end

outch()のRatofor版は以下の通り。

# outch.r4 -- put one character into output buffer
      include ratfor.def
      subroutine outch(c)
      character c
      integer i

      include coutln.ri

      if (outp >= 72 ) # continution card
          call outdon
          for (i = 1;  i < 6; i = i + 1)
              outbuf(i) = BLANK
          outbuf(6) = STAR
          outp = 6
      outp = outp + 1
      outbuf(outp) = c
      return
      end

WATCOM Fortran77版は以下の通り。

c outch.f -- put one character into output buffer
      include ratfor.def
      subroutine outch(c)
      integer*1 c
      integer i

      include coutln.fi

      if (outp .ge. 72 ) then  ! continution card
          call outdon
          i = 1
          while (i .lt. 6) do
              outbuf(i) = BLANK
              i = i + 1
          end while
          outbuf(6) = STAR
          outp = 6
      end if
      outp = outp + 1
      outbuf(outp) = c
      return
      end

outgo()のRatofor版は以下の通り。

# outgo.r4 -- output "goto n"
      include ratfor.def
      subroutine outgo(n)
      integer n

      string(goto,"goto")

      call outtab
      call outstr(goto)
      call outch(BLANK)
      call outnum(n)
      call outdon
      return
      end

WATCOM Fortran77版は以下の通り。

c outgo.f -- output "goto n"
      include ratfor.def
      subroutine outgo(n)
      integer n

      string(goto,"goto")

      call outtab
      call outstr(goto)
      call outch(BLANK)
      call outnum(n)
      call outdon
      return
      end