indeco.for

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

      SUBROUTINE INDECO
*-----------------------------------------------------------------------
*
* Complete processing of user commands on input.
* The input is received from routine INUSER.
* The output is stored in commons  /FLAGS/, /KEYINP/, and /SKEYNP/
*
*-----------------------------------------------------------------------
      include 'param.h'
      include 'alcaza.h'
      include 'state.h'
      include 'keycom.h'
      include 'flags.h'
      include 'flwork.h'
      include 'class.h'
      include 'condec.h'
*
      DIMENSION NSUBKY(MTOTKY),KSUBKY(MTOTKY),KDEFKY(MTOTKY), KACTKY
     +(MTOTKY),KLISKY(MTOTKY),KKEYLS(MTOTKY),KKEYLG(MTOTKY), KSUBRF
     +(MSUBKY),KSUBIX(MSUBKY),KSUBAC(MSUBKY),KSUBLG(MSUBKY), KSUBLS
     +(MSUBKY),KDEFAU(7,2),IBIT(3)
*   NSUBKY(I) = # of sub-keys of key I
*   KSUBKY(I) = start-1 of sub-key list in KSUBRF
*   KDEFKY(I) = default flag if no sub-key given
*   KACTKY(I) = action flag to be set by key I
*   KLISKY(I) = cumulative 'type of input' indicator:
*               1   integer list given
*               2   name list given
*               4   string list given
*   KKEYLS(I) = for key I, ref. to KDEFAU for numerical default values
*   KKEYLG(I) = for key I, no. of numerical default values in KDEFAU
*   KSUBRF    = ref. list of sub-keys
*   KSUBIX(J) = for sub-key number J, 'type of action' indicator:
*               -2   insert list of non-executable statements
*               -1   insert list of executable statements
*               > 0: p, where p is the position of the first integer
*               behind the sub-key of the integer list (FORMAT=... etc.)
*   KSUBLG(J) = for sub-key number J, no. of words for default values
*   KSUBAC(J) = for sub-key number J, action flag to be set, or zero
*   KSUBLS(J) = for sub-key J, ref. to default integer list
*   KDEFAU(I,J) = for above ref., defaults
*   IBIT      = temporary storage for bits from KLISKY
      CHARACTER*3 STRKEY(MTOTKY),SUBKEY(MSUBKY)
*    STRKEY = list of keys
*   SUBKEY = list of sub-keys
      CHARACTER STEMP*1,STEMP3*3,SLNAM*(MXNMCH)
      DATA STRKEY/'OR;','END','PRI','LIS','OUT','FIR','STA','OPT', 'REP'
     +,'ROU','NAM','STR','CLA'/
      DATA SUBKEY/'CHA','END','FOR','FUL','GLO','ILL','IND','NUM', 'QUO'
     +,'RET','SEP','EXE','NEX','PAR','CHA','PAR','FUL','SEP', 'TYP',
     +'USE','COM','COM','GOT','TRE'/
      DATA NSUBKY/0,0,4,3,4,0,6,5,0,0,0,0,2/
      DATA KSUBKY/0,0,0,4,7,11,11,17,22,22,22,22,22/
      DATA KDEFKY/0,0,5,1,8,0,0,0,0,0,0,0,0/
      DATA KACTKY/0,0,0,0,0,10,13,0,0,16,18,19,17/
      DATA KLISKY/0,0,0,0,0,0,0,0,6,2,2,4,1/
      DATA KKEYLS/6*0,1,6*0/
      DATA KKEYLG/6*0,7,6*0/
      DATA KSUBRF/1,4,6,14,5,11,19,15,16,17,21,2,3,8,10,18,23,24,7,9,
     +20,22,12,13/
      DATA KSUBIX/0,7,3,0,0,0,1,1,2,5,0,-1,-2,8*0,3,2*0/
      DATA KSUBLG/0,7,7,0,0,0,3,7,3,7,11*0,3,2*0/
      DATA KSUBAC/4,0,0,6,2,3,21,0,11,0,1,0,0,5,7,8,9,14,20,22,23,27,
     +28,29/
      DATA KSUBLS/0,0,0,0,0,0,2,0,2,12*0,2,2*0/
*--- in KDEFAU, under 1:
*    defaults for statement numbers(2),formats(2),returns(2),end(1)
*    under 2: defaults for INDFAC (1), and IBLPAD (1)
      DATA KDEFAU/10,10,0,10,0,1,0, 3,1,0,4*0/
 
*
      include 'condat.h'
*--- read all input commands, pre-process, store in SIMA
      CALL INUSER
