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

Ratforプリプロセッサー -- コード生成 "for" ― 2017年07月01日 17:11

for文にであったら、初期設定・終了条件・再設定を取り出して、再設定は再設定用スタックに積み、ラベルL、L+1、L+2を作りだし、

          continue
          初期設定
        L if ( .not. (終了条件)) goto L+2

を出力します。そして、forの終わりに達したら、

      L+1 continue
          再設定
          goto L
      L+2 continue

を出力します。ここで、ラベルL+2は、breakに出会ったときの行き先になります。また、ラベルL+1は、 nextに出会った時の行き先になります。具体的には、forcod()でfor文のはじめを生成します。

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

# forcod.r4 -- generate code for beginning of for
      include ratfor.def
      subroutine forcod(lab)
      integer lab
      character t,token(MAXTOK)

      lab = labgen(3)
      call outcon(0)
      t = gtoken(token,MAXTOK)
      if (token(1) != LPAREN) {
          call outstr(token)
          call eatup
          call synerr('missing left parenthesis.')
          }
      else {
          call forini
          call forcnd(lab)
          call forrei
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c forcod.f -- generate code for beginning of for
      include ratfor.def
      subroutine forcod(lab)
      integer lab
      integer*1 t,token(MAXTOK)

      lab = labgen(3)
      call outcon(0)
      t = gtoken(token,MAXTOK)
      if (token(1) .ne. LPAREN) then
          call outstr(token)
          call eatup
          call synerr('missing left parenthesis.')
      else
          call forini
          call forcnd(lab)
          call forrei
      end if
      return
      end

ここで、forini()は初期設定を取り出しコードを生成し、同様にforcnd()は終了条件を取り出し必要なコードを生成し、さらに、 forrei()は再設定を取り出しコードを生成します。

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

# forini.r4 -- generate code for initialize
      include ratfor.def
      subroutine forini
      character gtoken,stmnt(MAXLINE),t,token(MAXTOK)
      integer junk,sappnd

      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);t != SEMICOL & t != EOF;t = gtoken(token,MAXTOK))
          junk = sappnd(token,stmnt,MAXTOK)
      if (stmnt(1) != EOS) {
          call outtab
          call outstr(stmnt)
          call outdon
          }
      if (t != EOF)
          call synerr('unexpected EOF.')
      return
      end

WATCOM Fortran77版は以下の通り。

c forini.f -- generate code for beginning of for
      include ratfor.def
      subroutine forini
      integer*1 gtoken,stmnt(MAXLINE),t,token(MAXTOK)
      integer junk,sappnd

      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while ((t .ne. SEMICOL) .and. (t .ne. EOF)) do
          junk = sappnd(token,stmnt,MAXTOK)
          t = gtoken(token,MAXTOK)
      end while
      if (stmnt(1) .ne. EOS) then
          call outtab
          call outstr(stmnt)
          call outdon
      end if
      if (t .eq. EOF) then
          call synerr('unexpected EOF.')
      end if
      return
      end

ここで、sappnd()は、文字バッファーがあふれないように確認しながら、文字列を追加します。

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

# sappnd.r4 -- append str to body
      include ratfor.def
      integer function sappnd(str,body,maxsiz)
      character str(ARB),body(maxsiz)
      integer maxsiz
      integer i,j,length

      i = 1
      j = length(body) + 1
      sappnd = YES
      while (str(i) != EOS) {
          if (j >= maxsiz) then
              sappnd = NO
              exit
          end if
          body(j) = str(i)
          i = i + 1
          j = j + 1
          }
      body(j) = EOS
      return
      end

WATCOM Fortran77版は以下の通り。

c sappnd.f -- append str to body
      include ratfor.def
      integer function sappnd(str,body,maxsiz)
      integer*1 str(ARB),body(maxsiz)
      integer maxsiz
      integer i,j,length

      i = 1
      j = length(body) + 1
      sappnd = YES
      while (str(i) .ne. EOS) do
          if (j .ge. maxsiz) then
              sappnd = NO
              exit
          end if
          body(j) = str(i)
          i = i + 1
          j = j + 1
      end while
      body(j) = EOS
      return
      end

outdon()は、生成しているコードを実際に出力先に書き出します。

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

# outdon.r4 -- finish off an output line
      include ratfor.def
      subroutine outdon

      include coutln.ri

      outbuf(outp+1) = NEWLINE
      outbuf(outp+2) = EOS
      call putlin(outbuf,STDOUT)
      outp = 0
      return
      end

WATCOM Fortran77版は以下の通り。

c outdon.f -- finish off an output line
      include ratfor.def
      subroutine outdon

      include coutln.fi

      outbuf(outp+1) = NEWLINE
      outbuf(outp+2) = EOS
      call putlin(outbuf,STDOUT)
      outp = 0
      return
      end

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

