VDEFINE and VGET Shared Pool Variables



IBM's Command List programming language & Restructured Extended Executor

VDEFINE and VGET Shared Pool Variables

Postby Quasar » Wed Mar 13, 2013 9:13 pm

Hi everybody,

I am writing a Rexx - script for my mainframe shop. This would be an ISPF Edit-Macro called MINE, which takes one PARM parameter, you can MINE IN or you can MINE OUT. In a Cobol source-program, when the cursor is positioned at a PERFORM <para> statement, a MINE IN is used to jump from calling paragraph to the called paragraph. You can keep MIN'ing in. If you want to back-up and go back to the point from where you'd left off, you can MINE OUT.

During a TSO/ISPF Edit session, an average user would MINE IN and MINE OUT several times, while analysing a source-program. Upon each MINE IN, I would like to record the current-line number and the PERFORM <para-name> into an Application Shared Pool variable, say CALLSTK. I am going to use it like a stack. Next time, when user MINE's out, this information can be used to back-up.

My problem is, when the user first logs on to the Mainframe, the CALLSTK Variable does not exist. So, the VGET CALLSTK SHARED call sets a Return-Code of 08. But, this gets reports as a Syntax Error and Rexx script just stops running. I wanted a way to handle this - if the variable's not defined, VPUT it for the first time.

MINE Utility:
/* REXX - MINE TOOL(FOR COBOL PROGRAMS)                             */
/*__________________________________________________________________*/
/* AUTHOR : C QUASAR. QUASAR.CHUNAWALLA@GMAIL.COM                   */
/*                                                                  */
/* DESCRIPTION :                                                    */
/* -----------                                                      */
/* MINE REFERS TO SOFTWARE MINING AND IS FOR ANALYSIS OF            */
/* COBOL PROGRAMS.                                                  */
/*                                                                  */
/* IT RUNS AS AN EDIT-MACRO. THE <PF2> KEY IS USED TO TRAVERSE      */
/* DOWN FROM THE CALLING TO THE CALLED ROUTINE. THE <PF4> KEY       */
/* IS USED BACK UP. <PF1> KEY HELPS TO GENERATE A CALL GRAPH.       */
/*                                                                  */
/*                         */
/*__________________________________________________________________*/
                                                                       
                                                                       
TRACE ALL                                                             
                                                                       
/* START OF MACRO */                                                   
ADDRESS ISREDIT                                                       
"MACRO (PARM) NOPROCESS"                                               
                                                                       
SIGNAL ON ERROR                                                       
                                                                       
/* ADDRESS ISPEXEC "CONTROL ERRORS RETURN"                          */
                                                                       
/*__________________________________________________________________*/
  MAIN:                                                               
/*-----                                                             */
/* THE MAIN ROUTINE FIRST INITIALIZES THE VARIABLES TO THE DEFAULT  */
/* VALUES. NEXT, IT READS THE LONG VARIABLE PARA_STACK TO DETERMINE */
/* HOW DEEP WE ARE IN THE CALL-TREE. DEPENDING UPON THE PARAMETER   */
/* PASSED, 'IN' OR 'OUT' IT WILL PROCESSING IS PERFORMED. A <PF3>   */
/* KEY-PRESS IS INTERCEPTED AND THE PARA_STACK VARIABLE IS CLEARED. */
/*__________________________________________________________________*/
  CALL INITIALIZATION                                                 
                                                                       
  IF PARM = 'IN' THEN DO                                               
     CALL MINE_IN                                                     
  END                                                                 
                                                                       
  IF PARM = 'OUT' THEN DO                                             
     CALL MINE_OUT                                                     
  END                                                                 
                                                                       
  EXIT                                                                 
                                                                       
/*__________________________________________________________________*/
  INITIALIZATION:                                                     
/*--------------                                                    */
/* THE INITIALIZATION ROUTINE ASSIGNS TO DEFAULT VALUES TO VARIABLES*/
/* THAT ARE USED, EACH TIME THIS EXEC IS INVOKED.                   */
/*__________________________________________________________________*/
                                                                       
  LINENUM = 0                                                         
  LINEDATA = ''                                                       
                                                                       
  RACFID = ''                                                         
  EDIT_DATASET = ''                                                   
  PARAGRAPH = ''                                                       
  LINE_NUMBER = 00                                                     
  PARA_NAME = ''                                                       
  CALLSTK   = ''                                                       
                                                                       
  RETURN                                                               
                                                                       
