アナクロなコンピューターエンジニアのつぶやき

Ratforで書かれたプログラム文は、parse()で解析され、lex()が返す綴り別に それがコードの始まりの時は、コード生成ルーチンを呼び出し、スタックに綴りの種類と 名札が積まれる。コードの終わりの時は、unstak()が呼ばれスタックから取りおろしをします。 綴りは、defineやmacroのように、initkw()でテーブルにセットします。

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

# parse.r4 -- parse Ratfor source program
      include ratfor.def
      subroutine parse
      character lexstr(MAXTOK)
      character lex, token
      integer lab,sp
      integer labval(MAXSTACK)
      character lextyp(MAXSTACK)

      call initkw                       # install keywords in table
      sp = 1
      lextyp(1) = EOF
      for (token = lex(lexstr); token != EOF; token = lex(lexstr) ) {
          if (token == LEXIF)
              call ifcode(lab)
          else if (token == LEXDO)
              call docode(lab)
          else if (token == LEXWHILE)
              call whilec(lab)
          else if (token == LEXFOR)
              call forcod(lab)
          else if (token == LEXREPEAT)
              call repcod(lab)
          else if (token == LEXUNTIL) {
              if (lextyp(sp) == LEXREPEAT)
                  call synerr('illegal until.')
              }
          else if (token == LEXSTRING)
              call strngc
          else if (token == LEXDIGITS)
              call labelc(lexstr)
          else if (token == LEXELSE) {
              if (lextyp(sp) == LEXIF)
                  call elseif(labval(sp))
              else
                  call synerr('illegal else.')
              }
          if (token == LEXIF | token == LEXELSE
              | token == LEXWHILE | token == LEXDO
              | token == LEXDIGITS | token == LBRACE
              | token == LEXFOR | token == LEXREPEAT) {
              sp = sp + 1
              if (sp > MAXSTACK)
                  call synerr('stack overflow in paser.')
              lextyp(sp) = token
              labval(sp) = lab
              }
          else }
              if (token == RBRACE)
                  if (lextyp(sp) == LBRACE)
                      sp = sp - 1
                  else
                      call synerr('illegal right brace.')
              else if (token == LEXOTHER)
                  call otherc(lexstr)
              else if (token == LEXBREAK | token == LEXNEXT)
                  call brknxt(sp,lextyp,labval,token)
              token = lex(lexstr)       # peek at next token
              call pbstr(lexstr)
              call unstak(sp,lextyp,labval,token)
              }
          }
      if (sp != 1)
          call synerr('unexpected EOF.')
      return
      end

WATCOM Fortran77版は以下の通り。

c parse.f -- parse Ratfor source program
      include ratfor.def
      subroutine parse
      integer*1 lexstr(MAXTOK)
      integer*1 lex,lextyp(MAXSTACK),token
      integer lab,labval(MAXSTACK),sp

      call initkw                       ! install keywords in table
      sp = 1
      lextyp(1) = EOF
      token = lex(lexstr)
      while (token .ne. EOF) do
          if (token .eq. LEXIF) then
              call ifcode(lab)
          else if (token .eq. LEXDO) then
              call docode(lab)
          else if (token .eq. LEXWHILE) then
              call whilec(lab)
          else if (token .eq. LEXFOR) then
              call forcod(lab)
          else if (token .eq. LEXREPEAT) then
              call repcod(lab)
          else if (token .eq. LEXUNTIL) then
              if (lextyp(sp) .ne. LEXREPEAT) then
                  call synerr('illegal until.')
              end if
          else if (token .eq. LEXSTRING) then
              call strngc
          else if (token .eq. LEXDIGITS) then
              call labelc(lexstr)
          else if (token .eq. LEXELSE) then
              if (lextyp(sp) .eq. LEXIF) then
                  call elseif(labval(sp))
              else
                  call synerr('illegal else.')
              end if
          end if
          if ((token .eq. LEXIF) .or. (token .eq. LEXELSE) .or.
     1        (token .eq. LEXWHILE) .or. (token .eq. LEXDO) .or.
     2        (token .eq. LEXDIGITS) .or. (token .eq. LBRACE) .or.
     3        (token .eq. LEXFOR) .or. (token .eq. LEXREPEAT)) then
              sp = sp + 1
              if (sp .gt. MAXSTACK) then
                  call synerr('stack overflow in paser.')
              end if
              lextyp(sp) = token
              labval(sp) = lab
          else
              if (token .eq. RBRACE) then
                  if (lextyp(sp) .eq. LBRACE) then
                      sp = sp - 1
                  else
                      call synerr('illegal right brace.')
                  end if
              else if (token .eq. LEXOTHER) then
                  call otherc(lexstr)
              else if (token .eq. LEXBREAK .or. token .eq. LEXNEXT) then
                  call brknxt(sp,lextyp,labval,token)
              end if
              token = lex(lexstr)       ! peek at next token
              call pbstr(lexstr)
              call unstak(sp,lextyp,labval,token)
          end if
          token = lex(lexstr)
      end while
      if (sp .ne. 1) then
          call synerr('unexpected EOF.')
      end if

      return
      end