*--- check for illegal keys
      IPR=0
      DO 20 IS=1,NSTAMM
         STEMP3=SIMA(NFLINE(IS))(1:3)
         DO 10 IC=1,MTOTKY
            IF (STEMP3.EQ.STRKEY(IC)) GOTO 20
   10    CONTINUE
         WRITE (MPUNIT,10020) STEMP3
         IF (IPR.EQ.0)  THEN
            WRITE (MPUNIT,10030) STRKEY
            IPR=1
         ENDIF
   20 CONTINUE
*--- start decoding
      NKEY=0
*--- loop over global (IORSET=0) and local keys
      DO 160 IORSET=0,NORSET
         IF (IORSET.EQ.0)  THEN
            ILOW=3
            IUP=MGLOKY
            I1=1
            I2=NSTAMM
         ELSE
            ILOW=MGLOKY+1
            IUP=MTOTKY
         ENDIF
         DO 150 IKY=ILOW,IUP
            NSINT=0
            NFINT=0
            IF (IORSET.NE.0)  THEN
               I1=NSSTRT(IORSET)
               I2=NSEND(IORSET)
            ENDIF
*--- collect all occurences (either globally, or in this OR-set)
*    of this key
            CALL INEXTR(STRKEY(IKY),I1,I2,NL)
*--- complete key now in SSTA, length NL (characters), cleaned
*    from key-words.
            IF (NL.LT.0) GOTO 150
*--- set bit string for integer list etc.
            N=KLISKY(IKY)
            DO 30 J=3,1,-1
               IBIT(J)=N/2**(J-1)
               N=N-IBIT(J)*2**(J-1)
   30       CONTINUE
*--- count
            IF (IORSET.EQ.0)  THEN
               NGLSET=NGLSET+1
            ELSE
               IF (NORCOM(IORSET).EQ.0) KORCOM(IORSET)=NKEY
               NORCOM(IORSET)=NORCOM(IORSET)+1
            ENDIF
            NKEY=NKEY+1
            KEYREF(NKEY,1)=IKY
*--- set action flags
            IF (KACTKY(IKY).NE.0)  THEN
               ACTION(KACTKY(IKY))=.TRUE.
            ENDIF
*--- defaults for keys
            IF (KKEYLS(IKY).GT.0.AND.KEYREF(NKEY,2).EQ.0)  THEN
               NKS=KKEYLG(IKY)
               KEYREF(NKEY,2)=NKS
               KEYREF(NKEY,3)=NKYINT
               KK=KKEYLS(IKY)
               DO 40 JJ=1,NKS
                  NKYINT=NKYINT+1
                  KEYINT(NKYINT)=KDEFAU(JJ,KK)
   40          CONTINUE
            ENDIF
*--- sub-keys
            NSFD=0
            DO 80 JS=1,NSUBKY(IKY)
               JSC=KSUBKY(IKY)+JS
               JSN=KSUBRF(JSC)
               IF(NL.EQ.0)  THEN
                  IND=0
               ELSE
                  IND=INDEX(SSTA(:NL),SUBKEY(JSN))
               ENDIF
               IF (IND.GT.0)  THEN
*--- sub-key found
                  NSFD=1
                  CALL SKIPTP(2,SSTA,IND,NL,.FALSE.,JPT,ILEV)
                  IF (KSUBIX(JSN).GT.0)  THEN
*--- integers following
                     IF (KEYREF(NKEY,2).EQ.0)  THEN
*--- get length and reserve space
                        NKS=KSUBLG(JSN)
                        KEYREF(NKEY,2)=NKS
                        KEYREF(NKEY,3)=NKYINT
*--- set default values
                        KK=KSUBLS(JSN)
                        DO 50 JJ=1,NKS
                           NKYINT=NKYINT+1
                           KEYINT(NKYINT)=KDEFAU(JJ,KK)
   50                   CONTINUE
                     ENDIF
*--- integer position
                     IPOS=KSUBIX(JSN)
   60                CONTINUE
                     CALL GETNBL(SSTA(JPT+1:NL),STEMP,N)
                     IF(N.GT.0.AND.(STEMP.EQ.'='
     +               .OR.NUMCH(STEMP)))  THEN
*--- next comma position
                        JCOM=JPT+INDEX(SSTA(JPT+1:NL),',')
                        IF(JCOM.EQ.JPT) JCOM=NL
*--- get integer
                        CALL GETINT(SSTA,JPT,JCOM,KFCH,KLCH,NN)
                        IF (KFCH.GT.0) THEN
*--- integer found
                           IF(NN.GT.0) KEYINT(KEYREF(NKEY,3)+IPOS)=NN
                           IPOS=IPOS+1
                           JPT=JCOM
                           IF (IPOS.LE.NKS) GOTO 60
                        ENDIF
                     ENDIF
                  ELSEIF(KSUBIX(JSN).LT.0)  THEN