/*__________________________________________________________________*/
  VGET_CALL_STACK:                                                     
/*--------------                                                    */
/* THIS ROUTINE VGETS THE CALLSTK VARIABLE FROM THE ISPF SHARED     */
/* POOL.                                                            */
/*__________________________________________________________________*/
                                                                       
  ADDRESS ISPEXEC "VGET (CALLSTK) SHARED"                             
                                                                       
  SAY 'VGET : ' CALLSTK                                               
                                                                       
  RETURN                                                               
                                                                       
/*__________________________________________________________________*/
  VPUT_CALL_STACK:                                                     
/*--------------                                                    */
/* THIS ROUTINE VPUTS THE CALLSTK VARIABLE TO   THE ISPF SHARED     */
/* POOL.                                                            */
/*__________________________________________________________________*/
                                                                       
  ADDRESS ISPEXEC                                                     
  "VPUT CALLSTK SHARED";                                               
                                                                       
  SAY 'VPUT : ' CALLSTK                                               
                                                                       
  RETURN                                                               
                                                                       
/*__________________________________________________________________*/
  MINE_IN:                                                             
/*-------                                                           */
/* THIS ROUTINE JUMPS FROM THE CALLING <PARA> TO THE CALLED <PARA>. */
/* IT FIRST ACQUIRES THE LINE-NO, THE PERFORM PARA-NAME, THE RACFID */
/* AND THE CURRENT DATASET NAME AND APPENDS THEM TO THE CALLSTK     */
/* VARIABLE IN THE BASE ISR SHARED POOL.                            */
/* NEXT, IT EXECUTES THE FIND ALL <PARA-NAME> 08 COMMAND TO JUMP    */
/* TO THE CALLED PARAGRAPH.                                         */
/*__________________________________________________________________*/
                                                                       
                                                                       
/* GET THE CURRENT LINE NUMBER, WHERE THE CURSOR IS POSITIONED      */
  ADDRESS ISREDIT                                                     
  "(LINENUM) = LINENUM .ZCSR"                                         
                                                                       
/* GET THE CURRENT LINE DATA                                        */
  ADDRESS ISREDIT                                                     
  "(LINEDATA) = LINE .ZCSR"                                           
                                                                       
/* PARSE THE CURRENT LINE-OF-CODE, TO SEE IF THIS IS A PERFORM      */
  PARSE VAR LINEDATA TAG 8,                                           
                     AREA_A 12,                                       
                     AREA_B 72,                                       
                     COMMENT                                           
                                                                       
                                                                       
                                                                       
/* IF AREA-B STATEMENT CONTAINS THE COBOL KEYWORD PERFORM           */
  IF INDEX(AREA_B,'PERFORM') > 0                                       
  THEN DO                                                             
                                                                       
/* THE TSO-USER RACF-ID - 8 BYTES                                   */
     RACF_ID = USERID()                                               
     RACF_ID = RACF_ID || COPIES(' ',08 - LENGTH(RACF_ID))             
                                                                       
/* THE STATEMENT NUMBER OF PERFORM <PARA> - 08 BYTES                */
     LINE_NUMBER = LINENUM                                             
                                                                       
/* THE COBOL PARAGRAPH NAME - 30 BYTES                              */
     PARSE VAR AREA_B VERB PARAGRAPH .                                 
     PARAGRAPH = PARAGRAPH || COPIES(' ',30 - LENGTH(PARAGRAPH))       
                                                                       
/* THE CURRENT DATASET OPEN IN EDIT MODE - 54 BYTES                 */
     ADDRESS ISREDIT "(CURDSN) = DATASET"                             
     ADDRESS ISREDIT "(MEMBER) = MEMBER"                               
     CURDSN = CURDSN || '(' || MEMBER || ')'                           
     CURDSN = CURDSN || COPIES(' ',54 - LENGTH(CURDSN))               
                                                                       
/* APPEND THE DATA TO END OF THE CALLSTK                            */
     CALL VGET_CALL_STACK                                             
                                                                       
     CALLSTK = CALLSTK || RACFID || LINE_NUMBER,                       
               || PARAGRAPH || CURDSN || '|'                           
                                                                       
     CALL VPUT_CALL_STACK                                               
                                                                       
