reform.for

这是一个Linux下的集成开发环境

      SUBROUTINE REFORM
*-----------------------------------------------------------------------
*
*   Re-formats the statement after a change.
*   Modified by JJB to take account of inline comments
*
*---Input
*     SSTA, NCHST, JPLINK
*--- Output
*     SIMA, and NFLINE, NLLINE, NLINES possibly updated.
*
*-----------------------------------------------------------------------
      include 'param.h'
      include 'alcaza.h'
      include 'flags.h'
      include 'cursta.h'
      include 'state.h'
      include 'jobsum.h'
      include 'flwork.h'
      include 'class.h'
*--- RETRY flag for second attempt without indentation if overflow
      LOGICAL RETRY
*--- IUPPER = line fill of SIMA, max. indented statement starts in
*    IMAX+7
      DATA IUPPER/72/, IMAX/30/
      RETRY=.TRUE.
      NMOD=IMODIF(NSTREF)
      I1=NFLINE(NSTREF)
   10 CONTINUE
*--- start of complete statement reformatting
      IF(RETRY)  THEN
*--- get user indentation
         imaxp = imax+6
         if(jplink(i1).ne.0) imaxp = min(7,imaxp,jplink(i1)-1)
         INU=NLBLPS(SIMA(I1),7,imaxp)
         IF(ACTION(21))  THEN
*--- indent corresponding to level (from PROIND)
            INB=6+MIN(IMAX,INDFAC*INDCNT)
*--- return if not modified and indentation correct
            IF (IMODIF(NSTREF).LT.10.AND.INU.EQ.INB) THEN
               DO 20 I=I1+1,NLLINE(NSTREF)
                  IF(NLTYPE(I).EQ.2)  THEN
                     IF(NLBLPS(SIMA(I),7,imaxp).NE.INU) GOTO 30
                  ENDIF
   20          CONTINUE
               GOTO 999
            ENDIF
   30       CONTINUE
            IF(NMOD.LT.10)  NMOD=NMOD+10
         ELSE
            INB=INU
         ENDIF
      ELSE
*--- second pass - try without indentation
         INB=6
      ENDIF
      NEWOUT=0
      INSTR=0
      INTRA=0
      IPTRA=0
      LTRA=0
      LAST=0
   40 CONTINUE
      NEWOUT=NEWOUT+1
*--- start of a new line  (statement number pre-set in PROCES or RENUMB)
      IF(NEWOUT.EQ.20)  THEN
         IF (RETRY)  THEN
            RETRY=.FALSE.
            GOTO 10
         ELSE
            WRITE (MPUNIT,10000)
            CALL FLPRNT(1,'OVERFLOW',NLLINE(NSTREF)-NFLINE(NSTREF)+1,
     +      SIMA(NFLINE(NSTREF)),NDUMMY)
            NSTATC(6)=NSTATC(6)+1
            STATUS(11)=.TRUE.
            GOTO 999
         ENDIF
      ELSEIF(NEWOUT.GT.1)  THEN
         IF(INSTR.GE.0)  THEN
            SNEWST(NEWOUT)(1:6)='     +'
         ELSE
*--- split statement into several at '<'
            SNEWST(NEWOUT)(1:6)='      '
            INSTR=0
         ENDIF
      ENDIF
*--- clear rest of statement
      SNEWST(NEWOUT)(7:MXLINE)=' '
      IF(INSTR.EQ.0)  THEN
*--- outside string
         IPS=INB
      ELSE
         IPS=6
      ENDIF
      IF(IPTRA.LT.LTRA)  THEN
*--- add those items already prepared by call to NXITEM
         L=MIN(IUPPER-IPS,LTRA-IPTRA)
         SNEWST(NEWOUT)(IPS+1:IPS+L)=SSTA(IPTRA+1:IPTRA+L)
         IPTRA=IPTRA+L
         IPS=IPS+L
         IF (IPTRA.LT.LTRA) GOTO 40
      ENDIF
      INSTR=0
      IPT=LAST
   50 CONTINUE
      IF (IPT.EQ.NCHST) GOTO 60
