Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume12 / ffccc / part05 < prev next >

Wrap

Text File | 1990-05-14 | 47.2 KB | 1,223 lines

Newsgroups: comp.sources.misc organization: CERN, Geneva, Switzerland keywords: fortran subject: v12i091: Floppy - Fortran Coding Convention Checker Part 05/11 from: julian@cernvax.cern.ch (julian bunn) Sender: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Posting-number: Volume 12, Issue 91 Submitted-by: julian@cernvax.cern.ch (julian bunn) Archive-name: ffccc/part05 #!/bin/sh echo 'Start of Floppy, part 05 of 11:' echo 'x - PROCES.f' sed 's/^X//' > PROCES.f << '/' X SUBROUTINE PROCES X*----------------------------------------------------------------------- X* X* Processes one routine statement by statement: X* filtering, replacements X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'CLASS.h' X include 'FLAGS.h' X include 'CURSTA.h' X include 'STATE.h' X include 'JOBSUM.h' X LOGICAL SAMEST X*--- treat routine header and init X CALL RSTART X*--- TREE preparation if no proper header X IF(ACTION(29).AND.SCROUT.EQ.'NOHEADER') CALL TREEST(0) X*--- user top of routine X IF(ACTION(22)) CALL URINIT X X*--- NP controls the number of blank lines for print headers X NP=0 X*--- process only if routine selected X IF (STATUS(7)) THEN X*--- loop over all statements in routine X DO 60 IST=1,NSTAMM X STATUS(8)=.TRUE. X STATUS(10)=.TRUE. X STATUS(11)=.FALSE. X IF (ICLASS(IST,1).GT.0) THEN X*--- extract and set classes X CALL EXTRAC(IST,'FULL') X ICURCL(1)=ICLASS(IST,1) X ICURCL(2)=ICLASS(IST,2) X IF (ICURCL(1).EQ.ILL) NFDCLS(ILL,1)=NFDCLS(ILL,1)+1 X ENDIF X IF (ICLASS(IST,1).EQ.ILL.AND.ACTION(3)) THEN X IF (STATUS(9)) THEN X STATUS(9)=.FALSE. X IF (ACTION(6)) THEN X WRITE (MPUNIT,10000) 'all',SCROUT X ELSE X WRITE (MPUNIT,10000) 'selected',SCROUT X ENDIF X ENDIF X STATUS(10)=.FALSE. X CALL FLPRNT(1,'illegal',NLLINE(IST)-NFLINE(IST)+1,SIMA( X + NFLINE(IST)),NSTATC(8)) X NP=1 X*--- print all if requested X ELSEIF (ACTION(6)) THEN X*--- routine header X IF (STATUS(9)) THEN X STATUS(9)=.FALSE. X WRITE (MPUNIT,10000) 'all',SCROUT X ENDIF X STATUS(10)=.FALSE. X CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA(NFLINE( X + IST)),NSTATC(8)) X NP=0 X ENDIF X*--- call user routine for ALL statements X IF(ACTION(22)) CALL USSALL X*--- process only legal FORTRAN statements X IF (ICLASS(IST,1).GT.0.AND.ICLASS(IST,1).NE.ILL) THEN X*--- get statement number X SNEWST(1)(1:6)=SIMA(NFLINE(IST))(1:6) X*--- filter for classes X IF (ACTION(17)) CALL FILTER(13,8) X IF (STATUS(8)) THEN X*--- get statement names X ISNAME=IRNAME+NRNAME X CALL GETALL X*--- filter for names X IF (ACTION(18)) CALL FILTER(11,8) X IF (STATUS(8)) THEN X*--- filter for strings X IF (ACTION(19)) CALL FILTER(12,8) X IF (STATUS(8)) THEN X*--- all filters passed - update statistics X IMODIF(IST)=1 X NSTATC(4)=NSTATC(4)+1 X NFDCLS(ICURCL(1),1)=NFDCLS(ICURCL(1),1)+1 X IF (ICURCL(1).EQ.IIF) NFDCLS(ICURCL(2),2)=NFDCLS X + (ICURCL(2),2)+1 X*--- user start of statement X IF(ACTION(22)) CALL USSBEG X*--- prepare indentation if requested X IF(ACTION(21)) CALL PROIND X*----get type for variables X IF (ACTION(20)) CALL SETTYP(1) X*--- check for incorrect relational operators in character type X CALL CHKCHR X*--- treat names further if any X IF(NSNAME.GT.0) THEN X*--- prepare TREE output X IF(ACTION(29)) CALL TREEST(1) X*--- find used and unused common blocks X IF(ACTION(24).AND..NOT.STATUS(12)) X + CALL PROCOM X*--- perform name replacements X IF (ACTION(15)) CALL REPNAM X IF (STATUS(11)) GOTO 10 X IF (ACTION(1).OR.ACTION(2)) THEN X*--- add names to routine name list X CALL LSORT(SNAMES(ISNAME+1), X + NAMTYP(ISNAME+1),.TRUE.,NSNAME) X CALL LMERGE(SNAMES,NAMTYP,.TRUE.,IRNAME, X + NRNAME,NSNAME) X CALL SUPMOR(SNAMES,NAMTYP,.TRUE.,IRNAME, X + NRNAME+NSNAME,NRNAME) X ENDIF X ENDIF X IF (ACTION(5).AND.STATUS(10)) THEN X*--- print filtered X IF (STATUS(9)) THEN X WRITE (MPUNIT,10000) 'filtered',SCROUT X STATUS(9)=.FALSE. X ENDIF X STATUS(10)=.FALSE. X CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1, X + SIMA(NFLINE(IST)),NSTATC(8)) X NP=0 X ENDIF X IF (ACTION(11).OR.ACTION(12)) THEN X*--- remove {} , change holl. to quotes if requested X CALL QUOSUB X IF (STATUS(11)) GOTO 10 X*--- string replacement X IF(ACTION(12)) CALL REPSTR X IF (STATUS(11)) GOTO 10 X*--- re-insert {} around strings for REFORM X CALL MARKST('FULL',IERR) X STATUS(11)=IERR.NE.0 X IF (STATUS(11)) GOTO 10 X ENDIF X*--- re-numbering if requested X IF (ACTION(13)) CALL RENUMB X*--- user end of statement X IF(ACTION(22)) CALL USSEND X ENDIF X ENDIF X ENDIF X*--- here you arrive without filter checks X 10 CONTINUE X IFILTR=0 X IF (STATUS(11)) IMODIF(IST)=MOD(IMODIF(IST),10) X*--- reformat = put modified statement into SIMA X IF (IMODIF(IST).GT.10.OR.ACTION(21).AND.IMODIF(IST).GT.0) X + THEN X CALL REFORM X*--- not changed if REFORM problem, or identical after REFORM X IF (STATUS(11).OR.SAMEST(IST)) X + IMODIF(IST)=MOD(IMODIF(IST),10) X ENDIF X IF (IMODIF(IST).GT.10) THEN X*--- count changed statements X NSTATC(5)=NSTATC(5)+1 X IF (ACTION(4).AND.STATUS(10)) THEN X*--- print changed statements X IF (STATUS(9)) THEN X WRITE (MPUNIT,10000) 'changed',SCROUT X STATUS(9)=.FALSE. X ENDIF X CALL FLPRNT(1,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA( X + NFLINE(IST)),NSTATC(8)) X ENDIF X*--- re-formatted statement in SNEWST X* put into SIMA, push SIMA if new longer than old, introduce blank X* lines if new shorter than old X N=0 X DO 20 I=NFLINE(IST),NLLINE(IST) X IF (NLTYPE(I).NE.0) THEN X N=N+1 X IF (N.GT.NEWOUT) THEN X SIMA(I)=' ' X ELSE X SIMA(I)=SNEWST(N) X ENDIF X ENDIF X 20 CONTINUE X NPUSH=NEWOUT-N X IF (NPUSH.GT.0) THEN X DO 30 I=NLINES,NLLINE(IST)+1,-1 X NLTYPE(I+NPUSH)=NLTYPE(I) X SIMA(I+NPUSH)=SIMA(I) X 30 CONTINUE X NLINES=NLINES+NPUSH X*--- loop over all statements since they might be in a different order X DO 40 I=1,NSTAMM X IF(NFLINE(I).GT.NFLINE(IST)) THEN X NFLINE(I)=NFLINE(I)+NPUSH X NLLINE(I)=NLLINE(I)+NPUSH X ENDIF X 40 CONTINUE X DO 50 I=1,NPUSH X SIMA(NLLINE(IST)+I)=SNEWST(N+I) X 50 CONTINUE X NLLINE(IST)=NLLINE(IST)+NPUSH X ENDIF X IF (ACTION(4)) THEN X CALL FLPRNT(0,'changed to',NLLINE(IST)-NFLINE(IST)+ X + 1,SIMA(NFLINE(IST)),NDUMMY) X NP=1 X ENDIF X ENDIF X ENDIF X 60 CONTINUE X ENDIF X*--- user end of routine X IF(ACTION(22)) CALL URTERM X*--- TREE output if any X IF(ACTION(29)) CALL TREESU X10000 FORMAT(/1X,20('++++'),A10,' statements, routine =',A10) X 999 END / echo 'x - PROCOM.f' sed 's/^X//' > PROCOM.f << '/' X SUBROUTINE PROCOM X*----------------------------------------------------------------------- X* X* Processes common blocks: collects name lists, X* marks the variables referenced in each routine X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'CLASS.h' X include 'FLAGS.h' X include 'CURSTA.h' X include 'FLWORK.h' X include 'STATE.h' X LOGICAL RANGE X CHARACTER SCB*8 X*--- get external statement number X ICLE=ISTMDS(6,ICURCL(1)) X IF(ICLE.EQ.12) THEN X*--- common block X IV=0 X ICOMMB=ISTMDS(17,ICURCL(1)) X ICOMMV=ISTMDS(21,ICURCL(1)) X 10 CONTINUE X*--- find c.b. name, and first and last variable in this c.b. X IF(ITBIT(NAMTYP(ISNAME+IV+1),ICOMMB).EQ.0) THEN X*--- first name not c.b. name ---> blank common X SCB='BLANKCOM' X ELSE X SCB=SNAMES(ISNAME+IV+1) X IV=IV+1 X ENDIF X*--- last var. in this c.b. is min. pos. of '//', or c.b. name X IPT=NSSTRT(IV+1)-1 X INS=INDEX(SSTA(IPT+1:NCHST),'//') X IND=INDEX(SSTA(IPT+1:NCHST),'/ /') X IF(IND.GT.0) THEN X IF(INS.GT.0) THEN X INS=MIN(IND,INS) X ELSE X INS=IND X ENDIF X ENDIF X IF(INS.GT.0) THEN X INS=IPT+INS X ELSE X INS=NCHST+1 X ENDIF X*--- collect variable name ref.s in IWS X N=0 X ILOW=IV+1 X DO 20 I=ILOW,NSNAME X K=ISNAME+I X NT=NAMTYP(K) X IF(ITBIT(NT,ICOMMB).NE.0) GOTO 30 X IF(NSSTRT(I).GT.INS) GOTO 30 X IF(ITBIT(NT,ICOMMV).NE.0) THEN X IF(NCBVAR+N.EQ.MXNAME) GOTO 180 X N=N+1 X SCBVAR(NCBVAR+N)=SNAMES(K) X ENDIF X IV=I X 20 CONTINUE X 30 CONTINUE X*--- store in name list for this common block X IF(N.GT.0) THEN X CALL LSORT(SCBVAR(NCBVAR+1),IWS,.FALSE.,N) X*--- look for name in c.b. name table X CALL NAMSRC(SCB,SCBNAM,NCBNAM,IPOS,LAST) X IF(IPOS.EQ.0) THEN X*--- not in table - add to existing X IF(NCBNAM.EQ.MAXGRP) GOTO 190 X DO 40 I=NCBNAM,LAST+1,-1 X SCBNAM(I+1)=SCBNAM(I) X NCBGRP(I+1)=NCBGRP(I) X KCBGRP(I+1)=KCBGRP(I) X 40 CONTINUE X NCBNAM=NCBNAM+1 X SCBNAM(LAST+1)=SCB X NCBGRP(LAST+1)=N X KCBGRP(LAST+1)=NCBVAR X ELSE X*--- already in table - add in place, and merge X CALL NAMOVE(SCBVAR,KCBGRP(IPOS)+NCBGRP(IPOS),NCBVAR,N) X CALL LMERGE(SCBVAR,IWS,.FALSE.,KCBGRP(IPOS),NCBGRP(IPOS), X + N) X DO 50 I=1,NCBNAM X IF(KCBGRP(I).GT.KCBGRP(IPOS)) KCBGRP(I)=KCBGRP(I)+N X 50 CONTINUE X DO 60 I=1,NEQNAM X IF(KEQGRP(I).GT.KCBGRP(IPOS)) KEQGRP(I)=KEQGRP(I)+N X 60 CONTINUE X NCBGRP(IPOS)=NCBGRP(IPOS)+N X ENDIF X NCBVAR=NCBVAR+N X ENDIF X IF(IV.LT.NSNAME) GOTO 10 X ELSEIF(ICLE.EQ.30) THEN X*--- EQUIVALENCE X IV=0 X IPT=0 X 70 CONTINUE X ILB=INDEX(SSTA(IPT+1:NCHST),'(') X IF(ILB.GT.0) THEN X ILB=ILB+IPT X CALL SKIPLV(SSTA,ILB+1,NCHST,.FALSE.,IRB,ILEV) X IF(IRB.GT.0) THEN X IPT=IRB X*--- only names outside brackets (inside each group) X CALL GETRNG(ILB+1,IRB-1,IWS) X ILOW=IV+1 X N=0 X DO 80 I=ILOW,NSNAME X IF(NSSTRT(I).GT.IRB) GOTO 90 X IF(.NOT.RANGE(NSSTRT(I),IWS)) THEN X IF(NCBVAR+N.EQ.MXNAME) GOTO 180 X N=N+1 X SCBVAR(NCBVAR+N)=SNAMES(ISNAME+I) X ENDIF X IV=I X 80 CONTINUE X 90 CONTINUE X IF(N.GT.0) THEN X IF(NEQNAM.EQ.MAXGRP) GOTO 200 X CALL LSORT(SCBVAR(NCBVAR+1),IWS,.FALSE.,N) X NEQNAM=NEQNAM+1 X KEQGRP(NEQNAM)=NCBVAR X NEQGRP(NEQNAM)=N X NCBVAR=NCBVAR+N X ENDIF X IF(IPT.LT.NCHST) GOTO 70 X ENDIF X ENDIF X ELSEIF(ICLE.EQ.16.OR.ISTMDS(11,ICURCL(1)).EQ.1) THEN X*--- DATA statement, or executable, i.e. start of routine X IF(.NOT.STATUS(13)) THEN X*--- merge all equiv. groups with common blocks X STATUS(13)=.TRUE. X 100 CONTINUE X DO 150 IE=1,NEQNAM X KEQ=KEQGRP(IE) X NEQ=NEQGRP(IE) X DO 140 IEI=1,NEQ X DO 130 IC=1,NCBNAM X CALL NAMSRC(SCBVAR(KEQGRP(IE)+IEI),SCBVAR(KCBGRP X + (IC)+1), NCBGRP(IC),IPOS,LAST) X IF(IPOS.NE.0) THEN X*--- equiv. group var. is in this c.b., add complete group X CALL NAMOVE(SCBVAR,KCBGRP(IC)+NCBGRP(IC),KEQ, X + NEQ) X KCB=KCBGRP(IC) X DO 110 I=1,NCBNAM X IF(KEQ.LT.KCB) THEN X IF(KCBGRP(I).LE.KCB.AND.KCBGRP(I).GT.KEQ) X + KCBGRP(I)=KCBGRP(I)-NEQ X ELSE X IF(KCBGRP(I).GT.KCB.AND.KCBGRP(I).LT.KEQ) X + KCBGRP(I)=KCBGRP(I)+NEQ X ENDIF X 110 CONTINUE X DO 120 I=1,NEQNAM X IF(KEQ.LT.KCB) THEN X IF(KEQGRP(I).LE.KCB.AND.KEQGRP(I).GT.KEQ) X + KEQGRP(I)=KEQGRP(I)-NEQ X ELSE X IF(KEQGRP(I).GT.KCB.AND.KEQGRP(I).LT.KEQ) X + KEQGRP(I)=KEQGRP(I)+NEQ X ENDIF X 120 CONTINUE X CALL LMERGE(SCBVAR,IWS,.FALSE.,KCBGRP(IC),NCBGRP X + (IC),NEQ) X CALL SUPMUL(SCBVAR,IWS,.FALSE.,KCBGRP(IC), X + NCBGRP(IC)+NEQ,N) X NCBGRP(IC)=N X NEQGRP(IE)=0 X*--- restart search X GOTO 100 X ENDIF X 130 CONTINUE X 140 CONTINUE X 150 CONTINUE X ENDIF X*--- look for any name in statement being in a c.b. X DO 170 I=1,NSNAME X DO 160 IC=1,NCBNAM X CALL NAMSRC(SNAMES(ISNAME+I),SCBVAR(KCBGRP(IC)+1),NCBGRP X + (IC), IPOS,LAST) X IF(IPOS.GT.0) THEN X*--- name is in this c.b. - set flag, count X IF(LCBVAR(KCBGRP(IC)+IPOS).EQ.0) X + LCBNAM(IC)=LCBNAM(IC)+1 X LCBVAR(KCBGRP(IC)+IPOS)=LCBVAR(KCBGRP(IC)+IPOS)+1 X GOTO 170 X ENDIF X 160 CONTINUE X 170 CONTINUE X ENDIF X GOTO 999 X*--- error - name buffer overflow X 180 CONTINUE X STATUS(12)=.TRUE. X WRITE(MPUNIT,10000) MXNAME,SCROUT X GOTO 999 X 190 CONTINUE X STATUS(12)=.TRUE. X WRITE(MPUNIT,10010) MAXGRP,SCROUT X GOTO 999 X 200 CONTINUE X STATUS(12)=.TRUE. X WRITE(MPUNIT,10020) MAXGRP,SCROUT X10000 FORMAT(/' +++++++++ WARNING - more than',I8,' variable names', X +' in COMMON and EQUIV., routine ',A8,' skipped') X10010 FORMAT(/' +++++++++ WARNING - more than',I8,' common block names', X +', routine ',A8,' skipped') X10020 FORMAT(/' +++++++++ WARNING - more than',I8,' groups', X +' in EQUIVALENCE, routine ',A8,' skipped') X 999 END / echo 'x - SETTYP.f' sed 's/^X//' > SETTYP.f << '/' X SUBROUTINE SETTYP(MODE) X*----------------------------------------------------------------------- X* X* Sets variable types for a given statement, or updates default list X* and names so far in case of IMPLICIT. X* X* Only sensible if called for all statements in a routine, and while X* establishing a name list for that routine. X* X* Input X* MODE = 0 : reset default type table, no further action X* > 0 : process statement X* SSTA (statement), NSNAME, NRNAME etc. X* Output X* NAMTYP in common /STATE/ X* X* Each type corresponds to a bit position (for testing use ITBIT). X* X* Types are: X* X* Bit meaning X* X* 1 INTEGER X* 2 REAL X* 3 LOGICAL X* 4 COMPLEX X* 5 DOUBLE PRECISION X* 6 CHARACTER X* 7 PARAMETER X* 8 COMMON block name X* 9 NAMELIST name X* 10 statement function X* 11 INTRINSIC X* 12 EXTERNAL X* 13 PROGRAM name X* 14 BLOCK DATA name X* 15 SUBROUTINE X* 16 ENTRY X* 17 FUNCTION (intrinsic or external) X* 18 dimensioned X* 19 (routine or function) argument X* 20 in a COMMON block X* 21 strongly typed function (internal usage) X* X*----------------------------------------------------------------------- X include 'PARAM.h' X include 'ALCAZA.h' X include 'CLASS.h' X include 'FLWORK.h' X include 'FLAGS.h' X include 'CURSTA.h' X include 'STATE.h' X include 'TYPDEF.h' X include 'CONDEC.h' X CHARACTER STEMP*1 ,STEMP1*1 X LOGICAL RANGE X DIMENSION ILOC(MCLASS),KDEFTP(26),NLIM1(2),NLIM2(2) X*--- KDEFTP = default FORTRAN types (REAL and INTEGER) for first letter X* KILOC = last location of ISTMDS not relevant for ILOC X* ILOC = local copy of type descriptors from ISTMDS X DATA KDEFTP/8*2,6*1,12*2/, KILOC/14/ X include 'CONDAT.h' X IF(MODE.EQ.0) THEN X*--- routine header: reset default type table X DO 10 I=1,26 X KVTYPE(I)=KDEFTP(I) X 10 CONTINUE X GOTO 999 X ENDIF X DO 20 I=ISNAME+1,ISNAME+NSNAME X NAMTYP(I)=0 X 20 CONTINUE X IF(ICURCL(1).EQ.IIF) THEN X IUP=2 X*--- find end of IF(...) X JPT=INDEX(SSTA(:NCHST),'(') X CALL SKIPLV(SSTA,JPT+1,NCHST,.FALSE.,KND,ILEV) X NLIM1(1)=1 X DO 30 I=1,NSNAME X IF(NSSTRT(I).GT.KND) GOTO 40 X 30 CONTINUE X I=NSNAME+1 X 40 CONTINUE X NLIM2(1)=I-1 X NLIM1(2)=I X NLIM2(2)=NSNAME X ELSE X IUP=1 X KND=NCHST X NLIM1(1)=1 X NLIM2(1)=NSNAME X ENDIF X DO 120 IPART=1,IUP X IF (IPART.EQ.1) THEN X ICL=ICURCL(1) X KST=1 X ELSE X ICL=ICURCL(2) X KST=KND+1 X KND=NCHST X ENDIF X*--- get flags, counts, and types X DO 50 I=1,MCLASS-KILOC X ILOC(I)=ISTMDS(KILOC+I,ICL) X 50 CONTINUE X IFLG2=ILOC(1)/10 X IFLG1=ILOC(1)-10*IFLG2 X ILPT=2 X IULOOP=1 X IF(IFLG2.NE.0) THEN X*--- take only names outside brackets, get ranges for this X CALL GETRNG(KST,KND,IWS) X ENDIF X IF(IFLG2.EQ.2) THEN X*--- treat COMMON block names specially X IULOOP=2 X ICOMMB=ILOC(ILPT+1) X NLPT=ILOC(ILPT) X ENDIF X IF(IFLG1.EQ.0) THEN X*--- treat all names the same X ILOW=NLIM1(IPART) X INUP=NLIM2(IPART) X NLOOP=1 X ELSEIF(IFLG1.EQ.1) THEN X*--- different types for first name, and rest X NLOOP=2 X ELSE X*--- special treatment for IMPLICIT statement X CALL SETIMP X*--- update the already existing names except strongly typed X DO 60 I=1,NRNAME X NT=NAMTYP(IRNAME+I) X*--- do not change type of strongly typed function, nor parameter X IF (ITBIT(NT,7).EQ.0.AND.ITBIT(NT,21).EQ.0) THEN X K=ICVAL(SNAMES(IRNAME+I)(1:1)) X NT=NT-MOD(NT,64) X CALL ISBIT(NT,KVTYPE(K)) X NAMTYP(IRNAME+I)=NT X ENDIF X 60 CONTINUE X GOTO 999 X ENDIF X*--- the following IF(...) must stay here because of IMPLICIT X IF (NSNAME.EQ.0.OR.ILOC(2).EQ.0) GOTO 999 X DO 110 ILOOP=IULOOP,NLOOP X IF (IFLG1.NE.0) THEN X IF (ILOOP.EQ.1) THEN X ILOW=NLIM1(IPART) X INUP=NLIM1(IPART) X ELSE X IF(IFLG2.EQ.2) THEN X ILOW=NLIM1(IPART) X ELSE X ILOW=NLIM1(IPART)+1 X ENDIF X INUP=NLIM2(IPART) X ILPT=ILPT+NLPT+1 X ENDIF X ENDIF X NLPT=ILOC(ILPT) X*--- loop over names X DO 100 JN=ILOW,INUP X IF (IFLG2.NE.0) THEN X*--- take only names outside brackets X IF (RANGE(NSSTRT(JN),IWS)) GOTO 100 X ENDIF X*--- check whether already typed in this statement (except COMMON) X IF(IFLG2.LT.2) THEN X DO 70 JL=1,JN-1 X IF (SNAMES(ISNAME+JL).EQ.SNAMES(ISNAME+JN)) THEN X NT=NAMTYP(ISNAME+JL) X IPOS=0 X GOTO 90 X ENDIF X 70 CONTINUE X ENDIF X*--- check against existing routine name table X CALL NAMSRC(SNAMES(ISNAME+JN),SNAMES(IRNAME+1),NRNAME, X + IPOS, LAST) X IF (IPOS.EQ.0) THEN X*--- not yet in table X NT=0 X ELSE X NT=NAMTYP(IRNAME+IPOS) X ENDIF X IF(IFLG2.EQ.2) THEN X*--- common block X*--- look for common block name = /.../ X NFCB=NSSTRT(JN)-1 X STEMP=SSTA(NFCB:NFCB) X IF(STEMP.EQ.' ') THEN X NFCB=NFCB-1 X STEMP=SSTA(NFCB:NFCB) X ENDIF X IF(STEMP.EQ.'/') THEN X NSCB=NSEND(JN)+1 X IF(NSCB.LT.NCHST) THEN X STEMP=SSTA(NSCB:NSCB) X IF(STEMP.EQ.' ') STEMP=SSTA(NSCB+1:NSCB+1) X IF(STEMP.EQ.'/') THEN X NFCB=NFCB-1 X STEMP1=SSTA(NFCB:NFCB) X IF(STEMP1.EQ.' ') STEMP1=SSTA(NFCB-1:NFCB X + -1) X JNL=MAX(JN-1,1) X IF((JN.EQ.1.OR.ITBIT(NAMTYP(ISNAME+JNL), X + ICOMMB).EQ.0).AND.STEMP1.NE.'/') THEN X NT=0 X CALL ISBIT(NT,ICOMMB) X NAMTYP(ISNAME+JN)=NT X GOTO 100 X ENDIF X ENDIF X ENDIF X ENDIF X ENDIF X*--- loop over types (for first, or second, or all) X DO 80 JT=ILPT+1,ILPT+NLPT X ITYP=ILOC(JT) X IF (ITYP.EQ.0) THEN X*--- skip if already typed (REAL, INTEGER, etc.) X IF (MOD(NT,64).NE.0) GOTO 80 X*--- skip if ENTRY in SUBROUTINE X IF(STATUS(14).AND.ISTMDS(6,ICL).EQ.29) GOTO 80 X*--- take default type X ITYP=KVTYPE(ICVAL(SNAMES(ISNAME+JN)(1:1)) ) X X ELSEIF (ITYP.LE.6) THEN X*--- strong typing - reset other types X NT=NT-MOD(NT,64) X ELSEIF (ITYP.EQ.10) THEN X*--- check for statement function declaration (not dimensioned) X IF (ITBIT(NT,18).NE.0) GOTO 80 X*--- no':' allowed in bracket X JLB=INDEX(SSTA(KST:KND),'(')+KST-1 X JRB=INDEX(SSTA(KST:KND),')')+KST-1 X CALL POSCH(':',SSTA,JLB+1,JRB-1,.FALSE.,0,KPOS, X + ILEV) X IF (KPOS.NE.0) GOTO 80 X ELSEIF (ITYP.EQ.17.OR.ITYP.EQ.18) THEN X*--- function (17) or array (18) X* get next non-blank behind name X IF (NSEND(JN).EQ.KND) GOTO 80 X CALL GETNBL(SSTA(NSEND(JN)+1:KND),STEMP,NN) X IF (NN.EQ.0.OR.STEMP.NE.'(')GOTO 80 X IF (ITYP.EQ.17) THEN X*--- only function if not dimensioned X IF (ITBIT(NT,18).NE.0) GOTO 80 X*--- should not be statement function X IF (ITBIT(NT,10).NE.0) GOTO 80 X*--- no ':' allowed on zero level in bracket following X JLB=NSEND(JN)+INDEX(SSTA(NSEND(JN)+1:KND),'(') X CALL SKIPLV(SSTA,JLB+1,KND,.FALSE.,JRB,ILEV) X CALL POSCH(':',SSTA,JLB+1,JRB-1,.FALSE.,0,KPOS, X + ILEV ) X IF (KPOS.NE.0) GOTO 80 X ENDIF X ENDIF X*--- type is accepted for this variable - set X CALL ISBIT(NT,ITYP) X 80 CONTINUE X 90 CONTINUE X NAMTYP(ISNAME+JN)=NT X IF (IPOS.GT.0) THEN X NAMTYP(IRNAME+IPOS)=NT X ENDIF X 100 CONTINUE X 110 CONTINUE X 120 CONTINUE X 999 END / echo 'x - TYPDEF.h' sed 's/^X//' > TYPDEF.h << '/' X COMMON/TYPDEF/KVTYPE(26) X*IF DEF,NEVER X*----------------------------------------------------------------------- X* X* KVTYPE(I) current default type for starting character no. I X*----------------------------------------------------------------------- X*EI / echo 'x - floppy.helpcms' sed 's/^X//' > floppy.helpcms << '/' X.cm CAT:CMS X.cm NAM:FLOPPY X.cm EXP: Fortran Coding Convention Checker X.cm DAT: 87.09.20 X.cm A/R: J.J.Bunn X.cm KEY: FLOP TREE TIDY CONVENTION RULE FORTRAN X.cm ABS: A program which checks a Fortran program against X.cm ABS: a pre-defined set of coding conventions. X.cm ABS: Options to tidy the source Fortran and to write X.cm ABS: an input file for FLOW (a separate utility) are X.cm ABS: provided. X.cm FLG: LOCAL X.cm END: X X XFLOPPY (Coding Convention Checker) X X XFLOPPY is used to check that a body of Fortran code complies with a set Xof coding conventions. This is done by parsing the Fortran using FLOP X(see DD/US/13 Flop User's Guide by H.Grote) and then analysing the Xstructure against the specified set of instructions. XIn addition, FLOPPY may be used to 'tidy' the source Fortran, in other Xwords to indent the DO/IF clauses, renumber the statement labels, and so XIt may also be used to produce an analysis file which is interpreted late Xby the TREE utility (type HELP TREE for details). The TREE utility is Xcapable of giving a graphical representation of the subroutine calling Xtree in the source Fortran, as well as for analysing the usage of COMMON Xblock variables. X XFLOPPY is used as follows: X X+--------+--------------------------------------------------------------+ X| | | X| FLOPPY | [ ? | fn [ft [fm]] [( Options ]] | X| | | X| | Options: | X| | | X| | [CHECKS {STANDARD|NONE|ALEPH|GALEPH|ONLINE|LIST|number_list}]| X| | [DISK] | X| | [FULL] | X| | [GOTOS] | X| | [GROUPF] | X| | [IGNORE] | X| | [INDENT spaces] | X| | [OLD fn ft fm] | X| | [OUTPUT fn ft fm] | X| | [RENUMF start_value[,step_value]] | X| | [RENUMS start_value[,step_value]] | X| | [TIDY] | X| | [TREE] | X+--------+--------------------------------------------------------------+ X Xwhere: X X When FLOPPY is entered without any parameters a panel will be X displayed in which details of the Floppy job may be entered. X X? If this is the only operand this HELP file will be displayed. X XFn Ft Fm The file name of the Fortran on which Floppy is to operate. X XCHECKS STANDARD The standard set of coding conventions are checked X These are the ones marked by a (*) in the list X below (in Usage Notes). X X NONE No coding conventions will be checked. This option X is useful with the TREE option. X X LIST The user will be prompted for a list of those X coding conventions he wishes to check. X X ALEPH Specifies that the set of conventions is that X agreed on by the Aleph Offline Group. X X GALEPH Specifies that the set of conventions is as for X the ALEPH qualifier, but additionally all names X beginning G..... or IG.... will be ignored. X X ONLINE This qualifier is not yet implemented. X X number_list Numbers should correspond to the numbers in the X list given below. Specifying 99 indicates that X all the checks are to be made. Specifying a X negative number means that the corresponding X convention will not be checked. So for example X CHECKS 99,-1,-20 will cause all conventions X except 1 and 20 to be checked. X XDISK Inclusion of this option causes the output from Floppy to be X written to a file. X XFULL Specifying this option causes Floppy to print all source Fortra X statements, instead of just those in breach of the coding X conventions checked (which is the default). X XGOTOS Inclusion of this option causes the GOTO statements in the sour X Fortran to be right adjusted in the new Fortran file. X XGROUPF Causes all FORMAT statements that appear in each subroutine to X grouped at the end of the subroutine in the new Fortran file. X XIGNORE If this option is invoked, then the user will be prompted for a X list of variable and/or subroutine/function names which he woul X like to be ignored when Floppy checks the coding conventions. X This is particularly useful when Floppy is run on external code X containing names over which the user has no control, for exampl X HBOOK calls. X XINDENT Inclusion of this option causes all DO and IF clauses to be X indented by nn spaces, according to their level of nesting. X XOLD The file name given with this qualifier should refer to an X existing 'FLOPIGN' file, created by a previous Floppy run. X The FLOPIGN file contains the list of coding convention numbers X together with a list of any specified names to be ignored, and X is created automatically when Floppy is run. Specify this X option if you have a particularly complex Floppy environment X that you do not want to re-create each Floppy run. X XOUTPUT The file name given with this option will be the file to X which the 'tidied' Fortran is written. By default this file X has the name 'OUTPUT FORTRAN A'. X XRENUMF Specifying this option together with a value for START and STEP X will cause all FORMAT statements to be renumbered, beginning at X value START and stepping by STEP. X XRENUMS Specifying this option together with a value for START and STEP X will cause ALL statements to be renumbered, beginning at X value START and stepping by STEP. X XTIDY This option is automatically selected when any of GOTOS, INDENT X GROUPF, RENUMF, RENUMS are selected on the command line. X XTREE Specifying this option causes an analysis file to be written X which may be used as input to the TREE utility. If all the user X requires from Floppy is this analysis file, then he should X specify CHECKS NONE, to avoid Floppy wasting time making any X coding convention checks. X X XUsage Notes X X Here follows the list of coding conventions which may at present X be checked by Floppy. The conventions in the STANDARD set are X marked by an asterisk (*). X X * 1 Avoid comment lines after end of module X * 2 End all program modules with the END statement X * 3 Declared COMMON blocks must be used in the module X * 4 COMPLEX and DOUBLEPRECISION vars at end of COMMON X * 5 COMMON block definitions should not change X * 6 Variable names should be 6 or fewer characters long X 7 Variables in COMMON should be 6 characters long X 8 Variables not in COMMON should be <6 characters X * 9 Integer variables should begin with I to N X * 10 Variable names should not equal FORTRAN keywords X * 11 Avoid comment lines before module declaration X * 12 Module names should not equal intrinsic functions X * 13 First statement in a module should be declaration X * 14 Module should begin with at least 3 comment lines X 15 Comment lines should begin with a C X * 16 No comment lines between continuations X * 17 Avoid non-standard variable types eg INTEGER*2 X * 18 Avoid multiple COMMON definitions per line X * 19 Do not dimension COMMON variables outside COMMON X * 20 Avoid embedded blanks in variable names X * 21 Avoid embedded blanks in syntactic entities X * 22 Avoid the use of PRINT statements (use WRITE) X 23 Do not give the END statement a label X * 24 Avoid WRITE(* construction X 25 Avoid WRITE statement in a FUNCTION X * 26 Avoid the use of PAUSE statements X * 27 Statement labels should not begin in column 1 X * 28 Always precede STOP by a descriptive WRITE X * 29 Avoid the use of ENTRY in FUNCTIONS X * 30 Avoid using I/O in FUNCTIONs X 31 Avoid the use of the alternate RETURN statement X * 32 COMMON block names should not equal variable names X * 33 Avoid use of obsolete CERN library routines X 34 Avoid FUNCTION names the same as intrinsics X * 35 Local functions should be declared EXTERNAL X * 36 Module names should all be different X * 37 Avoid expressions of mixed mode eg A=B/I X * 38 Length of passed CHARACTER variables should be * X * 39 Order of statements should conform to note X * 40 Separate Statement Functions by comment lines X * 41 No names in Statement Function definitions elsewhere X 42 Use LLT,LGT etc to compare CHARACTER vars. in IFs X 43 Variables (not COMMON, not PARAMs) <6 characters X * 44 Passed arguments should be dimensioned * in module / echo 'x - floppy.vmshlp' sed 's/^X//' > floppy.vmshlp << '/' X1 FLOPPY X X Floppy is a program which checks that an input file of Fortran X code complies with a set of coding conventions. X X There is a "FLOPPY User Guide" DD/US/112 available in the UCO, X Batiment 512, Tel. 4952. X X FLOPPY can also produce output for the FLOW program, a tool X which analyses the structure of Fortran code. Type HELP FLOW X for details. X X There are some extra features which are described below. X X For problems with FLOPPY or FLOW contact VXCERN::JULIAN (Tel.5029) X X Format: X X FLOPPY [filename] X X NB Floppy uses FLOP (DD/US/13 Flop User's Guide by H.Grote) X to parse the source Fortran. X2 Parameters X X filename X X Specifies the name of the input file of FORTRAN upon which the X coding convention checks are to be made. The code must be X standard FORTRAN 77, and must have compiled without errors, X otherwise the results from using FLOPPY will be unreliable. X X You may use wild-cards in the filename; if more than one file X is found matching the specification, then the files will be X internally concatenated. X X Note that non-standard constructs such as INCLUDE statements X will be treated as illegal statements by FLOPPY, and ignored. X X If you are using FLOPPY to tidy your Fortran (see /TIDY option), X then 'filename' may be for instance an EDITF.DAT extracted X with HISTORIAN option S, or likewise may be a file where the X COMMON block declarations are hidden in INCLUDE statements. This X will not jeopardize the indentation of DO loops and IF clauses, X nor the re-numbering of statement labels. X X2 Qualifiers X/CHECKS X X /CHECKS[=(n[,.....])] X /NOCHECKS X X Define the coding convention checks to be made. X X If no list is given, then the checks marked by a '*' X in the list below are made. X X If n=99 then all checks are made X X If /NOCHECKS is specified then no checks are made. X X If n is negative, then check number n is not made. X X Thus to make all the checks except numbers 3 and 31, X specify /CHECKS=(99,-3,-31). See the Examples. X X The coding convention numbering (n) is as follows: X X * Check no. 1 Avoid comment lines after end of module X * Check no. 2 End all program modules with the END statement X * Check no. 3 Declared COMMON blocks must be used in the module X * Check no. 4 COMPLEX and DOUBLEPRECISION vars at end of COMMON X * Check no. 5 COMMON block definitions should not change X * Check no. 6 Variable names should be 6 or less characters long X Check no. 7 Variables in COMMON should be 6 characters long X Check no. 8 Variables not in COMMON should be <6 characters X * Check no. 9 Integer variables should begin with I to N X * Check no. 10 Variable names should not equal FORTRAN keywords X * Check no. 11 Avoid comment lines before module declaration X * Check no. 12 Module names should not equal intrinsic functions X * Check no. 13 First statement in a module should be declaration X * Check no. 14 Module should begin with at least 3 comment lines X Check no. 15 Comment lines should begin with a C X * Check no. 16 No comment lines between continuations X * Check no. 17 Avoid non-standard variable types eg INTEGER*2 X * Check no. 18 Avoid multiple COMMON definitions per line X * Check no. 19 Do not dimension COMMON variables outside COMMON X * Check no. 20 Avoid embedded blanks in variable names X * Check no. 21 Avoid embedded blanks in syntactic entities X * Check no. 22 Avoid the use of PRINT statements (use WRITE) X Check no. 23 Do not give the END statement a label X * Check no. 24 Avoid WRITE(* construction X Check no. 25 Avoid WRITE statement in a FUNCTION X * Check no. 26 Avoid the use of PAUSE statements X * Check no. 27 Statement labels should not begin in column 1 X * Check no. 28 Always precede STOP by a descriptive WRITE X * Check no. 29 Avoid the use of ENTRY in FUNCTIONS X * Check no. 30 Avoid using I/O in FUNCTIONs X Check no. 31 Avoid the use of the alternate RETURN statement X * Check no. 32 COMMON block names should not equal variable names X * Check no. 33 Avoid use of obsolete CERN library routines X Check no. 34 Avoid FUNCTION names the same as intrinsics X * Check no. 35 Local functions should be declared EXTERNAL X * Check no. 36 Module names should all be different X * Check no. 37 Avoid expressions of mixed mode eg A=B/I X * Check no. 38 Length of passed CHARACTER variables should be * X * Check no. 39 Order of statements should conform to note X * Check no. 40 Separate Statement Functions by comment lines X * Check no. 41 No names in Statement Function definitions elsewhere X Check no. 42 Use LLT,LGT etc to compare CHARACTER vars. in IFs X Check no. 43 Variables (not COMMON, not PARAMs) <6 characters X * Check no. 44 Passed arguments should be dimensioned * in module X X X/TREE X X /TREE X X Cause a summary output file to be produced, containing a packed X description of the source FORTRAN. The summary file contains X such information as the list of all FORTRAN module names, their X arguments, calling list, and so on. The file is unformatted; it X should be used as input to an auxiliary tool called TREE, and X is unreadable at the terminal. X X/OUTPUT X X /OUTPUT[=filename] X X Cause the output from FLOPPY (normally viewed at the terminal) X to be sent to a disk file. If filename is not specified the X output file will have the stem name of the source FORTRAN file, X with an extension of .FLOPLIS . X X/FULL X X /FULL X X Cause all source FORTRAN statements to be output, as opposed to X only those breaking the specified coding conventions. X X/IGNORE X X /IGNORE=(name[,.....]) X X Specify a list of FORTRAN module and variable names to be X ignored when the coding convention checks are made. Specify X module names by preceding the name with a # sign e.g. #MINUIT, X specify variable names normally. X X/SPECIAL X X /SPECIAL[=type] X X Specify that a special version of FLOPPY be used. The default X 'special' version is STANDARD, which causes those checks marked X by a '*' (see /CHECKS) to be implemented. X X STANDARD : Use the standard check set. X ALEPH : Use the standard ALEPH check set. X ONLINE : Use the check set for Online Programs (not yet available). X GALEPH : Variables beginning with G..... or xG.... are ignored. X X Other special versions may be defined on request to the author. X X/LOG X X /LOG X /NOLOG X X Show a summary of the FLOPPY command parsing, or not. X X/OLD X X /OLD[=filename] X X Each time FLOPPY is run, an "IGNORE" file is written with the X user specifications for that particular run. If the /OLD X qualifier is used, one may specify an already existing "IGNORE" X file. If the filename is omitted, then the filename used is X obtained from the stem of the source FORTRAN file and the X extension .FLOPIGN . X X Note that this qualifier does not affect the use of /TIDY X as the FORTRAN tidying parameters are not stored in the "IGNORE" X file. X X X2 /TIDY X X Write a new file of FORTRAN after re-formatting the input X according to the qualifiers specified. X X Format: X X FLOPPY/TIDY [filename] X X The TIDY qualifier must be accompanied by at least one of the X following qualifiers. If all you want to do is TIDY your Fortran, X then use the /NOCHECKS qualifier as well. X X3 Qualifiers X/FORTRAN X X /FORTRAN[=filename] X X Cause the reformatted FORTRAN output to be written on the filename X specified. If no filename is given, then the output Fortran is X written to a file called FORTRAN.FOR . X X/GOTOS X X /GOTOS X X Right adjust all GOTO statements so that they finish in column 72. X X/INDENT X X /INDENT[=n] X X Indent DO and IF clauses by the specified number of spaces. The X default is 3, and if specified, n should be in the range 1 to 5. X X/FORMAT X X /FORMAT[=(START=n,STEP=m)] X X Re-number FORTRAN statements starting at n and stepping by m. X X/GROUPF X X /GROUPF X X Group all FORMAT statements at the bottom of each module in which X they appear. X X/STMNTS X X /STMNTS[=(START=n,STEP=m)] X X Re-number all statements (not FORMATs) starting at n and stepping X by m. X X2 Examples X X $ FLOPPY myfile.for X X Make all the available coding convention checks on the FORTRAN X file myfile.for. X X $ FLOPPY/TREE/NOCHECKS myfile.for X X Produce a TREE output file, and make no checks. X X $ FLOPPY/IGNORE=(FRED,#MICHEL) myfile.for X X Make all the available checks, but ignore the variable called X FRED and the subroutine called MICHEL. X X $ FLOPPY/CHECKS=(1,5,25,3)/FULL myfile.for X X Check conventions 1,3,5 and 25, and list all lines from the X source FORTRAN. X X $ FLOPPY/CHECKS=(99,-1,-2,-20) my*.for X X Check all conventions except numbers 1,2 and 20. Use all files X beginning 'MY' and with filetype .FOR . X X $ FLOPPY/NOLOG/OUT=output.lis myfile.for X X Send the FLOPPY output to a listing file, and disable the command X parsing information. X X $ FLOPPY/NOCHECKS/TIDY/INDENT=2 myfile.for X X Produce a new FORTRAN file with all DO and IF clauses indented by X two spaces. No coding convention checking is done. The new X fortran will be called FORTRAN.FOR. X X $ FLOPPY/TIDY/STMNTS=(START=10,STEP=5)/FORTRAN=out.for myfile.for X X Renumber statements starting at 10 (10, 15, 20 etc.) and write X the new FORTRAN to the file out.for. / echo 'Part 05 of Floppy complete.' exit