Ratforプリプロセッサー -- コード生成 "if"と"if-else" ― 2017年06月07日 15:41
"if"文に出会ったら、2つのラベル、LとL+1を生成し、
if(.not(条件)) goto Lを出力します。それは、ifcode()で行ない、ラベルを返します。
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を作り出します。ここでLはスタックに積んであったラベルです。
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
Ratforプリプロセッサー -- コード生成 "do" ― 2017年06月20日 18:06
Ratforのdo文にであったら、doの限界指定部を取り出して、ラベルL、L+1を 作りだし、
do L 限界指定部を出力します。そして、doの終わりに達したら、
L continue L+1 continueを出力します。ここで、ラベルL+1は、breakに出会ったときの行き先になります。また、ラベルLは、 do分のループの終わりを示すとともに、nextに出会った時の行き先になります。 具体的には、docode()でdo文のはじめを生成します。
docode()のRatofor版は以下の通り。
# docode.r4 -- generate code for beginning of do include ratfor.def subroutine docode(lab) integer lab integer labgen string(dostr,"do") call outtab call outstr(dostr) call outch(BLANK) lab = labgen(2) call outnum(lab) call outch(BLANK) call eatup call outdon return end
WATCOM Fortran77版は以下の通り。
c docode.f -- generate code for beginning of do include ratfor.def subroutine docode(lab) integer lab integer labgen string(dostr,"do") call outtab call outstr(dostr) call outch(BLANK) lab = labgen(2) call outnum(lab) call outch(BLANK) call eatup call outdon return end
eatup()は、まだ取り込んでいない部分を継続行を含めて処理します。
eatup()のRatofor版は以下の通り。
# eatup.r4 -- process rest of statement; interpret continuations include ratfor.def subroutine eatup character gtoken character ptoken(MAXTOK),t,token(MAXTOK) integer nlpar nlpar = 0 repeat ` t = gtoken(token,MAXTOK) if (t == SEMICOL | t == NEWLINE) break if (t == LBRACE) { call pbstr(token) break } if (t == RBRACE | t == EOF) { call synerr('unexpected brace or EOF.') call pbstr(token) break } if (t == COMMA) { if (gtoken(ptoken,MAXTOK) != NEWLINE) call pbstr(ptoken) } else if (t == LPAREN) nlpar = nlpar + 1 else if (t == RPAREN) nlpar = nlpar - 1 call outstr(token) } until (nlpar < 0) if (nlpar != 0) call synerr('unbalanced parentheses.') return end
WATCOM Fortran77版は以下の通り。
c eatup.f -- process rest of statement; interpret continuations include ratfor.def subroutine eatup integer*1 gtoken integer*1 ptoken(MAXTOK),t,token(MAXTOK) integer nlpar nlpar = 0 loop t = gtoken(token,MAXTOK) if ((t .eq. SEMICOL) .or. (t .eq. NEWLINE)) then exit end if if (t .eq. LBRACE) then call pbstr(token) exit end if if ((t .eq. RBRACE) .or. (t .eq. EOF)) then call synerr('unexpected brace or EOF.') call pbstr(token) exit end if if (t .eq. COMMA) then if (gtoken(ptoken,MAXTOK) .ne. NEWLINE) then call pbstr(ptoken) end if else if (t .eq. LPAREN) then nlpar = nlpar + 1 else if (t .eq. RPAREN) then nlpar = nlpar - 1 end if call outstr(token) until (nlpar .lt. 0) if (nlpar .ne. 0) then call synerr('unbalanced parentheses.') end if return end
doの終わりのコードは、dostat()で生成します。
dostat()のRatofor版は以下の通り。
# dostat.r4 -- generate code for end of do statement subroutine dostat(lab) integer lab call outcon(lab) call outcon(lab+1) return end
WATCOM Fortran77版は以下の通り。
c dostat.f -- generate code for end of do statement subroutine dostat(lab) integer lab call outcon(lab) call outcon(lab+1) return end
Ratforプリプロセッサー -- コード生成 "while" ― 2017年06月24日 18:26
while文にであったら、whileの条件を取り出して、ラベルL、L+1を 作りだし、
continue L if ( .not. (条件)) goto L+1を出力します。そして、whileの終わりに達したら、
goto L L+1 continueを出力します。ここで、ラベルL+1は、breakに出会ったときの行き先になります。また、ラベルLは、 nextに出会った時の行き先になります。 具体的には、whilec()でwhile文のはじめを生成します。
whilec()のRatofor版は以下の通り。
# whilec.r4 -- generate code for beginning of while subroutine whilec(lab) integer lab call outcon(0) lab = labgen(2) call outnum(lab) call ifgo(lab+1) return end
WATCOM Fortran77版は以下の通り。
c whilec.f -- generate code for beginning of while subroutine whilec(lab) integer lab call outcon(0) lab = labgen(2) call outnum(lab) call ifgo(lab+1) return end
whileの終わりは、whiles()でコードを生成します。
whiles()のRatofor版は以下の通り。
# whiles.r4 -- generate code for end of while subroutine whiles(lab) integer lab call outgo(lab) call outcon(lab+1) return end
WATCOM Fortran77版は以下の通り。
c whiles.f -- generate code for end of while subroutine whiles(lab) integer lab call outgo(lab) call outcon(lab+1) return end
最近のコメント