*--- chop into nice little pieces
      CALL NXITEM(SSTA,IPT+1,NCHST,LAST)
      IF(SSTA(IPT+1:IPT+1).EQ.' ')  THEN
         IF (IPS.LT.IUPPER) IPS=IPS+1
         IPT=IPT+1
         IF (IPT.EQ.NCHST) GOTO 60
      ENDIF
      IF(SSTA(IPT+1:IPT+1).EQ.'{')  THEN
         IPTRA=IPT+1
      ELSEIF(SSTA(IPT+1:IPT+1).EQ.'<')  THEN
*--- split statement into several
         IPTRA=LTRA
         INSTR=-1
         GOTO 40
      ELSE
         IPTRA=IPT
      ENDIF
      IF(SSTA(LAST:LAST).EQ.'}')  THEN
         LTRA=LAST-1
      ELSE
         LTRA=LAST
      ENDIF
      L=LTRA-IPTRA
      IF(L.LE.0)  THEN
         IPT=LAST
         GOTO 50
      ENDIF
      IF(L.LE.IUPPER-IPS)  THEN
         SNEWST(NEWOUT)(IPS+1:IPS+L)=SSTA(IPTRA+1:LTRA)
         IPS=IPS+L
         IPT=LAST
         GOTO 50
      ELSE
         IF (L.GT.IUPPER-INB)  THEN
*--- split
            SNEWST(NEWOUT)(IPS+1:IUPPER)=SSTA(IPTRA+1:)
            INSTR=1
            IPTRA=IPTRA+IUPPER-IPS
         ELSE
            INSTR=0
         ENDIF
*--- start a new line
         GOTO 40
      ENDIF
   60 CONTINUE
      IF(ACTION(28))  THEN
*--- right-adjust GOTO statements
         IF(ICURCL(1).EQ.IIF.or.icurcl(1).eq.iif+71) THEN
            ICLE=ISTMDS(6,ICURCL(2))
         ELSE
            ICLE=ISTMDS(6,ICURCL(1))
         ENDIF
         IF(ICLE.EQ.37) THEN
            CALL MATCH('#GOTO@;',1,7,SNEWST(NEWOUT),7,
     +      LASTNB(SNEWST(NEWOUT),7,72), .FALSE.,KPOS,ILEV,NSPEC,
     +      IWS,IWS(1001))
            IF(KPOS.GT.0.AND.KPOS.LT.72) THEN
               DO 70 I=72,7,-1
                  SNEWST(NEWOUT)(I:I)=SNEWST(NEWOUT)(KPOS:KPOS)
                  IF(SNEWST(NEWOUT)(I:I).EQ.'G') GOTO 80
                  KPOS=KPOS-1
   70          CONTINUE
   80          CONTINUE
               SNEWST(NEWOUT)(KPOS:I-1)=' '
            ENDIF
            CALL MATCH('#goto@;',1,7,SNEWST(NEWOUT),7,
     +      LASTNB(SNEWST(NEWOUT),7,72), .FALSE.,KPOS,ILEV,NSPEC,
     +      IWS,IWS(1001))
            IF(KPOS.GT.0.AND.KPOS.LT.72) THEN
               DO 71 I=72,7,-1
                  SNEWST(NEWOUT)(I:I)=SNEWST(NEWOUT)(KPOS:KPOS)
                  IF(SNEWST(NEWOUT)(I:I).EQ.'g') GOTO 81
                  KPOS=KPOS-1
   71          CONTINUE
   81          CONTINUE
               SNEWST(NEWOUT)(KPOS:I-1)=' '
            ENDIF
         ENDIF
      ENDIF
      IMODIF(NSTREF)=NMOD
c
c re-insert any in-line comments that were in the original source lines
c (they will go either in the same column, or to the immediate right of
c of the new line)
c   
      nfl = nfline(nstref)
      do 82 is=nfl,nlline(nstref)
         inout = is-nfl+1
         if(inout.gt.newout) goto 82
         if(jplink(is).eq.0) goto 82
         iposo = max(1+lenocc(snewst(inout)),jplink(is))
         lencom = lenocc(sima(is))-jplink(is)
         snewst(inout)(iposo:iposo+lencom) = sima(is)(jplink(is):)
   82 continue
*--- re-formatted statement now in SNEWST
10000 FORMAT(/' +++++++++ WARNING - re-formatting leads to overflow,
     + statement not changed:')
  999 END