Ratforプリプロセッサー -- 構文解析 ― 2017年05月25日 16:50
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
最近のコメント