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

stringは、文字列定数を格納するinteger*1型の配列を生成する部分と、 配列に文字を割り当てるdata文を生成する部分があるます。配列の大きさは、 格納する文字列の長さとEOSを格納する分が必要です。

          string name "data"

は、

          integer*1 name(5)
          data name(1)/100/
          data name(2)/97/
          data name(3)/116/
          data name(4)/97/
          data name(5)/-2/
          

となります。また、文字列には、空白を含め特殊文字が含まれていてもよく、

          string specs "!#$%&'( )=-"

は、

      integer*1 specs(12)
      data specs(1)/33/
      data specs(2)/35/
      data specs(3)/36/
      data specs(4)/37/
      data specs(5)/38/
      data specs(6)/39/
      data specs(7)/40/
      data specs(8)/32/
      data specs(9)/41/
      data specs(10)/61/
      data specs(11)/45/
      data specs(12)/-2/

のように、コードが生成されます。さらには、文字列をくくるのは"でも'でもよく、

          string str1 'ab"cd'

"を含んだ文字左列は下記のように

      integer*1 str1(6)
      data str1(1)/97/
      data str1(2)/98/
      data str1(3)/34/
      data str1(4)/99/
      data str1(5)/100/
      data str1(6)/-2/

となります。

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

# strngc.r4 -- generate string data
      include ratfor.def
      subroutine strngc
      character ngetc,name(MAXTOK),strng(MAXLINE)
      integer c,i,l,length,n
      string intstr "integer*1 "
      string datstr "data "

      junk = lex(name)
      for (strng(1) = ngetc(strng(1)); strng(1) == BLANK); strng(1) = ngetc(strng(1))
          ;
      if (strng(1) != DQUOTE & strng(1) != SQUOTE)
          call synerr('missing quort.')
      i = 2
      for (strng(i) = ngetc(strng(i)); strng(1) != strng(i)); strng(i) = ngetc(strng(i)) {
           if (i >= MAXLINE) {
               call synerr('string data too long.')
               break
               }
           else if (strng(i) == NEWLINE) {
               call synerr('Unexpected NEWLINE.')
               break
               }
           else if (strng(i) == EOF) {
               call synerr('Unexpected EOF.')
               exit
               }
           i = i + 1
           }
      if (i >= MAXLINE)
          strng(MAXLINE) = EOS
      else
          strng(i+1) = EOS
      l = length(strng)
      call outtab
      call outstr(intstr)
      call outstr(name)
      call outch(LPAREN)
      call outnum(l-1)
      call outch(RPAREN)
      call outdon
      i = 1
      for (c = 2; c < l; c = c + 1) {
          call outtab
          call outstr(datstr)
          call outstr(name)
          call outch(LPAREN)
          call outnum(i)
          call outch(RPAREN)
          call outch(SLASH)
          n = strng(c)
          call outnum(n)
          call outch(SLASH)
          call outdon
          i = i + 1
          }
      call outtab
      call outstr(datstr)
      call outstr(name)
      call outch(LPAREN)
      call outnum(i)
      call outch(RPAREN)
      call outch(SLASH)
      call outnum(EOS)
      call outch(SLASH)
      call outdon
      return
      end

WATCOM Fortran77版は以下の通り。

c strngc.f -- generate string data
      include ratfor.def
      subroutine strngc
      integer*1 ngetc,name(MAXTOK),strng(MAXLINE)
      integer c,i,l,length,n
      integer*1 intstr(11)
      data intstr(1)/LETi/
      data intstr(2)/LETn/
      data intstr(3)/LETt/
      data intstr(4)/LETe/
      data intstr(5)/LETg/
      data intstr(6)/LETe/
      data intstr(7)/LETr/
      data intstr(8)/STAR/
      data intstr(9)/LET1/
      data intstr(10)/BLANK/
      data intstr(11)/EOS/
      integer*1 datstr(6)
      data datstr(1)/LETd/
      data datstr(2)/LETa/
      data datstr(3)/LETt/
      data datstr(4)/LETa/
      data datstr(5)/BLANK/
      data datstr(6)/EOS/

      junk = lex(name)
      strng(1) = ngetc(strng(1))
      while (strng(1) .eq. BLANK) do
          strng(1) = ngetc(strng(1))
      end while
      if (strng(1) .ne. DQUOTE .and. strng(1) .ne. SQUOTE) then
          call synerr('missing quort.')
      end if
      i = 2
      strng(i) = ngetc(strng(i))
      while (strng(1) .ne. strng(i)) do
           if (i .ge. MAXLINE) then
               call synerr('string data too long.')
               exit
           else if (strng(i) .eq. NEWLINE) then
               call synerr('Unexpected NEWLINE.')
               exit
           else if (strng(i) .eq. EOF) then
               call synerr('Unexpected EOF.')
               exit
           end if
           i = i + 1
           strng(i) = ngetc(strng(i))
      end while
      if (i .ge. MAXLINE) then
          strng(MAXLINE) = EOS
      else
          strng(i+1) = EOS
      end if
      l = length(strng)
      call outtab
      call outstr(intstr)
      call outstr(name)
      call outch(LPAREN)
      call outnum(l-1)
      call outch(RPAREN)
      call outdon
      i = 1
      c = 2
      while (c .lt. l) do
          call outtab
          call outstr(datstr)
          call outstr(name)
          call outch(LPAREN)
          call outnum(i)
          call outch(RPAREN)
          call outch(SLASH)
          n = strng(c)
          call outnum(n)
          call outch(SLASH)
          call outdon
          i = i + 1
          c = c + 1
      end while
      call outtab
      call outstr(datstr)
      call outstr(name)
      call outch(LPAREN)
      call outnum(i)
      call outch(RPAREN)
      call outch(SLASH)
      call outnum(EOS)
      call outch(SLASH)
      call outdon
      return
      end

これで、Ratforプリプロセッサの作成は完了しました。Ratforも含めた、展開処理用の バッチプログラムを以下に示します。

          @echo off
          rem fimr.bat
          cd ..\src
          ..\exe\include < %1.f | ..\exe\macro | ..\exe\ratfor > %1.for
          cd ..\bat

ソフトウェア作法に記載されている、RatforコードをWATCOM-fortran77に ポーティングする作業は、ひとまず終わりとします。ただし、実際にポーティングの課程 で作成したコードは、そのままの状態で、完成したRatforに通すことは、 できません。ratfor.defファイルのインクルードが必要なこととなど、 まだまだ、手を加える部分があります。これについては、次回から、必要な部分を取り出して、 説明します。