initkw()は、見出し語をinstal()を使って登録します。

Ratofor版は以下の通り。

# initkw.f -- install Ratfor keyword
      include ratfor.def
      subroutine initkw
      string(ifst,"if")
      character iftyp(2)
      data iftyp(1)/LEXIF/
      data iftyp(2)/EOS/
      string(elsest,"else")
      character elstyp(2)
      data elstyp(1)/LEXELSE/
      data elstyp(2)/EOS/
      string(whilst,"while")
      character whityp(2)
      data whityp(1)/LEXWHILE/
      data whityp(2)/EOS/
      string(forst,"for")
      character fortyp(2)
      data fortyp(1)/LEXFOR/
      data fortyp(2)/EOS/
      string(repest,"repeat")
      character reptyp(2)
      data reptyp(1)/LEXREPEAT/
      data reptyp(2)/EOS/
      string(untist,"until")
      character unttyp(2)
      data unttyp(1)/LEXUNTIL/
      data unttyp(2)/EOS/
      string(dost,"do")
      character dotyp(2)
      data dotyp(1)/LEXDO/
      data dotyp(2)/EOS/
      string(breast,"break")
      character bretyp(2)
      data bretyp(1)/LEXBREAK/
      data bretyp(2)/EOS/
      string(nextst,"next")
      character nextyp(2)
      data nextyp(1)/LEXNEXT/
      data nextyp(2)/EOS/
      integer*1 strtyp(2)
      data strtyp(1)/LEXSTRING/
      data strtyp(2)/EOS/

      call instal(ifst,iftyp)
      call instal(elsest,elstyp)
      call instal(whilst,whityp)
      call instal(forst,fortyp)
      call instal(repest,reptyp)
      call instal(untist,unttyp)
      call instal(dost,dotyp)
      call instal(breast,bretyp)
      call instal(nextst,nextyp)
      call instal(strst,strtyp)
      return
      end

WATCOM Fortran77版は以下の通り。