/* EXECUTE THE FIND ALL <PARA-NAME> 08 COMMAND                      */ 
     ADDRESS ISREDIT "FIND ALL "PARAGRAPH" 08 "                         
                                                                       
  END                                                                   
                                                                       
  RETURN                                                               


Error Output:
     76 *-*       ADDRESS ISPEXEC "VGET (CALLSTK) SHARED"                       
        >>>         "VGET (CALLSTK) SHARED"                                     
        +++ RC(8) +++                                                           
     76 +++       ADDRESS ISPEXEC "VGET (CALLSTK) SHARED"                       
    146 +++      CALL VGET_CALL_STACK                                           
     41 +++   CALL MINE_IN                               
        +++   "ERROR"                                   
 IRX0016I Error running MINE, line 76: Label not found   


Thank you very much and appreciate any help you can provide.
Quasar Chunawala,
Software Engineer, Lives at Borivali, Mumbai
User avatar
Quasar
 
Posts: 102
Joined: Wed Nov 10, 2010 7:11 pm
Location: Borivali, Mumbai
Has thanked: 13 times
Been thanked: 2 times

Re: VDEFINE and VGET Shared Pool Variables

 

Re: VDEFINE and VGET Shared Pool Variables

Postby Akatsukami » Wed Mar 13, 2013 10:35 pm

I recommend that you use CALL ON ERROR rather SIGNAL ON ERROR, determine the source of the error (perhaps through sourceline(sigl)) and, if it be one that should be tolerated as a VGET of a non-existent variable, return zero from the error handler.
"You have sat too long for any good you have been doing lately ... Depart, I say; and let us have done with you. In the name of God, go!" -- what I say to a junior programmer at least once a day

These users thanked the author Akatsukami for the post:
Quasar (Sun Mar 17, 2013 10:54 am)
User avatar
Akatsukami
Global moderator
 
Posts: 1053
Joined: Sat Oct 16, 2010 2:31 am
Location: Bloomington, IL
Has thanked: 6 times
Been thanked: 51 times

Re: VDEFINE and VGET Shared Pool Variables

Postby enrico-sorichetti » Wed Mar 13, 2013 10:40 pm

if You do not check the return code Your REXX script is deemed to fail in the most obnoxious manners :geek:

and when You have to pad, instead of ...
RACF_ID = RACF_ID || COPIES(' ',08 - LENGTH(RACF_ID))

why not use the simpler
RACF_ID = left(RACF_ID, 8, " ")


and also why not use lower and upper case ???
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort

These users thanked the author enrico-sorichetti for the post:
Quasar (Sun Mar 17, 2013 10:55 am)
enrico-sorichetti
Global moderator
 
Posts: 2644
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 130 times

Re: VDEFINE and VGET Shared Pool Variables

Postby Pedro » Thu Mar 14, 2013 1:59 am

Can you temporarily disable your recovery routine, something like this:
SIGNAL OFF ERROR
"VGET (CALLSTK) SHARED"
SIGNAL ON ERROR

And then have code to handle the RC=8.
Pedro Vera

These users thanked the author Pedro for the post:
Quasar (Sun Mar 17, 2013 10:55 am)
User avatar
Pedro
 
Posts: 569
Joined: Thu Jul 31, 2008 9:59 pm
Location: Silicon Valley
Has thanked: 0 time
Been thanked: 39 times

Re: VDEFINE and VGET Shared Pool Variables

Postby Mickeydusaor » Fri Mar 15, 2013 12:02 am

Use the PROFILE pool, if you do not then you can not have more than one user using the REXX at a time.
User avatar
Mickeydusaor
 
Posts: 29
Joined: Fri Feb 24, 2012 11:24 pm
Has thanked: 1 time
Been thanked: 0 time

Re: VDEFINE and VGET Shared Pool Variables

Postby enrico-sorichetti » Fri Mar 15, 2013 12:13 am

Use the PROFILE pool, if you do not then you can not have more than one user using the REXX at a time.
:shock:
if it were true zillions of lines of REXX code should be flushed down the toilet :geek:

see here for the SHARED stuff
http://publib.boulder.ibm.com/infocente ... dg8050.htm