# forcnd.r4 -- get condition statementr of for
      include ratfor.def
      subroutine forcnd(lab)
      integer lab
      character gtoken,opstr(MAXTOK),stmnt(MAXTOK),t,token(MAXTOK)

      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);t != EOF & t != SEMICOL;t = gtoken(token,MAXTOK))
          if (islgop(token(1)) != YES) {
              call cnvop(token,opstr)
              junk = sappnd(opstr,stmnt,MAXTOK)
              }
          else
              junk = sappnd(token,stmnt,MAXTOK)
      if (stmnt(1) == EOS)
          call outcon(lab)
      else {
          call outnum(lab)
          call outtab
          call ifnot(stmnt,lab + 1)
          }
      if (t == EOF)
          call synerr('unexpected EOF.')
      return
      end

WATCOM Fortran77版は以下の通り。

c forcnd.f -- get condition statementr of for
      include ratfor.def
      subroutine forcnd(lab)
      integer lab
      integer*1 gtoken,opstr(MAXTOK),stmnt(MAXTOK),t,token(MAXTOK)

      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while ((t .ne. EOF) .and. (t .ne. SEMICOL)) do
          if (islgop(token(1)) .eq. YES) then
              call cnvop(token,opstr)
              junk = sappnd(opstr,stmnt,MAXTOK)
          else
              junk = sappnd(token,stmnt,MAXTOK)
          end if
          t = gtoken(token,MAXTOK)
      end while
      if (stmnt(1) .eq. EOS) then
          call outcon(lab)
      else
          call outnum(lab)
          call outtab
          call ifnot(stmnt,lab + 1)
      end if
      if (t .eq. EOF) then
          call synerr('unexpected EOF.')
      end if
      return
      end

ここで、islgop()は、tokenが論理演算子かどうかを判断します。

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

# islgop.r4 -- if c is operatr then return YES
      include ratfor.def
      integer function islgop(c)
      integer*1 c
      integer iindex
      integer*1 opcode(7)
      data opcode(1)/OPEQUAL/
      data opcode(2)/OPGTHAN/
      data opcode(3)/OPLTHAN/
      data opcode(4)/OPNOT/
      data opcode(5)/OPAND/
      data opcode(6)/OPOR/
      data opcode(7)/EOS/

      islgop = NO
      if (iindex(opcode,c) > 0)
          islgop = YES
      return
      end

WATCOM Fortran77版は以下の通り。

c islgop.f -- if c is operatr then return YES
      include ratfor.def
      integer function islgop(c)
      integer*1 c
      integer iindex
      integer*1 opcode(7)
      data opcode(1)/OPEQUAL/
      data opcode(2)/OPGTHAN/
      data opcode(3)/OPLTHAN/
      data opcode(4)/OPNOT/
      data opcode(5)/OPAND/
      data opcode(6)/OPOR/
      data opcode(7)/EOS/

      islgop = NO
      if (iindex(opcode,c) .gt. 0) then
          islgop = YES
      end if
      return
      end

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

# forrei.r4 -- save reinitialize statement of for
      include ratfor.def
      subroutine forrei
      character sappnd,stmnt(MAXTOK),t,token(MAXTOK)
      integer junk,nlpar

      nlpar = 0
      stmnt(1) = EOS
      for (t = gtoken(token,MAXTOK);token(1) != EOF;t = gtoken(token,MAXTOK)) {
          if (nlpar == 0 & token(1) == RPAREN)
              exit
          junk = sappnd(token,stmnt,MAXTOK)
          if (token(1) == LPAREN)
              nlpar = nlpar + 1
          else if (token(1) == RPAREN)
              nlpar = nlpar - 1
          }
      call cspush(stmnt)
      return
      end

WATCOM Fortran77版は以下の通り。

c forrei.f -- save reinitialize statement of for
      include ratfor.def
      subroutine forrei
      integer*1 sappnd,stmnt(MAXTOK),t,token(MAXTOK)
      integer junk,nlpar

      nlpar = 0
      stmnt(1) = EOS
      t = gtoken(token,MAXTOK)
      while (token(1) .ne. EOF) do
          if (nlpar .eq. 0 .and. token(1) .eq. RPAREN) then
              exit
          end if
          junk = sappnd(token,stmnt,MAXTOK)
          if (token(1) .eq. LPAREN) then
              nlpar = nlpar + 1
          else if (token(1) .eq. RPAREN) then
              nlpar = nlpar - 1
          end if
          t = gtoken(token,MAXTOK)
      end while
      call cspush(stmnt)
      return
      end

cspush()は、再設定用スタックに、再設定を積みます。

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

# cspush.r4 -- push statment into code stack
      include ratfor.def
      subroutine cspush(stmnt)
      character stmnt(MAXTOK)
      integer length
      include cstack.ri
      
      cscnt = cscnt + 1
      if (cscnt > MAXTOK) then
          call error('Code stack overflow.')
      end if
      cslast = cslast + 1
      csstat(cscnt) = cslast
      call scopy(stmnt,1,csstck,cslast)
      cslast = cslast + length(stmnt) + 1
      return
      end

