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
コメントをどうぞ
※メールアドレスとURLの入力は必須ではありません。 入力されたメールアドレスは記事に反映されず、ブログの管理者のみが参照できます。