and here for the PROFILE stuff
http://publib.boulder.ibm.com/infocente ... dg8050.htm
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico-sorichetti
Global moderator
 
Posts: 2644
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 130 times

Re: VDEFINE and VGET Shared Pool Variables

Postby Pedro » Fri Mar 15, 2013 6:16 pm

Use the PROFILE pool, if you do not then you can not have more than one user using the REXX at a time.

Can you elaborate?
Pedro Vera
User avatar
Pedro
 
Posts: 569
Joined: Thu Jul 31, 2008 9:59 pm
Location: Silicon Valley
Has thanked: 0 time
Been thanked: 39 times

Re: VDEFINE and VGET Shared Pool Variables

Postby prino » Fri Mar 15, 2013 6:50 pm

Pedro wrote:
Use the PROFILE pool, if you do not then you can not have more than one user using the REXX at a time.

Can you elaborate?

Don't feed the trolls!
Robert AH Prins
robert.ah.prins @ the.17+Gb.Google thingy
User avatar
prino
 
Posts: 536
Joined: Wed Mar 11, 2009 12:22 am
Location: Oostende, Belgium
Has thanked: 3 times
Been thanked: 21 times

Re: VDEFINE and VGET Shared Pool Variables

Postby Quasar » Sun Mar 17, 2013 10:13 am

Hi all,

Thanks Akatsukami, Prino and everyone else on the thread for your replies. I removed the SIGNAL ON ERROR and handled the RC 08, if the VGET variable is not defined. Here's the modified version of the code. I am thinking of uploading my tool called MINE on CBTTAPE.

/* REXX - MINE TOOL(FOR COBOL PROGRAMS)                             */
/*__________________________________________________________________*/
/* AUTHOR : C QUASAR. QUASAR.CHUNAWALLA@GMAIL.COM                   */
/*                                                                  */
/* DESCRIPTION :                                                    */
/* -----------                                                      */
/* MINE REFERS TO SOFTWARE MINING AND IS FOR ANALYSIS OF            */
/* COBOL PROGRAMS.                                                  */
/*                                                                  */
/* IT RUNS AS AN EDIT-MACRO. THE <PF2> KEY IS USED TO TRAVERSE      */
/* DOWN FROM THE CALLING TO THE CALLED ROUTINE. THE <PF4> KEY       */
/* IS USED BACK UP. <PF1> KEY HELPS TO GENERATE A STRUCTURE CHART.  */
/*                                                                  */
/*                     */
/*__________________________________________________________________*/


/* START OF MACRO */
ADDRESS ISREDIT
"MACRO (PARM) NOPROCESS"

ADDRESS ISPEXEC "CONTROL ERRORS RETURN"

/*__________________________________________________________________*/
  MAIN:
/*-----                                                             */
/* THE MAIN ROUTINE FIRST INITIALIZES THE VARIABLES TO THE DEFAULT  */
/* VALUES. NEXT, IT READS THE LONG VARIABLE PARA_STACK TO DETERMINE */
/* HOW DEEP WE ARE IN THE CALL-TREE. DEPENDING UPON THE PARAMETER   */
/* PASSED, 'IN' OR 'OUT' IT WILL PROCESSING IS PERFORMED. A <PF3>   */
/* KEY-PRESS IS INTERCEPTED AND THE PARA_STACK VARIABLE IS CLEARED. */
/*__________________________________________________________________*/

  CALL INITIALIZATION

  IF PARM = 'IN' THEN DO
     CALL MINE_IN
  END

  IF PARM = 'OUT' THEN DO
     CALL MINE_OUT
  END

  IF PARM = 'GRAPH' THEN DO
     CALL GEN_FLOW_GRAPH
  END

  EXIT

/*__________________________________________________________________*/
  INITIALIZATION:
