Ratfor in C (bug fixes and enhancements to generate F77)
ken at boring.UUCP
ken at boring.UUCP
Thu Jun 27 05:34:50 AEST 1985
These context diffs follow Ozan Yigit's posting of Ratfor in C. There
are 2 bug fixes, and changes to make it generate Fortran-77 code for
if and while statements. A short test program and output are included.
Please send bug reports on the original code to Ozan, bug reports on
the added code to me. Thanks for the posting, Ozan.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# ctxdiff
# test.r
# test.f
# This archive created: Wed Jun 26 13:29:08 1985
# By: Ken Yap ()
export PATH; PATH=/bin:$PATH
if test -f 'ctxdiff'
then
echo shar: will not over-write existing file "'ctxdiff'"
else
cat << \SHAR_EOF > 'ctxdiff'
*** ratfor.c Tue Jun 25 14:49:59 1985
--- rat77.c Wed Jun 26 13:19:13 1985
***************
*** 33,38
char velse[2] = {
LEXELSE,EOS};
char swhile[6] = {
LETW, LETH, LETI, LETL, LETE, EOS};
char vwhile[2] = {
--- 33,44 -----
char velse[2] = {
LEXELSE,EOS};
+ char sthen[5] = {
+ LETT,LETH,LETE,LETN,EOS};
+
+ char sendif[6] = {
+ LETE,LETN,LETD,LETI,LETF,EOS};
+
char swhile[6] = {
LETW, LETH, LETI, LETL, LETE, EOS};
char vwhile[2] = {
***************
*** 866,873
int lab;
{
! outgo(lab+1);
! outcon(lab);
}
/*
--- 872,880 -----
int lab;
{
! outtab();
! outstr(selse);
! outdon();
}
/*
***************
*** 986,992
xfer = NO;
*lab = labgen(2);
! ifgo(*lab);
}
/*
--- 993,999 -----
xfer = NO;
*lab = labgen(2);
! ifthen();
}
/*
***************
*** 990,995
}
/*
* ifgo - generate "if(.not.(...))goto lab"
*
*/
--- 997,1013 -----
}
/*
+ * ifend - generate code for end of if
+ *
+ */
+ ifend()
+ {
+ outtab();
+ outstr(sendif);
+ outdon();
+ }
+
+ /*
* ifgo - generate "if(.not.(...))goto lab"
*
*/
***************
*** 1004,1009
outgo(lab); /* " goto lab " */
}
/*
* labelc - output statement number
--- 1022,1033 -----
outgo(lab); /* " goto lab " */
}
+ /*
+ * ifthen - generate "if((...))then"
+ *
+ */
+ ifthen()
+ {
outtab();
outstr(sif);
***************
*** 1005,1010
}
/*
* labelc - output statement number
*
--- 1029,1041 -----
ifthen()
{
+ outtab();
+ outstr(sif);
+ balpar();
+ outstr(sthen);
+ outdon();
+ }
+
/*
* labelc - output statement number
*
***************
*** 1096,1102
outbuf[outp] = NEWLINE;
outbuf[outp+1] = EOS;
! printf(outbuf);
outp = 0;
}
--- 1127,1133 -----
outbuf[outp] = NEWLINE;
outbuf[outp+1] = EOS;
! printf("%s", outbuf);
outp = 0;
}
***************
*** 1286,1293
break;
if (lextyp[tp] == LEXIF && token == LEXELSE)
break;
! if (lextyp[tp] == LEXIF)
! outcon(labval[tp]);
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
--- 1317,1325 -----
break;
if (lextyp[tp] == LEXIF && token == LEXELSE)
break;
! if (lextyp[tp] == LEXIF) {
! ifend();
! }
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
***************
*** 1291,1297
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
! outcon(labval[tp]+1);
}
else if (lextyp[tp] == LEXDO)
dostat(labval[tp]);
--- 1323,1329 -----
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
! ifend();
}
else if (lextyp[tp] == LEXDO)
dostat(labval[tp]);
***************
*** 1339,1345
outcon(0); /* unlabeled continue, in case there was a label */
tlab = labgen(2);
outnum(tlab);
! ifgo(tlab+1);
*lab = tlab;
}
--- 1371,1377 -----
outcon(0); /* unlabeled continue, in case there was a label */
tlab = labgen(2);
outnum(tlab);
! ifthen();
*lab = tlab;
}
***************
*** 1352,1357
{
outgo(lab);
outcon(lab+1);
}
--- 1384,1390 -----
{
outgo(lab);
+ ifend();
outcon(lab+1);
}
***************
*** 1392,1398
for (i = fnamp - 1; i > 1; i = i - 1)
if (fnames[i-1] == EOS) { /* print file name */
fprintf(stderr,in);
! fprintf(stderr,fnames[i]);
break;
}
fprintf(stderr,": \n %s\n",msg);
--- 1425,1431 -----
for (i = fnamp - 1; i > 1; i = i - 1)
if (fnames[i-1] == EOS) { /* print file name */
fprintf(stderr,in);
! fprintf(stderr,&fnames[i]);
break;
}
fprintf(stderr,": \n %s\n",msg);
SHAR_EOF
fi # end of overwriting check
if test -f 'test.r'
then
echo shar: will not over-write existing file "'test.r'"
else
cat << \SHAR_EOF > 'test.r'
integer x,y
x=1; y=2
if(x == y)
write(6,600)
else if(x > y)
write(6,601)
else
write(6,602)
x=1
while(x < 10){
if(y != 2) break
if(y != 2) next
write(6,603)x
x=x+1
}
repeat
x=x-1
until(x == 0)
for(x=0; x < 10; x=x+1)
write(6,604)x
600 format('Wrong, x != y')
601 format('Also wrong, x < y')
602 format('Ok!')
603 format('x = ',i2)
604 format('x = ',i2)
end
SHAR_EOF
fi # end of overwriting check
if test -f 'test.f'
then
echo shar: will not over-write existing file "'test.f'"
else
cat << \SHAR_EOF > 'test.f'
integer x,y
x=1
y=2
if(x .eq. y)then
write(6,600)
else
if(x .gt. y)then
write(6,601)
else
write(6,602)
endif
endif
x=1
23004 if(x .lt. 10)then
if(y .ne. 2)then
goto 23005
endif
if(y .ne. 2)then
goto 23004
endif
write(6,603)x
x=x+1
goto 23004
endif
23005 continue
23010 continue
x=x-1
23011 if(.not.(x .eq. 0))goto 23010
23012 continue
x=0
23013 if(.not.(x .lt. 10))goto 23015
write(6,604)x
23014 x=x+1
goto 23013
23015 continue
600 format('Wrong, x != y')
601 format('Also wrong, x < y')
602 format('Ok!')
603 format('x = ',i2)
604 format('x = ',i2)
end
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0
--
UUCP: ..!{seismo,okstate,garfield,decvax,philabs}!mcvax!ken Voice: Ken!
Mail: Centrum voor Wiskunde en Informatica, Kruislaan 413, 1098 SJ, Amsterdam.
More information about the Comp.sources.unix
mailing list