
                                                                31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   1
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0001    ****************************************************************************
0002    * Program Name   :Fdpass2                                                  *
0003    * Author         :Kevin McLaurin (MVRTA)                                   *
0004    * Date Developed :Sep 25, 1990                                             *
0005    * Called By      :Fdtocdd                                                  *
0006    * Calls To       :Clen,Index,Wrpc,Wrst,Wrvl,Wrvr,Chkocc,Fst,Getval,Redrc,  *
0007    *                 Chgdsh,Len.                                              *
0008    * -------------------------------------------------------------------------*
0009    * Purpose: This subroutine reads the FD file to convert to CDD and creates *
0010    * the CDD except for putting the periods (.) in the right places.  Fdpass3 *
0011    * puts the periods in the correct places.                                  *
0012    *--------------------------------------------------------------------------*
0013    *                                Variables                                 *
0014    * var     - A 1000,2 table that contains the data elements that are used in*
0015    *           redefines.    n,1 = the original data element name,            *
0016    *                         n,2 = the redefined name.                        *
0017    * nbm     - Integer that tells where in the input record to start parsing  *
0018    *           it.  It is used to skip line numbers that may be in the record.*
0019    * strs    - Pointer to a character in a string.                            *
0020    * stre    - Pointer to a character in a string.                            *
0021    * pidx    - Index used for the previous records data level and structre    *
0022    *           name.                                                          *
0023    * idx     - Index used for the current records data level and structure    *
0024    *           name.                                                          *
0025    * cs      - Current records data elements structure name.                  *
0026    * ps      - A table of 80 which holds all previous structures.             *
0027    * tp      - Character to store the current record's data type.             *
0028    * siz     - Character to store the current record's data size.             *
0029    * fract   - Character to store the current record's number of fractions.   *
0030    * wsiz    - Character to store the current record's data size such as Quad.*
0031    * pl      - A table of 80 which holds all previous structures data levels. *
0032    * Inline  - The string which holds the input record currently being        *
0033    *           processed.                                                     *
0034    * cbnam   - The character to store the current records 'COBOL NAME IS' data*
0035    *           element.                                                       *
0036    * val     - Character to store the name of the 88 level data name.         *
0037    * vl      - Character to store the level of the redefines.                 *
0038    * STRUCT  - Set to true if the current record begins a new structure.      *
0039    * VARNTS- Set to true if there is a series of redefines.                   *
0040    * VARNT - Set to true if the current record is a redefine.                 *
0041    *                                                                          *
0042    *--------------------------------------------------------------------------*
0043    * Modified By   :                                                          *
0044    * Modified Date :                                                          *
0045    ****************************************************************************
0046    			Subroutine Fdpass2(var,nbm)
0047     
0048            Integer*4 strs,stre,pidx,Clen,Index,idx,nbm,Len,vidx
0049    	Integer*4 ZERO,ONE
0050    	Character cs*55,ps(80)*55,tp*25,siz*3,fract*1,wsiz*25
0051    	Character ost*4,oed*4,dep*32,cbp*80,cl*2,pl(80)*2
0052        	Character Inline*100,cbnam*80,val(25)*50,vl(10)*2
0053            Character COMMENT*1,BSTR*1,ESTR*1,DSTR*1,FD*4
0054    	Character*(*) var(500,2)
0055    	Character PERIOD*1,SPACE*1
0056            Logical   STRUCT,VARNT(10),VARNTS(10),DTR,PL1,BAS,RPG,PASS
0057    	Logical EOF