/*--------------                                                    */
/* THE INITIALIZATION ROUTINE ASSIGNS TO DEFAULT VALUES TO VARIABLES*/
/* THAT ARE USED, EACH TIME THIS EXEC IS INVOKED.                   */
/*__________________________________________________________________*/

  LINENUM = 0
  LINEDATA = ''
  SCREEN_NO = 00
  RACFID = ''
  EDIT_DATASET = ''
  PARAGRAPH = ''
  LINE_NUMBER = 00
  PARA_NAME = ''
  PARA_LIST.0 = 0
  PARA_LIST. = ''
  PARA_IDX = 0
  N = 0
  GRAPH. = 0
  GRAPH_PARA = ''
  CALLER_LIST.0 = 0
  CALLER_LIST.  = ''
  CALLED_LIST.0 = 0
  CALLED_LIST.  = ''
  GRAPH_PARA    = ''
  SHAD_CALLER_LIST.0 = 0
  SHAD_CALLER_LIST.  = ''
  SHAD_CALLED_LIST.0 = 0
  SHAD_CALLED_LIST.  = ''
  CALLER_CONNECTOR.0 = 0
  CALLER_CONNECTOR.  =''
  CALLED_CONNECTOR.0 = 0
  CALLED_CONNECTOR.  =''

  RETURN

/*__________________________________________________________________*/
  VGET_CALL_STACK:
/*--------------                                                    */
/* THIS ROUTINE VGETS THE CALLSTK VARIABLE FROM THE ISPF SHARED     */
/* POOL.                                                            */
/*__________________________________________________________________*/

  ADDRESS ISPEXEC "VGET (CALLSTK) SHARED"

  SAY 'VGET : ' CALLSTK

  RETURN

/*__________________________________________________________________*/
  VPUT_CALL_STACK:
/*--------------                                                    */
/* THIS ROUTINE VPUTS THE CALLSTK VARIABLE TO   THE ISPF SHARED     */
/* POOL.                                                            */
/*__________________________________________________________________*/

  ADDRESS ISPEXEC
  "VPUT CALLSTK SHARED";

  SAY 'VPUT : ' CALLSTK

  RETURN

/*__________________________________________________________________*/
  MINE_IN:
/*-------                                                           */
/* THIS ROUTINE JUMPS FROM THE CALLING <PARA> TO THE CALLED <PARA>. */
/* IT FIRST ACQUIRES THE LINE-NO, THE PERFORM PARA-NAME, THE RACFID */
/* AND THE CURRENT DATASET NAME AND APPENDS THEM TO THE CALLSTK     */
/* VARIABLE IN THE BASE ISR SHARED POOL.                            */
/* NEXT, IT EXECUTES THE FIND ALL <PARA-NAME> 08 COMMAND TO JUMP    */
/* TO THE CALLED PARAGRAPH.                                         */
/*__________________________________________________________________*/


/* GET THE CURRENT LINE NUMBER, WHERE THE CURSOR IS POSITIONED      */
  ADDRESS ISREDIT
  "(LINENUM) = LINENUM .ZCSR"

/* GET THE CURRENT LINE DATA                                        */
  ADDRESS ISREDIT
  "(LINEDATA) = LINE .ZCSR"

/* PARSE THE CURRENT LINE-OF-CODE, TO SEE IF THIS IS A PERFORM      */
  PARSE VAR LINEDATA TAG 8,
                     AREA_A 12,
                     AREA_B 72,
                     COMMENT



/* IF AREA-B STATEMENT CONTAINS THE COBOL KEYWORD PERFORM           */
  IF INDEX(AREA_B,'PERFORM') > 0
  THEN DO

/* THE TSO-USER RACF-ID - 8 BYTES                                   */
     RACF_ID = USERID()
     RACF_ID = RACF_ID || COPIES(' ',08 - LENGTH(RACF_ID))

/* THE STATEMENT NUMBER OF PERFORM <PARA> - 08 BYTES                */
     LINE_NUMBER = LINENUM

/* THE COBOL PARAGRAPH NAME - 30 BYTES                              */
     PARSE VAR AREA_B VERB PARAGRAPH .
     PARAGRAPH = PARAGRAPH || COPIES(' ',30 - LENGTH(PARAGRAPH))

/* THE CURRENT DATASET OPEN IN EDIT MODE - 54 BYTES                 */
     ADDRESS ISREDIT "(CURDSN) = DATASET"
     ADDRESS ISREDIT "(MEMBER) = MEMBER"
     CURDSN = CURDSN || '(' || MEMBER || ')'
     CURDSN = CURDSN || COPIES(' ',54 - LENGTH(CURDSN))

/* THE CURRENT LOGICAL SCREEN                                       */
     ADDRESS ISPEXEC "VGET ZSCREEN SHARED"
     SCREEN_NO = ZSCREEN