*--- EXE or NEX, add corresponding classes
                     NTYP=KSUBIX(JSN)+2
*--- collect in IWS first
                     DO 70 JCL=1,NCLASS
                        IF (ISTMDS(11,JCL).EQ.NTYP)  THEN
                           NSINT=NSINT+1
                           IWS(NSINT)=ISTMDS(6,JCL)
                        ENDIF
   70                CONTINUE
                  ENDIF
                  IF (KSUBAC(JSN).GT.0)  THEN
*--- action flag
                     ACTION(KSUBAC(JSN))=.TRUE.
                  ENDIF
               ENDIF
*--- end of sub-key loop
   80       CONTINUE
            IF (NSFD.EQ.0)  THEN
*--- no sub-key found - set default flag if any
               IF (KDEFKY(IKY).GT.0) ACTION(KDEFKY(IKY))=.TRUE.
            ENDIF
*--- get integers if any
            IF (IBIT(1).NE.0)  THEN
               JPT=0
               KADD=0
   90          CONTINUE
               CALL GETINT(SSTA,JPT+1,NL,KFCH,KLCH,NN)
               IF (KFCH.GT.0)  THEN
*--- integer found
                  JPT=KLCH
                  IF (KADD.EQ.0)  THEN
                     NSINT=NSINT+1
                     IWS(NSINT)=NN
                  ELSE
                     NFINT=NFINT+1
                     IWS(KADD+NFINT)=NN
                  ENDIF
                  IF (JPT.LT.NL)  THEN
*--- store those after IF ref. separately
                     IF (SSTA(JPT+1:JPT+1).EQ.'('.AND.KADD.EQ.0.AND.
     +               (ISTMDS(6,IIF).EQ.NN.or.istmds(6,iif+71).eq.nn)) 
     &               THEN
                        KADD=MXKINT
                     ELSEIF (SSTA(JPT+1:JPT+1).EQ.')')  THEN
                        KADD=0
                     ENDIF
                     GOTO 90
                  ENDIF
               ENDIF
*--- store integers (classes),in the following way:
*  # of simple, plus those following, # of classes behind IF,
*  plus those following
               IF (NSINT.GT.0)  THEN
                  KEYREF(NKEY,3)=NKYINT
*--- sort and suppress multiples
                  CALL SORTSP(NSINT,IWS,N)
                  KEYINT(NKYINT+1)=N
                  DO 100 J=1,N
                     KEYINT(NKYINT+J+1)=IWS(J)
  100             CONTINUE
                  CALL SORTSP(NFINT,IWS(MXKINT+1),NN)
                  KEYINT(NKYINT+N+2)=NN
                  DO 110 J=1,NN
                     KEYINT(NKYINT+N+J+2)=IWS(MXKINT+J)
  110             CONTINUE
                  KEYREF(NKEY,2)=N+NN+2
                  NKYINT=NKYINT+KEYREF(NKEY,2)
               ENDIF
            ENDIF
*--- get names if any
            IF (IBIT(2).NE.0)  THEN
               IPT=0
  120          CONTINUE
*--- find name outside string
               CALL GETNAM(SSTA,IPT+1,NL,KFCH,KLCH)
               IF (KFCH.GT.0)  THEN
*--- name found
                  IF (KEYREF(NKEY,4).EQ.0) KEYREF(NKEY,5)=NKYNAM
                  IF (NKYNAM.EQ.MXKNAM)  THEN
                     WRITE (MPUNIT,10000) NKYNAM
                     GOTO 150
                  ENDIF
                  SLNAM='        '
                  SLNAM(:KLCH+1-KFCH)=SSTA(KFCH:KLCH)
                  IPT=KLCH
*--- enter name in table (alphabetic for each key)
                  K=KEYREF(NKEY,5)
                  CALL NAMTAB(SLNAM,SKEYLS(K+1),NKYNAM-K,IPOS)
                  IF (IPOS.GT.0)  THEN
*--- name has been entered in table (otherwise already in)
                     IPOS=IPOS+K
                     DO 130 JJ=1,2
                        DO 130 J=NKYNAM,IPOS,-1
                           KNAMRF(J+1,JJ)=KNAMRF(J,JJ)
  130                CONTINUE
                     NKYNAM=NKYNAM+1
                     KEYREF(NKEY,4)=KEYREF(NKEY,4)+1
                     KNAMRF(IPOS,1)=0
                     KNAMRF(IPOS,2)=0
                  ENDIF
*--- check for string following if any
                  IF (IBIT(3).NE.0)  THEN
                     IF (SSTA(IPT+1:IPT+1).EQ.'{')  THEN