WATCOM Fortran77版は以下の通り。

c cspush.f -- push statment into code stack
      include ratfor.def
      subroutine cspush(stmnt)
      integer*1 stmnt(MAXTOK)
      integer length
      include cstack.fi
      
      cscnt = cscnt + 1
      if (cscnt .gt. MAXTOK) then
          call error('Code stack overflow.')
      end if
      cslast = cslast + 1
      csstat(cscnt) = cslast
      call scopy(stmnt,1,csstck,cslast)
      cslast = cslast + length(stmnt) + 1
      return
      end

再設定用スタックは、実際には、配列で表現されています。

cstackのRatofor版は以下の通り。

# cstack.ri -- code stack
      common /cstack/csstat,cscnt,cslast,csstck
      integer csstat(MAXTOK)            ! code pointer
      integer cscnt                     ! number of statments in stack; init = 0
      integer cslast                    ! last cstack filled; init = 0
      character csstck(MAXSTACK)        ! code stack
      data cscnt/0/
      data cslast/0/

WATCOM Fortran77版は以下の通り。

c cstack.fi -- code stack
      common /cstack/csstat,cscnt,cslast,csstck
      integer csstat(MAXTOK)            ! code pointer
      integer cscnt                     ! number of statments in stack; init = 0
      integer cslast                    ! last cstack filled; init = 0
      integer*1 csstck(MAXSTACK)        ! code stack
      data cscnt/0/
      data cslast/0/

forの終わりは、cspop()で再設定をスタックから取り出し、forsta()でコードを生成します。

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

# forsta.r4 -- generate code for end of for
      include ratfor.def
      subroutine forsta(lab)
      integer lab
      character stmnt(MAXTOK)

      call cspop(stmnt)
      if (stmnt(1) == EOS) {
          call outcon(lab + 2)
          call outtab
          call outgo(lab)
          call outcon(lab + 1)
          }
      else {
          call outcon(lab + 2)
          call outtab
          call outstr(stmnt)
          call outdon
          call outgo(lab)
          call outcon(lab + 1)
          }
      return
      end

WATCOM Fortran77版は以下の通り。

c forsta.f -- generate code for end of for
      include ratfor.def
      subroutine forsta(lab)
      integer lab
      integer*1 stmnt(MAXTOK)

      call cspop(stmnt)
      if (stmnt(1) .eq. EOS) then
          call outcon(lab + 2)
          call outtab
          call outgo(lab)
          call outcon(lab + 1)
      else
          call outcon(lab + 2)
          call outtab
          call outstr(stmnt)
          call outdon
          call outgo(lab)
          call outcon(lab + 1)
      end if
      return
      end

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

# cspop.r4 -- pop statment into code stack
      include ratfor.def
      subroutine cspop(stmnt)
      character stmnt(MAXTOK)
      integer length
      integer p
      include cstack.fi
      
      if (cscnt <= 0)
          call error('Code stack underflow.')
      p = csstat(cscnt)
      call scopy(csstck(p),1,stmnt,1)
      cscnt = cscnt - 1
      cslast = cslast - length(stmnt) - 1
      return
      end

WATCOM Fortran77版は以下の通り。

c cspop.f -- pop statment into code stack
      include ratfor.def
      subroutine cspop(stmnt)
      integer*1 stmnt(MAXTOK)
      integer length
      integer p
      include cstack.fi
      
      if (cscnt .le. 0) then
          call error('Code stack underflow.')
      end if
      p = csstat(cscnt)
      call scopy(csstck(p),1,stmnt,1)
      cscnt = cscnt - 1
      cslast = cslast - length(stmnt) - 1
      return
      end

_ judybush.hatenablog.com ― 2017年07月30日 17:40

Piece of writing writing is also a fun, if you be familiar with then you can write if not it is difficult to
write.

コメントをどうぞ

※メールアドレスとURLの入力は必須ではありません。入力されたメールアドレスは記事に反映されず、ブログの管理者のみが参照できます。

トラックバック

このエントリのトラックバックURL: http://kida.asablo.jp/blog/2017/07/01/8607869/tb

<<前次>>

<< 2017/07 >>
日	月	火	水	木	金	土
						01
02	03	04	05	06	07	08
09	10	11	12	13	14	15
16	17	18	19	20	21	22
23	24	25	26	27	28	29
30	31

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

最近の記事

このブログについて

カテゴリ一覧

最近のコメント

最近のトラックバック

バックナンバー

RSS

Ratforプリプロセッサー -- コード生成 "for" ― 2017年07月01日 17:11

コメント

_ judybush.hatenablog.com ― 2017年07月30日 17:40

トラックバック

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

最近の記事

このブログについて

カテゴリ一覧

最近のコメント

最近のトラックバック

バックナンバー

RSS

ログイン

Ratforプリプロセッサー -- コード生成 "for" ― 2017年07月01日 17:11

コメント

_ judybush.hatenablog.com ― 2017年07月30日 17:40

トラックバック