/* EXECUTE THE FIND ALL <PARA-NAME> 08 COMMAND                      */
     ADDRESS ISREDIT "FIND ALL "PARAGRAPH" 08 "

/* IF THE FIND <PARA-NAME> COMMAND COMPLETES SUCCESSFULLY           */
     IF RC = 0 THEN DO

/* APPEND THE DATA TO END OF THE CALLSTK                            */
        CALL VGET_CALL_STACK

/* IF YOU'RE MINE'ING FOR THE VERY FIRST TIME IN THE TSO SESSION,   */
/* THE VGET FAILS WITH A RETURN-CODE 08. HENCE INITIALISE THE       */
/* CALLSTK VARIABLE TO SPACES.                                      */
        IF RC > 0  THEN DO
           CALLSTK = ''
        END

        CALLSTK = CALLSTK || RACFID || LINE_NUMBER,
                  || PARAGRAPH || CURDSN || SCREEN_NO || '|'

        CALL VPUT_CALL_STACK

     END
     ELSE DO
        WARNMSG = 'THE <PARA-NAME> ON THE PERFORM STATEMENT COULD',
                  'NOT BE FOUND'
        ADDRESS ISPEXEC
        "ADDPOP"
        "DISPLAY PANEL(MINE01)"
        "REMPOP"
     END
  END

  RETURN

GEN_FLOW_GRAPH:

/* UNDER WHICH PARAGRAPH WAS THE PF1 KEY PRESSED                    */

  ADDRESS ISREDIT "FIND PREV P' #' 07"
  ADDRESS ISREDIT "(LINEDATA) = LINE .ZCSR"

  PARSE VAR LINEDATA TAG 08 GRAPH_PARA '.' .

/* COLLECT THE LIST OF ALL THE PARAGRAPHS IN AN ARRAY.              */
  LBL = 'PD'
  ADDRESS ISREDIT "X ALL 07 '*'"
  ADDRESS ISREDIT "F ALL 'PROCEDURE' 08"
  ADDRESS ISREDIT "X ALL .ZF .ZCSR"
  ADDRESS ISREDIT "UP MAX"

  DO FOREVER
     ADDRESS ISREDIT "F 08 P'^' NX"
     IF RC > 0 THEN DO
        PARA_LIST.0 = PARA_IDX
        ADDRESS ISREDIT "RESET"
        LEAVE
     END
     ELSE DO

/* GET THE CURRENT LINE DATA                                        */
       ADDRESS ISREDIT
       "(LINEDATA) = LINE .ZCSR"

/* PARSE THE CURRENT LINE-OF-CODE, TO SEE IF THIS IS A PERFORM      */
       PARSE VAR LINEDATA TAG 8,
                          AREA_A '.'

       IF INDEX(AREA_A,'EXIT') = 0
       THEN DO
          PARA_IDX = PARA_IDX + 1
          PARA_LIST.PARA_IDX = AREA_A

       END
     END
  END

  N = PARA_IDX

/* BUILD THE FLOW GRAPH - IT WILL BE A N X N MATRIX                 */
/* FIRST WE SHALL INITIALIZE THE MATRIX                             */
  DO X = 1 TO N
     DO Y = 1 TO N
        GRAPH.X.Y = 0
     END
  END

  DO PARA_IDX = 1 TO N

/* POSITION THE CURSOR AT THE PARA                                  */
     ADDRESS ISREDIT "F ALL "PARA_LIST.PARA_IDX" 08"
     ADDRESS ISREDIT "(LINENUM) = LINENUM .ZCSR"
     ADDRESS ISREDIT "(LASTLIN) = LINENUM .ZLAST"
     SAY 'PARA:' PARA_LIST.PARA_IDX

/* READ ALL THE LINES IN THIS PARAGRAPH TILL THE END-OF-PARA        */
     DO FOREVER

/* QUERY THE LINE-NUMBER                                            */
        LINENUM = LINENUM + 1
        ADDRESS ISREDIT  "(LINEDATA) = LINE "LINENUM""

        PARSE VAR LINEDATA TAG 8,
                           AREA_A 12,
                           AREA_B 72,
                           COMMENT

        IF (AREA_A  > '') | (LINENUM > LASTLIN) THEN DO
           LEAVE
        END

        SAY 'AREA_B : ' AREA_B