FDPASS2                                                         31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   2
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0058    	Common /Switches/STRUCT,VARNT,VARNTS,DTR,PL1,BAS,RPG,PASS
0059    	Common /Fil/EOF
0060    	Common /Param/PERIOD,SPACE,ZERO,ONE
0061     
0062    ************************************************************************
0063    *  Define Constants                                                    *
0064    ************************************************************************
0065    	Parameter(COMMENT='*', BSTR='B', ESTR='E', DSTR='D', FD=' FD ')
0066     
0067    ************************************************************************
0068    * Define the output strings.                                           *
0069    ************************************************************************
0070    20   	Format('DEFINE RECORD ' ,A)
0071    21	Format(6x,'DESCRIPTION IS'//8x,'/*        */.')
0072     
0073    ***********************************************************************
0074    *  Major Loop.  Read input file until EOF.                            *
0075    ***********************************************************************
0076    	idx=ONE
0077    	vidx=ONE
0078    	DOWHILE(.not.EOF)
0079    	  Call Redrc(Inline,nbm)
0080    	  If(EOF) goto 8000
0081    	  PASS=.FALSE.
0082     
0083    * **************************************************
0084    * *        If line is a comment then ignore it.    *
0085    * **************************************************
0086    	  If (InLine(1:1).ne. '*') THEN
0087     
0088    *   **************************************************
0089    *   *           If line is FD then use this as       *
0090    *   *           'Record Name'                        *
0091    *   ************************************************** 
0092    200	      ifd=Index(Inline,FD)
0093       	      if(Inline(ifd+2:ifd+2).gt.SPACE) ifd=0 
0094                  If(ifd.gt.ZERO) then
0095                    ifd=ifd+2
0096                    strs=Clen(Inline(ifd:))
0097    		strs=strs+ifd-1
0098                    stre=Index(Inline(strs:),SPACE)
0099    	        stre=stre-1
0100    	        if(Inline(stre:stre).eq.PERIOD)stre=stre-1
0101                    pidx=1
0102                    cs=Inline(strs:stre+strs-1)     
0103    	        Call Chgdsh(cs)
0104     
0105    *	**************************************************
0106    *	*           Write the Record Name to the DDL file*
0107    *	************************************************** 
0108    	        stre=Index(cs,SPACE)
0109    	        stre=stre-1
0110      	        if(cs(stre:stre).eq.PERIOD)stre=stre-1
0111                    if(stre.le.ZERO)stre=Len(cs)
0112                    write (22,20) cs(1:stre)
0113                    write (22,21)
0114    	        ps(pidx)=cs

FDPASS2                                                         31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   3
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0115                  Else
0116     
0117    *   **************************************************
0118    *   *             If line is not FD get its level    *
0119    *   **************************************************
0120    210	      strs=Clen(Inline)
0121                  if(strs.eq.ZERO)strs=strs+1
0122     
0123    *    **************************************************
0124    *    *  If the data element is not an 88 then store   *
0125    *    *  the level and get the data element name.      *
0126    *    **************************************************
0127    220           If((Inline(strs:strs).ge.'0').and.
0128         1           (Inline(strs:strs).lt.'6')) then
0129                     cl=Inline(strs:strs+1)
0130    	         strs=strs+2
0131    	         ost='000'
0132    	         oed='000'
0133     
0134    *    **************************************************
0135    *    *  Check if the string contains an Occurs Clause *
0136    *    **************************************************
0137    	         Call Chkocc(Inline(strs:),ost,oed,dep)
0138     
0139    *    **************************************************
0140    *    *  Check if a new structure is to be started.    *
0141    *    *  This is done if the string does not have a PIC*
0142    *    *  clause in it.                                 *
0143    *    **************************************************
0144    		 Call Fst(Inline(strs:),cs,cbnam)
0145                     if(cl.gt.pl(pidx)) then
0146     
0147    *     **************************************************
0148    *     *  If the current strings level (01..) is GT the *
0149    *     *  previous level, then start the new structure. *
0150    *     **************************************************
0151                         if(STRUCT) then
0152                           if(.not.PASS)
0153         1                   Call Wrvr(cbnam,var,cl,vl,vidx)
0154                           PASS=.FALSE.
0155     
0156    *       **************************************************
0157    *       *  Write the structure name and the 'COBOL NAME  *
0158    *       *  IS' data name.                                *
0159    *       **************************************************
0160                           Call Wrst(cs,BSTR,ost,oed,dep,cbnam)
0161        	               pidx=pidx+1
0162                           pl(pidx)=cl
0163                           ps(pidx)=cs
0164                         endif
0165                       else
0166     
0167    *     **************************************************
0168    *     *  If the current strings level is LT then the   *
0169    *     *  previous level, then End the previous         *
0170    *     *  structure.                                    *
0171    *     **************************************************

FDPASS2                                                         31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   4
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0172    	             if(vl(vidx).gt.cl)then
0173                           if(.not.STRUCT) then
0174                             Call Wrvr(cbnam,var,pl(pidx),vl,vidx)
0175                             PASS=.FALSE.
0176                           endif
0177                         endif
0178     
0179    250                  dowhile(cl.le.pl(pidx))
0180     
0181    *       **************************************************
0182    *       *  Write the structure name and the 'COBOL NAME  *
0183    *       *  IS' data name.                                *
0184    *       **************************************************
0185                           Call Wrst(ps(pidx),ESTR,ost,oed,dep,cbnam)
0186                           If(.not.STRUCT.and.(.not.PASS))
0187         1                 Call Wrvr(cbnam,var,pl(pidx),vl,vidx)
0188                          pidx=pidx-1
0189                         enddo
0190     
0191                         if(STRUCT) then
0192                           if(.not.PASS)Call Wrvr(cbnam,var,cl,vl,vidx)
0193     
0194    *         **************************************************
0195    *         *  Write the structure name and the 'COBOL NAME  *
0196    *         *  IS' data name.                                *
0197    *         **************************************************
0198    270                    Call Wrst(cs,BSTR,ost,oed,dep,cbnam)
0199                           pidx=pidx+1
0200                           pl(pidx)=cl
0201                           ps(pidx)=cs
0202                         endif
0203    		   endif
0204     
0205    *      **************************************************
0206    *      *  If the string is not a new structure, then    *
0207    *      * Write then get the picture clause.             *
0208    *      **************************************************
0209    280              If(.not.STRUCT) then
0210                       if(.not.PASS)Call Wrvr(cbnam,var,cl,vl,vidx)
0211     
0212    *       **************************************************
0213    *       * Check for an 'Occurs'. Write the data elements *
0214    *       * COBOL and CDD name.                            *
0215    *       **************************************************
0216    290	           Call Wrdp(cbnam,cs,ost,oed,dep)
0217     
0218    *       **************************************************
0219    *       * Parse the picture clause.                      *
0220    *       **************************************************
0221    300                Call Getpic(Inline,strs,stre,tp,siz,fract,wsiz,cbp)   
0222     
0223    *       **************************************************
0224    *       * Write the data type, size, and data names.     *
0225    *       **************************************************
0226                       Call Wrpc(tp,siz,fract,wsiz,cbp)
0227                      Endif
0228    	Else

FDPASS2                                                         31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   5
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0229     
0230    *    **************************************************
0231    *    *  If the data level is 88 then parse the string *
0232    *    *  and get the value name and thier values.      *
0233    *    **************************************************
0234    310 	  If(Inline(strs:strs+1).eq.'88') then
0235                Call Fst(Inline(strs+2:),cs,cbnam)
0236    	    Call Getval(Inline(strs:),val,siz,nbm)
0237    	    Call Wrvl(cs,cbnam,val)
0238    	  Endif
0239    	Endif
0240    	endif
0241    	endif
0242     
0243    	ENDO
%FORT-F-OPEDOLOOP, Unclosed DO loop or IF block 
 	in module FDPASS2 at line 78

%FORT-E-ALTRETOMI, Alternate return omitted in SUBROUTINE or ENTRY statement 
 	in module FDPASS2 

%FORT-F-UNDSTALAB, Undefined statement label 
 	[ 8000] in module FDPASS2 at line 80


                                                                31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   6
                                                                31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

0001    1000 	Continue
0002    	
0003     
0004    * **************************************************
0005    * * Write 'End Structure' for any not closed       *
0006    * * before the EOF of the input file.              *
0007    * **************************************************
0008    8000 	Dowhile(pidx.gt.1)
0009    	  PASS=.FALSE.
0010    	  Call Wrst(ps(pidx),ESTR,ost,oed,dep,cbnam)
0011              If(VARNTS(vidx))
0012         1          Call Wrvr(cbnam,var,pl(pidx),vl,vidx)
%FORT-F-LOGVALREQ, Non-logical expression where logical value required 
 	[x))          ] in module FDPASS2$MAIN at line 11

