nelson@uncecs.edu (jim nelson) (12/18/90)
Posting-number: Volume 15, Issue 103 Submitted-by: nelson@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@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@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@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@ecsvax.uncecs.edu nelson@ecsvax.bitnet