/* IF A PERFORM STATEMENT IS FOUND ON THIS LINE                     */
        IF INDEX(AREA_B,'PERFORM') > 0   DO
        THEN DO
           PARSE VAR AREA_B VERB PARAGRAPH
           IF PARAGRAPH = 'VARYING' | PARAGRAPH = 'UNTIL' THEN DO
              ITERATE
           END
           ELSE DO
              SAY 'PARA-FOUND : ' PARAGRAPH
              X = PARA_IDX
/* SEARCH THIS PARAGRAPH NAME IN THE PARA_LIST                      */
              DO Y = 1 TO N
                 IF PARA_LIST.Y = PARAGRAPH THEN DO
                    SAY 'X:' X ' Y:' Y
/* THERE SHOULD BE AN EDGE FROM X TO Y                              */
                    GRAPH.X.Y = 1

                 END
              END
           END
        END
     END

  END

  DO X = 1 TO N
     DO Y = 1 TO N
        SAY 'GRAPH(' X ',' Y ')' GRAPH.X.Y
     END
  END

/* FIND OUT ALL EDGES LEADING INTO THE GRAPH_PARA - CALLER_LIST     */

  DO Y = 1 TO N
     IF PARA_LIST.Y = GRAPH_PARA THEN DO
        LEAVE
     END
  END

  I = 0
  DO X = 1 TO N
     IF GRAPH.X.Y = 1 THEN DO
        I = I + 1
        CALLER_LIST.I = PARA_LIST.X
        SAY 'CALLER_LIST.' I ' = ' CALLER_LIST.I
     END
  END

  X = Y
/* FIND OUT ALL EDGES GOING OUT OF THE GRAPH_PARA - CALLED_LIST     */
  I = 0
  DO Y = 1 TO N
     IF GRAPH.X.Y = 1 THEN DO
        I = I + 1
        CALLED_LIST.I = PARA_LIST.Y
        SAY 'CALLED_LIST.' I ' = ' CALLED_LIST.I
     END
  END

/* BUILD THE CONNECTOR ARRAY                                        */
  IF CALLER_LIST.1 > '' THEN DO
     CALLER_CONNECTOR.1 = '-----'
  END
  ELSE DO
     CALLER_CONNECTOR.1 = COPIES(' ',05)
  END

  J = 1
  DO J = 02 TO 05
     I = (J - 1)*2
     IF CALLER_LIST.J > '' THEN DO
        CALLER_CONNECTOR.I = '  |  '
        I = I + 1
        CALLER_CONNECTOR.I = '--+  '
     END
     ELSE DO
        CALLER_CONNECTOR.I = '     '
        I = I + 1
        CALLER_CONNECTOR.I = '     '
     END
  END

  IF CALLED_LIST.1 > '' THEN DO
     CALLED_CONNECTOR.1 = '-----'
  END
  ELSE DO
     CALLED_CONNECTOR.1 = COPIES(' ',05)
  END

  J = 1
  DO J = 02 TO 05
     I = (J - 1)*2
     IF CALLED_LIST.J > '' THEN DO
        CALLED_CONNECTOR.I = '  |  '
        I = I + 1
        CALLED_CONNECTOR.I = '  +--'
     END
     ELSE DO
        CALLED_CONNECTOR.I = COPIES(' ',05)
        I = I + 1
        CALLED_CONNECTOR.I = COPIES(' ',05)
     END
  END