0013    	  pidx=pidx-1
0014    	  if(vidx.gt.ONE)vidx=vidx-1
0015    	Enddo
0016     
0017    	Call Wrst(ps(pidx),DSTR,ost,oed,dep,cbnam)
0018              If(VARNTS(vidx).and.(.not.PASS))
0019         1          Call Wrvr(cbnam,var,pl(pidx),vl,vidx)
%FORT-F-OPENOTPER, Operation not permissible on these data types 
 	[nd.(.not.PASS)] in module FDPASS2$MAIN at line 18

0020    	  if(vidx.gt.ONE)vidx=vidx-1
0021     
0022    	RETURN
%FORT-E-STANOTVAL, Statement not valid in this program unit, statement ignored 
 	[RETURN] in module FDPASS2$MAIN at line 22

0023    	END


COMMAND QUALIFIERS

  FOR/LIST FDPASS2

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS)
  /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE)
  /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX)
  /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN)
  /CONTINUATIONS=19  /NOCROSS_REFERENCE  /NOD_LINES  /NOEXTEND_SOURCE
  /F77  /NOG_FLOATING  /I4  /NOMACHINE_CODE  /OPTIMIZE  /NOPARALLEL
  /NOANALYSIS_DATA
  /NODIAGNOSTICS
  /LIST=DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.LIS;1                                                           
  /OBJECT=DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.OBJ;1                                                           

FDPASS2$MAIN                                                    31-Oct-1990 11:16:32	VAX FORTRAN V5.4-79                 Page   7
01                                                              31-Oct-1990 11:16:25	DEVELOP:[DEVELOP.MIS.SOURCE]FDPASS2.FOR;4   

COMPILATION STATISTICS

  Run Time:           1.10 seconds
  Elapsed Time:       5.24 seconds
  Page Faults:        222
  Dynamic Memory:     372 pages