*--- delete string indicator (for string scan later on)
                        SSTA(IPT+1:IPT+1)=' '
                        IND=INDEX(SSTA(IPT+1:NL),'}')
                        IF (IND.GT.2.AND.IPOS.GT.0)  THEN
                           CALL INDECS(IPT+1,IPT+IND,*150)
                           KNAMRF(IPOS,1)=NKYSTR
                        ENDIF
                        IPT=IPT+MAX(IND,1)
                     ENDIF
*--- look for replacement string
                     IF (IPT+2.LT.NL.AND.SSTA(IPT+1:IPT+2).EQ.'={')
     +               THEN
                        IPT=IPT+1
                        SSTA(IPT+1:IPT+1)=' '
                        IND=INDEX(SSTA(IPT+1:NL),'}')
                        IF (IND.GT.2.AND.IPOS.GT.0)  THEN
                           CALL INDECS(IPT+1,IPT+IND,*150)
                           KNAMRF(IPOS,2)=NKYSTR
                           ACTION(15)=.TRUE.
                        ENDIF
                        IPT=IPT+MAX(IND,1)
                     ENDIF
                  ENDIF
                  GOTO 120
               ENDIF
            ENDIF
*--- check for strings to be replaced
            IF (IBIT(3).NE.0)  THEN
               IPT=0
  140          CONTINUE
               IND=INDEX(SSTA(IPT+1:NL),'{')
               IF (IND.GT.0)  THEN
                  IPT=IPT+IND-1
                  IND=INDEX(SSTA(IPT+1:NL),'}')
                  IF (IND.GT.2)  THEN
                     IF (NKYCHR.EQ.MXKNAM)  THEN
                        WRITE (MPUNIT,10010) NKYCHR
                        GOTO 150
                     ENDIF
                     CALL INDECS(IPT+1,IPT+IND,*150)
                     IF (KEYREF(NKEY,6).EQ.0) KEYREF(NKEY,7)=NKYCHR
                     KEYREF(NKEY,6)=KEYREF(NKEY,6)+1
                     NKYCHR=NKYCHR+1
                     KSTREF(NKYCHR,1)=NKYSTR
                  ENDIF
                  IPT=IPT+MAX(IND,1)
*--- look for replacement string
                  IF (IPT+2.LT.NL.AND.SSTA(IPT+1:IPT+2).EQ.'={')  THEN
                     IPT=IPT+1
                     IND=INDEX(SSTA(IPT+1:NL),'}')
                     IF (IND.GT.2)  THEN
                        CALL INDECS(IPT+1,IPT+IND,*150)
                        KSTREF(NKYCHR,2)=NKYSTR
                        ACTION(12)=.TRUE.
                     ENDIF
                     IPT=IPT+MAX(IND,1)
                  ENDIF
                  GOTO 140
               ENDIF
            ENDIF
  150    CONTINUE
  160 CONTINUE
*--- look for indentation multiple request
      INDFAC=0
      IBLPAD=1
      DO 170 I=1,NGLSET
         IF (KEYREF(I,1).EQ.8) GOTO 180
  170 CONTINUE
      GOTO 190
  180 CONTINUE
      IF(KEYREF(I,2).GT.0)  THEN
         IF(ACTION(21))  INDFAC=MIN(5,KEYINT(KEYREF(I,3)+1))
         IF(ACTION(11))  IBLPAD=MIN(10,KEYINT(KEYREF(I,3)+2))
         IF(ACTION(27))  ICBPRT=KEYINT(KEYREF(I,3)+3)
      ENDIF
  190 CONTINUE
      ACTION(25)=ACTION(1)
      ACTION(26)=ACTION(2)
*--- allow flags and options to be set directly
      CALL SETREQ
      ACTION(24)=ACTION(24).OR.ACTION(27).OR.ACTION(29)
      ACTION(27)=ACTION(27).AND..NOT.ACTION(29)
      ACTION(3)=ACTION(3).OR.ACTION(6)
*--- namelist / routine if common block option given, dito type
      ACTION(1)=ACTION(1).OR.ACTION(24)
      ACTION(20)=ACTION(20).OR.ACTION(24)
*--- print flags
      ACTION(5)=ACTION(5).OR.ACTION(6)
      ACTION(4)=ACTION(4).OR.ACTION(5)
10000 FORMAT(/1X,8('*=*='),' WARNING - max. no. of names =', I5,
     +' reached in commands, rest ignored')
10010 FORMAT(/1X,8('*=*='),' WARNING - max. no. of strings =', I5,
     +' reached in commands, rest ignored')
10020 FORMAT(/' *=*=*=*= WARNING - illegal key "',A,'" ignored',/)
10030 FORMAT(/' valid keys are:'/(1X,10A10))
      END