/* BUILD THE DYNAMIC AREA                                           */

  DO I = 1 TO 05
     CALLER_LIST.I = SUBSTR(CALLER_LIST.I,1,20)
     CALLED_LIST.I = SUBSTR(CALLED_LIST.I,1,20)
     CALLER_LIST.I = LEFT(CALLER_LIST.I,20)
     CALLED_LIST.I = LEFT(CALLED_LIST.I,20)


     IF CALLER_LIST.I > '' THEN DO
        SHAD_CALLER_LIST.I = COPIES('Y',20)
     END
     ELSE DO
        SHAD_CALLER_LIST.I = COPIES(' ',20)
     END

     IF CALLED_LIST.I > '' THEN DO
        SHAD_CALLED_LIST.I = COPIES('Y',20)
     END
     ELSE DO
        SHAD_CALLED_LIST.I = COPIES(' ',20)
     END
  END

  GRAPH_PARA = SUBSTR(GRAPH_PARA,1,20)
  GRAPH_PARA = LEFT(GRAPH_PARA,20)
  SAY 'CALLED_CONNECTOR 2= ' CALLED_CONNECTOR.2
  SAY 'CALLED_CONNECTOR 3= ' CALLED_CONNECTOR.3

  DYNVAR = ''
  SHADVAR = ''

  DYNVAR = DYNVAR ||,
           CALLER_LIST.1 || CALLER_CONNECTOR.1 || GRAPH_PARA ||,
                            CALLED_CONNECTOR.1 || CALLED_LIST.1 ||,
                            COPIES(' ',05) ||,
           COPIES(' ',20)|| CALLER_CONNECTOR.2 || COPIES(' ',20) ||,
           CALLED_CONNECTOR.2 || COPIES(' ',25),
         ||CALLER_LIST.2  || CALLER_CONNECTOR.3 || COPIES(' ',20) ||,
                             CALLED_CONNECTOR.3 || CALLED_LIST.2 ||,
                             COPIES(' ',05) || ,
           COPIES(' ',20)|| CALLER_CONNECTOR.4 || COPIES(' ',20) ||,
           CALLED_CONNECTOR.4 || COPIES(' ',25),
         ||CALLER_LIST.3  || CALLER_CONNECTOR.5 || COPIES(' ',20) ||,
                             CALLED_CONNECTOR.5 || CALLED_LIST.3 ||,
                             COPIES(' ',05) || ,
           COPIES(' ',20)|| CALLER_CONNECTOR.6 || COPIES(' ',20) ||,
           CALLED_CONNECTOR.6 || COPIES(' ',25),
         ||CALLER_LIST.4  || CALLER_CONNECTOR.7 || COPIES(' ',20) ||,
                             CALLED_CONNECTOR.7 || CALLED_LIST.4 ||,
                             COPIES(' ',05) || ,
           COPIES(' ',20)|| CALLER_CONNECTOR.8 || COPIES(' ',20) ||,
           CALLED_CONNECTOR.8 || COPIES(' ',25),
         ||CALLER_LIST.5  || CALLER_CONNECTOR.9 || COPIES(' ',20) ||,
                             CALLED_CONNECTOR.9 || CALLED_LIST.5 ||,
                             COPIES(' ',05)

  SHADVAR = SHADVAR,
         || SHAD_CALLER_LIST.1 || COPIES(' ',05) || COPIES('Y',20),
                               || COPIES(' ',05) || SHAD_CALLED_LIST.1,
                               || COPIES(' ',05) || COPIES(' ',75),
         ||SHAD_CALLER_LIST.2  || COPIES(' ',05) || COPIES(' ',20),
                               || COPIES(' ',05) || SHAD_CALLED_LIST.2,
                               || COPIES(' ',05) || COPIES(' ',75),
         ||SHAD_CALLER_LIST.3  || COPIES(' ',05) || COPIES(' ',20),
                               || COPIES(' ',05) || SHAD_CALLED_LIST.3,
                               || COPIES(' ',05) || COPIES(' ',75),
         ||SHAD_CALLER_LIST.4  || COPIES(' ',05) || COPIES(' ',20),
                               || COPIES(' ',05) || SHAD_CALLED_LIST.4,
                               || COPIES(' ',05) || COPIES(' ',75),
         ||SHAD_CALLER_LIST.5  || COPIES(' ',05) || COPIES(' ',20),
                               || COPIES(' ',05) || SHAD_CALLED_LIST.5,
                               || COPIES(' ',05)

  ADDRESS ISPEXEC "ADDPOP"
  ADDRESS ISPEXEC "DISPLAY PANEL(DYNAREA)"
  ADDRESS ISPEXEC "REMPOP"

  RETURN


Thank you very much.
Quasar Chunawala,
Software Engineer, Lives at Borivali, Mumbai
User avatar
Quasar
 
Posts: 102
Joined: Wed Nov 10, 2010 7:11 pm
Location: Borivali, Mumbai
Has thanked: 13 times
Been thanked: 2 times


Return to CLIST & REXX

 


  • Related topics
    Replies
    Views
    Last post