|
midrange.com
One way is to simulate the Bnn Enn marks the compiler does.
There are a number of variants of the following program,
in publications on web sites etc.
I think I coded this one a few years back.
I know it is RPGIII I couldnt be bothered 'IV it, but it
does something like what you want.
Do an OVRDBF RPGSRC yourlib/yourfile mbr(yourmember)
Call pgm parm(' ')
Set up a CL to call it, run the CL from PDM (if you got PDM).
This pgm clobbers the last 3 bytes in the comments column,
so beware. pos(109-111)
It DOES NOT handle free format RPG.
If DOES NOT handle newer OPS codes FOR loops etc.
Perhaps you may like to enhance it.
Of course no warranties are expressed or implied and use this
code at your own risk.
Frank Kolmann
>From: "Venkateshwar Venkataraman" <venkateshwar.raman@wipro.com>
>Is there any way to Indent RPG Code in SEU to check for
>Ifs and Do loops without the help of RPGAlive tool.
>Thanks and regards,
>Venky.
H D
*
FRPGSRC UP F 112 DISK
*
* OP CODES THAT START A SEGMENT (2 character)
E INC2 1 2 2
* OP CODES THAT START A SEGMENT (3 character)
E INC3 1 2 3
* OP CODES THAT END A SEGMENT
E DEC 1 5 5
* convert to uppper case
E OP 5 1
*
IRPGSRC AA 03 18 CC 19 C/
I OR 18 Cc 19 C/
I AA 03 18 CC 19 C+
I OR 18 Cc 19 C+
I AA 01 18 CC 19NC*
I OR 18 Cc 19NC*
I 38 39 OP2
I 38 40 OP3
I 38 42 OP5
I AA 02
*
I DS
I 38 42 OP
I 38 39 OP2
I 38 40 OP3
I 38 42 OP5
*
C *ENTRY PLIST
C PARM RTN 3
* Trap SQL lines
C *IN03 IFEQ '1' 1B
C MOVEA'0000' *IN,50 1
C SETON 01 1
C ENDIF 1E
*
* PROCESS C SPECS
C 01N03 EXSR PROCES
*
C END TAG
*
* If the segment index is not zero then return an error.
CLR EXSR IDXCHK
*
/SPACE 3
CSR PROCES BEGSR
C SETOF 505152
*
* Rather than testing for every varient of IFxx and DOxx I
* test only for the IF or DO. There are two other opcodes that
* also are terminated by an END, CASxx and SELEC. I have
* included these as structured segment groups rather than not
* as it simplifies the code.
*
C EXSR CVTCAS
*
* Beginning Segments
C OP2 LOKUPINC2 50
C N50 OP3 LOKUPINC3 50
* Prevent multiple CAS from triggering a begin segment
C 50 OP3 IFEQ 'CAS' 1B
C OP3SAV ANDEQ'CAS' 1
C SETOF 50 1
C END 1E
C MOVE OP3 OP3SAV 3
* Ending Segments
C OP5 LOKUPDEC 51
C 51 MOVE ' ' OP3SAV
* ELSE
C OP5 COMP 'ELSE ' 52
* Check and reset the segment start for subroutines to zero.
C OP5 CASEQ'BEGSR' BEGSR 1B
C ENDCS 1E
* Increment index for a begin segment
C 50 EXSR INCR
* Decrement index for a segment end.
C 51 EXSR DECR
* WHEN
C OP2 COMP 'WH' 53
*
* Supress the output of segment level zero.
C IDX COMP 0 54
C IDS COMP 0 55
*
CSR ENDSR
*
*
/SPACE 3
CSR CVTCAS BEGSR
C 1 DO 5 X 50 1B
C BITON'1' OP,X 1
C ENDDO 1E
CSR ENDSR
*
/SPACE 3
CSR BEGSR BEGSR
* Check that the BEGIN segments match the END segments.
*
C EXSR IDXCHK
C Z-ADD0 IDX
CSR ENDSR
*
/SPACE 3
CSR IDXCHK BEGSR
* Check that the BEGIN segments match the END segments.
C IDX IFNE 0 1B
C MOVE 'ERR' RTN 1
C END 1E
C ENDSR
*
/SPACE 3
CSR INCR BEGSR
* BUMP A SEGMENT INDEX
C ADD 1 IDX 20
CSR ENDSR
*
/SPACE 3
CSR DECR BEGSR
* DROP A SEGMENT INDEX
* SAVE THE SEGMENT LEVEL ,IT BELONGS TO THE PREVIOUS ONE.
C MOVE IDX IDS 20
C SUB 1 IDX
CSR ENDSR
*
ORPGSRC D 01NLR
O 111 ' '
O 50 111 'B'
O 51 111 'E'
O 52 111 'X'
O 53 111 'W'
O N54 IDX Z 110
O 51N55IDS Z 110
** increment
IF IFxx (If)
DO DO (Do)
** increment
CAS CASxx (Case)
SEL SELEC (Select)
** decrement
END
ENDIF
ENDDO
ENDSL
ENDCS
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