c initkw.f -- install Ratfor keyword
      include ratfor.def
      subroutine initkw
      string(ifst,"if")
      integer*1 iftyp(2)
      data iftyp(1)/LEXIF/
      data iftyp(2)/EOS/
      string(elsest,"else")
      integer*1 elstyp(2)
      data elstyp(1)/LEXELSE/
      data elstyp(2)/EOS/
      string(whilst,"while")
      integer*1 whityp(2)
      data whityp(1)/LEXWHILE/
      data whityp(2)/EOS/
      string(forst,"for")
      integer*1 fortyp(2)
      data fortyp(1)/LEXFOR/
      data fortyp(2)/EOS/
      string(repest,"repeat")
      integer*1 reptyp(2)
      data reptyp(1)/LEXREPEAT/
      data reptyp(2)/EOS/
      string(untist,"until")
      integer*1 unttyp(2)
      data unttyp(1)/LEXUNTIL/
      data unttyp(2)/EOS/
      string(dost,"do")
      integer*1 dotyp(2)
      data dotyp(1)/LEXDO/
      data dotyp(2)/EOS/
      string(breast,"break")
      integer*1 bretyp(2)
      data bretyp(1)/LEXBREAK/
      data bretyp(2)/EOS/
      string(nextst,"next")
      integer*1 nextyp(2)
      data nextyp(1)/LEXNEXT/
      data nextyp(2)/EOS/
      integer*1 strst(7)
      data strst(1)/LETs/
      data strst(2)/LETt/
      data strst(3)/LETr/
      data strst(4)/LETi/
      data strst(5)/LETn/
      data strst(6)/LETg/
      data strst(7)/EOS/
      integer*1 strtyp(2)
      data strtyp(1)/LEXSTRING/
      data strtyp(2)/EOS/

      call instal(ifst,iftyp)
      call instal(elsest,elstyp)
      call instal(whilst,whityp)
      call instal(forst,fortyp)
      call instal(repest,reptyp)
      call instal(untist,unttyp)
      call instal(dost,dotyp)
      call instal(breast,bretyp)
      call instal(nextst,nextyp)
      call instal(strst,strtyp)
      return
      end

unstak()は、スタックに最後に積まれた綴りに応じた構文の終わりのコードを生成し、 スタックから取り下ろします。

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

# unstack.f -- unstack at end of statment
      include ratfor.def
      subroutine unstak(sp,lextyp,labval,token)
      integer sp
      integer labval(MAXSTACK)
      character token
      character lextyp(MAXSTACK)

      for ( ; sp > 1; sp = sp -1) {
          if (lextyp(sp) == LBRACE)
              break
          if ((lextyp(sp) == LEXIF) & (token == LEXELSE))
              break
          if (lextyp(sp) == LEXIF)
              call outcon(labval(sp))
          else if (lextyp(sp) == LEXELSE) {
              if (sp > 2)
                  sp = sp - 1
              call outcon(labval(sp)+1)
              }
          else if (lextyp(sp) == LEXDO)
              call dostat(labval(sp))
          else if (lextyp(sp) == LEXFOR)
              call forsta(labval(sp))
          else if (lextyp(sp) == LEXREPEAT)
              call repats(labval(sp))
          else if (lextyp(sp) == LEXWHILE)
              call whiles(labval(sp))
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c unstack.f -- unstack at end of statment
      include ratfor.def
      subroutine unstak(sp,lextyp,labval,token)
      integer labval(MAXSTACK),sp
      integer*1 lextyp(MAXSTACK),token

      while (sp .gt. 1) do
          if (lextyp(sp) .eq. LBRACE) then
              exit
          end if
          if ((lextyp(sp) .eq. LEXIF) .and. (token .eq. LEXELSE)) then
              exit
          end if
          if (lextyp(sp) .eq. LEXIF) then
              call outcon(labval(sp))
          else if (lextyp(sp) .eq. LEXELSE) then
              if (sp .gt. 2) then
                  sp = sp - 1
              end if
              call outcon(labval(sp)+1)
          else if (lextyp(sp) .eq. LEXDO) then
              call dostat(labval(sp))
          else if (lextyp(sp) .eq. LEXFOR) then
              call forsta(labval(sp))
          else if (lextyp(sp) .eq. LEXREPEAT) then
              call repats(labval(sp))
          else if (lextyp(sp) .eq. LEXWHILE) then
              call whiles(labval(sp))
          end if
          sp = sp - 1
      end while
      return
      end

Ratforのメインプリグラムはとても簡単です。

Ratofor版は以下の通り。

# ratfor.r4 -- main program for Ratfor
      program ratfor
      call initfile
      call parse
      stop
      end

WATCOM Fortran77版は以下の通り。

c ratfor.f -- main program for Ratfor
      program ratfor
      call initfile
      call parse
      stop
      end