v15i103: yet another fortran ratfor/beaut
jim nelson
nelson at uncecs.edu
Tue Dec 18 12:29:08 AEST 1990
Posting-number: Volume 15, Issue 103
Submitted-by: nelson at uncecs.edu (jim nelson)
Archive-name: fb/part01
Yet another ratfor fortran/beautifier package.
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: fb.1 README Makefile x.f fb.c kindex.c prewhile.c
# dountil.c f77uc2lc.c f77lc2uc.c XDaTa
# Wrapped by nelson at 3b2a on Fri Nov 23 17:59:14 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'fb.1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'fb.1'\"
else
echo shar: Extracting \"'fb.1'\" \(932 characters\)
sed "s/^X//" >'fb.1' <<'END_OF_FILE'
X
X
X
XFB(1) LOCAL FB(1)
X
X
X
XNAME
X fb - fortran program beautifier
X
XSYNOPSIS
X fb [-<digit>]
X
XDESCRIPTION
X
X Fb places a copy of the fortran program from the standard input
X on the standard output with spacing and indentation that displays
X the structure of the program.
X
X The sole option is an optional number of blanks to be used for
X indentation. The default is 4.
X
X It recognizes the following constructs for indentation purposes
X
X 1) if(...)then ... [else ...] endif
X 2) do ... until(...)
X 3) while(...) ... endwhile
X 4) regular fortran do-statements
X
X Note that 1) and 4) above are real f77 statements, but 2) and 3)
X are part of the "myratfor" package of preprocessors, also by the
X same author.
X
X
XAUTHOR
X Jim Nelson, Univ. of NC at Wilmington, MathSciences Dept.
X nelson at ecsvax.uncecs.edu
X {...,mcnc}!ecsvax!uncw!nelson
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
END_OF_FILE
if test 932 -ne `wc -c <'fb.1'`; then
echo shar: \"'fb.1'\" unpacked with wrong size!
fi
# end of 'fb.1'
fi
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(1599 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XA ('nuther?) ratfor package. If you've ever had to teach FORTRAN
Xwithout one (why do I not have one ... I don't know!) you'd write
Xone yourself. Here's a package that contains three main programs
Xand two auxilliary ones:
X1) fb -- sorta like "cb", it "beautifies" (in the eye of the
X beholder) fortran source;
X2) prewhile -- a preprocessor for "while ... endwhile" statements;
X3) dountil -- a preprocessor for "do ... until" statements.
X
XAlso included are a couple of uc/lc and vice versa programs in case
Xyour fortran doesn't recognize lc.
X
XI have found this package quite useful in trying to explain some
Xof the more complex (hah!) loop constructs necessary in some of
Xthe programming assignments I've just given (finding words, end-
Xof-lines, etc., in text).
X
XTo make:
X1) unshar the kit in a clean directory (warning: the Makefile does
X some "rm" thingies, so make sure you are in a clean directory)
X2) vi (or whatever) the Makefile, and look at and modify the first
X few lines.
X3) make test
X4) if this is successful, and you wish to install
X5) make install
X will install the things in /usr/local/bin, or wherever you choose.
X
XThe "make test" (if all goes well) will attempt to run the two pre-
Xprocessors and fb in some different orders on a file called "x.f",
Xwhich is purposely "hard"(i.e. "terrible code"), but not "impossible",
Xmaking four files y[1-4].f and calling your fortran compiler on them.
XThe resultant output is "diff"ed for testing.
X
XJim Nelson
XUNC at Wilmington, CS/Math Dept
XWilmington, NC 28403 919-395-3300
Xnelson at ecsvax.uncecs.edu || {...,mcnc}!ecsvax!uncw!nelson
END_OF_FILE
if test 1599 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
chmod +x 'README'
# end of 'README'
fi
if test -f 'Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(1864 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
XP=#& #for sequent parallel make
XCC=cc #gcc
XCFLAGS=#-O
XFFLAGS=-f #for3b2 floating point fortran
XFORTRAN=f77
X#FORTRAN=fortran
XWHERE=/usr/local/bin
X
X#below here should not need modifying
X
XEXES=fb prewhile dountil f77lc2uc f77uc2lc
XSRCS=fb.c kindex.c prewhile.c dountil.c f77uc2lc.c f77lc2uc.c
XOBJS=fb.o kindex.o prewhile.o dountil.o f77uc2lc.o f77lc2uc.o
X
X
Xall:$(P) $(EXES)
X
Xfb: $(P) $(OBJS) #fb.o kindex.o
X cc -s -o fb fb.o kindex.o
Xprewhile: $(P) prewhile.o kindex.o
X cc -s -o prewhile prewhile.o kindex.o
Xdountil: $(P) dountil.o kindex.o
X cc -s -o dountil dountil.o kindex.o
Xf77uc2lc: $(P) f77uc2lc.o
X cc -s -o f77uc2lc f77uc2lc.o
Xf77lc2uc: $(P) f77lc2uc.o
X cc -s -o f77lc2uc f77lc2uc.o
Xinstall: $(EXES)
X cp $(EXES) $(WHERE)
Xkit:
X shar fb.1 README Makefile x.f \
X $(SRCS) XDaTa>kit
Xclean:
X rm -f core *.o *.e *.out y*.f fb dountil prewhile f77lc2uc \
X f77uc2lc
X
Xyfs: $(P) all y1.f y2.f y3.f y4.f
Xyos: $(P) yfs y1.o y2.o y3.o y4.o
Xyes: $(P) yos y1.e y2.e y3.e y4.e
Xyous: $(P) yes y1.out y2.out y3.out y4.out
X
Xtest: all yous #yes y1.out y2.out y3.out y4.out
X -diff y1.out y2.out
X -diff y1.out y3.out
X -diff y1.out y4.out
X -diff y2.out y3.out
X -diff y2.out y4.out
X -diff y3.out y4.out
X
Xy1.out: y1.e
X ./y1.e>y1.out
Xy2.out: y2.e
X ./y2.e>y2.out
Xy3.out: y3.e
X ./y3.e>y3.out
Xy4.out: y4.e
X ./y4.e>y4.out
X
Xy1.f: $(EXES) x.f
X ./prewhile<x.f|./dountil|./fb>y1.f
Xy2.f: $(EXES) x.f
X ./dountil<x.f|./prewhile|./fb>y2.f
Xy3.f: $(EXES) x.f
X ./fb<x.f|./prewhile|./dountil>y3.f
Xy4.f: $(EXES) x.f
X ./fb<x.f|./dountil|./prewhile>y4.f
X
Xy1.o: y1.f
X $(FORTRAN) -c $(FFLAGS) y1.f
Xy2.o: y2.f
X $(FORTRAN) -c $(FFLAGS) y2.f
Xy3.o: y3.f
X $(FORTRAN) -c $(FFLAGS) y3.f
Xy4.o: y4.f
X $(FORTRAN) -c $(FFLAGS) y4.f
X
Xy1.e: y1.o
X $(FORTRAN) $(FFLAGS) y1.o -o y1.e
Xy2.e: y2.o
X $(FORTRAN) $(FFLAGS) y2.o -o y2.e
Xy3.e: y3.o
X $(FORTRAN) $(FFLAGS) y3.o -o y3.e
Xy4.e: y4.o
X $(FORTRAN) $(FFLAGS) y4.o -o y4.e
X
END_OF_FILE
if test 1864 -ne `wc -c <'Makefile'`; then
echo shar: \"'Makefile'\" unpacked with wrong size!
fi
chmod +x 'Makefile'
# end of 'Makefile'
fi
if test -f 'x.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'x.f'\"
else
echo shar: Extracting \"'x.f'\" \(877 characters\)
sed "s/^X//" >'x.f' <<'END_OF_FILE'
X integer frog(50),zork(50),
X & dood,do27k
X frog(27)=zork(15)
X i=1
X 12 while( (i.lt.4) .and. (frog(27).eq.zork(15)) )
X print*,'i=',i
X i=i+1
X do 13 id=1,2
X13 j=i+1
X do
X print*,'k=',k
X do 144 m=1,2
X do 144 j=1,2
X do 144 k=1,2
X a=m+j+k
X144 print*,'A=',a
X y=27
X do
X do27k=13
X print*,'y=',y
X y=y/4
X until(y.lt.1)
X print*,'x=',x
X x=x-1
X dood=x
X until(x.lt.7)
X k=k+1
X do 23 z=1,4
X print*,'z=',z
X23 doofus=4
X doofus=5
X do26i=55.57
X print*,'doofus=',doofus
X print*,'do26i=',do26i
X a=4
X b=5
X do27k=55,56
X if(a.gt.b)then
X q=4
X else
X 4 mumble=7
X endif
X27 continue
X j=1
X while(j.lt.3)
X print*,'j=',j
X j=j+1
X endwhile
X OpEn(7,file='XDaTa',status='Old')
X close(7)
X endwhile
X end
END_OF_FILE
if test 877 -ne `wc -c <'x.f'`; then
echo shar: \"'x.f'\" unpacked with wrong size!
fi
# end of 'x.f'
fi
if test -f 'fb.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'fb.c'\"
else
echo shar: Extracting \"'fb.c'\" \(3219 characters\)
sed "s/^X//" >'fb.c' <<'END_OF_FILE'
X/*fortran indenter for if then else endif
Xand while endwhile */
X#include <stdio.h>
Xchar line[300];
Xint indent,nindent;
X
Xmain(argc,argv)
Xchar **argv;
X{
X int i,j,label,lookfor;
X FILE *fp;
X int c1;
X char *file;
X
X fp=stdin;
X nindent=4;
X if(argc>=2){
X if(argv[1][0]=='-')
X nindent=atoi(&argv[1][1]);
X else
X {
X fp=fopen(argv[1],"r");
X file=argv[1];
X }
X }
X if(nindent<1 || nindent>44){
X fprintf(stderr,"nindent has a weird value==%d\n",nindent);
X exit(1);
X }
X if(argc==3){
X fp=fopen(argv[2],"r");
X file=argv[2];
X }
X if(!fp){
X fprintf(stderr,"could not open \"%s\"\n",file);
X exit(1);
X }
X
X indent=0;
X
X while(fgets(line+1,298,fp)){
X char *l;
X c1= *(line+1);
X if(c1=='*' || c1=='C' || c1=='c'){
X printf("%s",line+1);
X continue;
X }
X c1=line[6];
X line[6]=0;
X label=atoi(line+1);
X line[6]=c1;
X lc(line);
X ftabify(line);
X l=line+7;
X if(label){
X while(label==tos()){ (void)pop(); indent--;}
X putline();
X continue;
X
X }
X
X
X
X if(kindex(l,"else")>=0)
X if(kindex(l,"if")>=0){
X if(kindex(l,"then")>=0){
X indent--;
X putline();
X indent++;
X continue;
X }
X }
X if(kindex(l,"if")>=0){
X if(kindex(l,"then")>=0){
X putline();
X indent++;
X continue;
X }
X }
X if(kindex(l,"else")>=0){
X indent--;
X putline();
X indent++;
X continue;
X }
X if((j=kindex(l,"end"))>=0 && kindex(l,"if")>j){
X indent--;
X putline();
X continue;
X }
X if((j=kindex(l,"end"))>=0 && kindex(l,"while")>j){
X indent--;
X putline();
X continue;
X
X }
X if(kindex(l,"while")>=0){
X putline();
X indent++;
X continue;
X }
X if(kindex(l,"do")>=0)
X {
X for(j=0;l[j];j++)if(l[j]>' ' &&
X l[j]!='d' && l[j]!='o') goto notdo;
X putline();
X indent++;
X continue;
X }
Xnotdo:
X if(kindex(l,"until")>=0){
X indent--;
X putline();
X continue;
X }
X if((i=kindex(l,"do"))>=0)
X {
X int k=0;
X for(j=i+2;l[j];j++)
X {
X if(l[j]>='0' && l[j]<='9')k++;
X else if(l[j]==' ' || l[j]=='\t')continue;
X else break;
X }
X if(k>0 && k<=5) lookfor=atoi(l+i+2);
X else lookfor=0;
X if(lookfor){
X while(l[j]&&l[j]!='=')j++;
X while(l[j]&&l[j]!=',')j++;
X if(l[j]!=',')lookfor=0;
X }
X /* printf("k=%d lookfor=%d\n",k,lookfor);*/
X if(lookfor){
X push(lookfor);
X putline();
X indent++;
X continue;
X }
X }
X putline();
X }
X return 0;
X
X}
Xstatic int n=0;
Xstatic int stack[50];
Xtos(){ return stack[n-1];}
Xpush(v)
X{
X if(n>49){
X fprintf(stderr,"stack overflow");
X exit(1);
X }
X stack[n++]=v;
X}
Xpop()
X{
X if(n<=0){
X return -1;
X /*fprintf(stderr,"stack underflow");exit(2);*/
X }
X return stack[--n];
X}
Xlc(m)
Xchar *m;
X{
X int i,ql=0,nbl=0;
X for(i=1;m[i];i++){
X if(m[i]>' ')nbl=1;
X if(m[i]==047/*single quote*/)ql++;
X if(!(ql&1))if(m[i]>='A'&&m[i]<='Z')m[i] = m[i] -'A' +'a';
X }
X if(!nbl)strcpy(m," c \n");
X}
Xftabify(k)
Xchar *k;
X{
X char m[300];
X int i;
X for(i=0;i<=6;i++)m[i]=' ';
X for(i=1;i<=6;i++){
X if(k[i]=='\t')goto zook;
X m[i]=k[i];
X }
X return;
Xzook:
X strcpy(m+7,k+i+1);
X strcpy(k+1,m+1);
X
X
X}
Xputline()
X{
X int i,j;
X if(indent<0){
X fprintf(stderr,"oops indent=%d\n",indent);
X exit(1);
X }
X for(i=1;i<=6;i++)putchar(line[i]);
X for(i=0;i<indent;i++)for(j=0;j<nindent;j++)putchar(' ');
X for(i=7;line[i]==' '||line[i]=='\t';i++);
X printf("%s",line+i);
X}
END_OF_FILE
if test 3219 -ne `wc -c <'fb.c'`; then
echo shar: \"'fb.c'\" unpacked with wrong size!
fi
# end of 'fb.c'
fi
if test -f 'kindex.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kindex.c'\"
else
echo shar: Extracting \"'kindex.c'\" \(170 characters\)
sed "s/^X//" >'kindex.c' <<'END_OF_FILE'
Xkindex(s,t)
Xchar s[],t[];
X{
X int c,i,j,k;
X for(i=0;s[i] !='\0'; i++){
X for(j=i,k=0;t[k] !='\0' && s[j]==t[k];j++,k++)
X ;
X if(t[k]=='\0')return (i);
X }
X return(-1);
X}
END_OF_FILE
if test 170 -ne `wc -c <'kindex.c'`; then
echo shar: \"'kindex.c'\" unpacked with wrong size!
fi
# end of 'kindex.c'
fi
if test -f 'prewhile.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'prewhile.c'\"
else
echo shar: Extracting \"'prewhile.c'\" \(990 characters\)
sed "s/^X//" >'prewhile.c' <<'END_OF_FILE'
X#include <stdio.h>
Xmain()
X{
X char line[900];
X int i,j,k,l,stmtno=90001;
X while(gets(line)){
X if(*line&&(i=kindex(line,"end"))>=0
X && kindex(line+i+3,"while")>=0){
X int stmtno=pop();
X printf(" goto%d\n",stmtno);
X printf("%d continue\n",stmtno+1);
X }
X else
X if(*line&&(i=kindex(line,"while"))>=0){
X j=0;
X do{
X line[i+j]=line[i+j+5];
X }while(line[i+j++]);
X j=matchparen(line+i);
X printf("%d if(.not.%s)goto%d\n",stmtno,
X line+i,stmtno+1);
X push(stmtno);
X stmtno+=2;
X if(stmtno>99999)exit(3);
X }
X else puts(line);
X }
X}
Xmatchparen(p)
Xchar *p;
X{
X char c;
X char *q = p;
X int i;
X while(*p && *p!='(')p++;
X p++;
X i=1;
X while( (c= *p++)){
X if(c=='(')i++;
X if(c==')')i--;
X if(i==0 && p>q){
X *p=0;
X return;
X }
X }
X}
Xstatic int n=0;
Xstatic int stack[50];
Xpush(v)
X{
X if(n>49){
X fprintf(stderr,"stack overflow");
X exit(1);
X }
X stack[n++]=v;
X}
Xpop()
X{
X if(n<=0){
X fprintf(stderr,"stack underflow");
X exit(2);
X }
X return stack[--n];
X}
END_OF_FILE
if test 990 -ne `wc -c <'prewhile.c'`; then
echo shar: \"'prewhile.c'\" unpacked with wrong size!
fi
# end of 'prewhile.c'
fi
if test -f 'dountil.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dountil.c'\"
else
echo shar: Extracting \"'dountil.c'\" \(1168 characters\)
sed "s/^X//" >'dountil.c' <<'END_OF_FILE'
X#include <stdio.h>
Xmain()
X{
X char line[900];
X int c,i,j,k,l,stmtno=95001;
X while(gets(line)){
X if(!(*line))continue;
X if((i=kindex(line,"do"))>=0)
X {
X c=0;
X for(j=0;line[j];j++)
X if(line[j]>' '){
X if(line[j]=='d')if(c==0)c=1;
X else goto putaline;
X else
X if(line[j]=='o')if(c==1)c=2;
X else goto putaline;
X else
X goto putaline;
X }
X if(c!=2)goto putaline;
X printf("%d continue\n",stmtno);
X push(stmtno);
X stmtno++;
X if(stmtno>99999)exit(3);
X continue;
X }
X if((i=kindex(line,"until"))>=0){
X int sno=pop();
X j=0;
X do{
X line[i+j]=line[i+j+5];
X }while(line[i+j++]);
X j=matchparen(line+i);
X printf(" if(.not.%s)goto%d\n", line+i,sno);
X continue;
X }
X
Xputaline:
X puts(line);
X }
X}
Xmatchparen(p)
Xchar *p;
X{
X char c;
X char *q = p;
X int i;
X while(*p && *p!='(')p++;
X p++;
X i=1;
X while( (c= *p++)){
X if(c=='(')i++;
X if(c==')')i--;
X if(i==0 && p>q){
X *p=0;
X return;
X }
X }
X}
Xstatic int n=0;
Xstatic int stack[50];
Xpush(v)
X{
X if(n>49){
X fprintf(stderr,"stack overflow");
X exit(1);
X }
X stack[n++]=v;
X}
Xpop()
X{
X if(n<=0){
X fprintf(stderr,"stack underflow");
X exit(2);
X }
X return stack[--n];
X}
END_OF_FILE
if test 1168 -ne `wc -c <'dountil.c'`; then
echo shar: \"'dountil.c'\" unpacked with wrong size!
fi
# end of 'dountil.c'
fi
if test -f 'f77uc2lc.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'f77uc2lc.c'\"
else
echo shar: Extracting \"'f77uc2lc.c'\" \(203 characters\)
sed "s/^X//" >'f77uc2lc.c' <<'END_OF_FILE'
X#include <stdio.h>
Xmain()
X{
X int ql=0, c;
X while( (c=getchar())!=EOF ){
X if(c==047/*single quote*/)ql++;
X if( (ql%2)==0){
X if(c>='A' && c<='Z')c=c-'A'+'a';
X putchar(c);
X }
X else putchar(c);
X }
X}
END_OF_FILE
if test 203 -ne `wc -c <'f77uc2lc.c'`; then
echo shar: \"'f77uc2lc.c'\" unpacked with wrong size!
fi
# end of 'f77uc2lc.c'
fi
if test -f 'f77lc2uc.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'f77lc2uc.c'\"
else
echo shar: Extracting \"'f77lc2uc.c'\" \(203 characters\)
sed "s/^X//" >'f77lc2uc.c' <<'END_OF_FILE'
X#include <stdio.h>
Xmain()
X{
X int ql=0, c;
X while( (c=getchar())!=EOF ){
X if(c==047/*single quote*/)ql++;
X if( (ql%2)==0){
X if(c>='a' && c<='z')c=c-'a'+'A';
X putchar(c);
X }
X else putchar(c);
X }
X}
END_OF_FILE
if test 203 -ne `wc -c <'f77lc2uc.c'`; then
echo shar: \"'f77lc2uc.c'\" unpacked with wrong size!
fi
# end of 'f77lc2uc.c'
fi
if test -f 'XDaTa' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'XDaTa'\"
else
echo shar: Extracting \"'XDaTa'\" \(7 characters\)
sed "s/^X//" >'XDaTa' <<'END_OF_FILE'
Xxxxxxx
END_OF_FILE
if test 7 -ne `wc -c <'XDaTa'`; then
echo shar: \"'XDaTa'\" unpacked with wrong size!
fi
# end of 'XDaTa'
fi
echo shar: End of shell archive.
exit 0
--
jim nelson nelson at ecsvax.uncecs.edu nelson at ecsvax.bitnet
More information about the Comp.sources.misc
mailing list