Mainframe Utility: BRANCH

Return to Mainframe Utilities Page

Module


ISREDIT MACRO (HELP)
ISPEXEC CONTROL ERRORS RETURN
/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
IF &HELP = &STR(HELP) THEN GOTO HELPSEC
/**********************************************************************
/* UTILITY: BRANCH                                                    *
/* AUTHOR: DAVE LEIGH                                                 *
/* FUNCTION: BRANCH TO PARAGRAPHS/SECTIONS BASED ON PERFORM AND GOTO  *
/*           STATEMENTS.  THIS EDIT MACRO WORKS IN CONJUNCTION WITH   *
/*           EDIT MACRO BRANCHBK WHICH TAKES YOU BACK TO WHERE YOU    *
/*           WERE.                                                    *
/**********************************************************************

/**********************************************************************
/* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED?                  *
/**********************************************************************
ISREDIT (X,Y) = NUMBER
IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN +
    DO
        SET COL1 = 1
        SET COL2 = 66
    END
ELSE +
    DO
        SET COL1 = 7
        SET COL2 = 72
    END

/**********************************************************************
/* IF WE'RE BEFORE THE PROCEDURE DIVISION, JUST GO THERE AND RESET    *
/* THE BRANCH LEVEL TO 0.                                             *
/**********************************************************************
ISREDIT FIND ' PROCEDURE ' &COL1 &EVAL(&COL1 + 10 + 3)
IF &LASTCC > 0 THEN GOTO FIND_VERB

/*** LET'S ONLY LOG THE INITIAL BRANCH! ***/

ISREDIT (LINE,CL) = CURSOR
ISREDIT (X,Y) = DISPLAY_LINES
ISREDIT LABEL &X = .X
ISREDIT LABEL &Y = .Y
ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .X .Y
ISREDIT (GOTO,NULL) = CURSOR
ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .X .Y
ISREDIT (PERFORM,NULL) = CURSOR
ISREDIT FIND FIRST ' EXIT. ' &COL1 &COL2 .X .Y
IF &LASTCC > 0 THEN SET EXIT = &Y
ELSE ISREDIT (EXIT,NULL) = CURSOR
SET X = &LINE
IF &PERFORM > &LINE AND +
   &PERFORM < &EXIT THEN +
    SET X = &PERFORM
IF (&GOTO > &LINE AND +
    &GOTO < &EXIT) AND +
   ((&PERFORM > &LINE AND +
     &GOTO < &PERFORM) OR +
    (&PERFORM = &LINE)) THEN +
    SET X = &GOTO
ISREDIT LOCATE .X
ISREDIT CURSOR = &X 1
SET BCHLVL = &STR(0)
ISPEXEC VPUT BCHLVL SHARED
EXIT

/**********************************************************************
/* LOOK FOR THE PERFORM OR GO TO AND PARSE THE LINE.                  *
/**********************************************************************
FIND_VERB: +
SET TYPE = PERFORM
ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .ZCSR .ZCSR

IF &LASTCC > 0 THEN +
    DO
        SET TYPE = GOTO
        ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .ZCSR .ZCSR
        IF &LASTCC = 0 THEN +
            DO
                ISREDIT FIND NEXT ' TO ' &COL1 &COL2 .ZCSR .ZCSR
                IF &LASTCC = 0 THEN GOTO PARSE_FOR_NAME
            END
        SET ZEDSMSG = &STR("PERFORM"¦"GO TO" MISSING)
        ISPEXEC SETMSG MSG(UTLZ001)
        GOTO FINISH
    END

/**********************************************************************
/* FIND THE NAME OF THE SECTION OR PARAGRAPH TO BRANCH TO.            *
/**********************************************************************
PARSE_FOR_NAME: +
SET ZEDLMSG =
ISREDIT FIND NEXT P'¬' &COL1 &COL2 .ZCSR .ZCSR
IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO +
                                       BE ON THE SAME LINE AS THE +
                                       "&TYPE")
ISREDIT FIND NEXT P' ' &COL1 &COL2 .ZCSR .ZCSR
IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO +
                                       BE ON THE SAME LINE AS THE +
                                       "&TYPE")
ISREDIT FIND NEXT P'¬' &COL1 &COL2 .ZCSR .ZCSR
IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO +
                                       BE ON THE SAME LINE AS THE +
                                       "&TYPE")
ISREDIT (NULL,COLBEGIN) = CURSOR
ISREDIT FIND NEXT P' ' &COL1 &COL2 .ZCSR .ZCSR
IF &LASTCC > 0 THEN SET COLEND = &COL2
ELSE ISREDIT (NULL,COLEND) = CURSOR
SET COLEND = &COLEND - 1

ISREDIT FIND FIRST '.' &COLEND &COLEND .ZCSR .ZCSR
IF &LASTCC = 0 THEN SET COLEND = &COLEND - 1
ISREDIT (VERBLINE) = LINE .ZCSR
SET SECPARA = &SUBSTR(&COLBEGIN:&COLEND,&STR(&VERBLINE))
SET VERBLINE = &SUBSTR(1:&COL2,&STR(&SYSNSUB(1,&VERBLINE)))

/**********************************************************************
/* SAVE THE "VERB" LINE AND THE FIRST "DISPLAYED" LINE                *
/**********************************************************************
ISREDIT (DISPLINE,NULL) = DISPLAY_LINES
ISREDIT (CURRLINE) = LINENUM .ZCSR
SET DISPLINE = &CURRLINE - &DISPLINE - 1

SET TEMPLINE = 0
SET X = 1
ISREDIT FIND FIRST '&STR(&VERBLINE)'
ISREDIT (TEMPLINE) = LINENUM .ZCSR

DO WHILE &TEMPLINE ¬= &CURRLINE
    ISREDIT FIND NEXT '&STR(&VERBLINE)'
    ISREDIT (TEMPLINE) = LINENUM .ZCSR
    SET X = &X + 1
END

SET OCCURANCE = &X

/**********************************************************************
/* IF THE SECTION/PARAGRAPH TO GO TO EXISTS, GO THERE AND SAVE THE    *
/* "RETURN" INFORMATION.                                              *
/**********************************************************************
SET LENSTR = &LENGTH(&STR( &SECPARA))
ISREDIT EXCLUDE ALL P'¬' &COL1
ISREDIT FIND FIRST ' &STR(&SECPARA)' &COL1 &EVAL(&COL1 + &LENSTR + 3) NX
IF &LASTCC = 0 THEN +
    DO
        ISPEXEC VGET BCHLVL SHARED
        SET BCHLVL = &BCHLVL + 1
        SET BCHT&BCHLVL = &DISPLINE
        SET BCHV&BCHLVL = &STR(&VERBLINE)
        SET BCHI&BCHLVL = &OCCURANCE
        ISREDIT (X,Y) = BOUNDS
        ISREDIT (LRECL) = LRECL
        SET BCHB&BCHLVL = &STR(&X &Y &LRECL)
        ISPEXEC VPUT (BCHLVL BCHT&BCHLVL BCHB&BCHLVL +
                      BCHV&BCHLVL BCHI&BCHLVL) SHARED
        ISREDIT (LINE,CL) = CURSOR
        ISREDIT (X,Y) = DISPLAY_LINES
        IF &LINE > &X THEN +
            DO
                ISREDIT LOCATE &LINE
                ISREDIT (X,Y) = DISPLAY_LINES
            END
        ISREDIT LABEL &X = .X
        ISREDIT LABEL &Y = .Y
        ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .X .Y
        ISREDIT (GOTO,NULL) = CURSOR
        ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .X .Y
        ISREDIT (PERFORM,NULL) = CURSOR
        ISREDIT FIND FIRST ' EXIT. ' &COL1 &COL2 .X .Y
        IF &LASTCC > 0 THEN SET EXIT = &Y
        ELSE ISREDIT (EXIT,NULL) = CURSOR
        SET X = &LINE
        IF &PERFORM > &LINE AND +
           &PERFORM < &EXIT THEN +
            SET X = &PERFORM
        IF (&GOTO > &LINE AND +
            &GOTO < &EXIT) AND +
           ((&PERFORM > &LINE AND +
             &GOTO < &PERFORM) OR +
            (&PERFORM = &LINE)) THEN +
            SET X = &GOTO
        ISREDIT RESET EXCLUDED
        ISREDIT LOCATE .X
        ISREDIT CURSOR = &X 1
    END
ELSE +
    DO
        ISREDIT RESET EXCLUDED
        ISREDIT CURSOR = &CURRLINE 1
        ISREDIT LABEL .CURR = .ZCSR
        ISREDIT LOCATE &EVAL(&CURRLINE - &DISPLINE - 1)
        ISREDIT FIND FIRST P'=' .CURR .CURR
        SET ZEDLMSG = &STR(&SECPARA NOT FOUND ¦ SPELLING ? ¦ COPY +
                           MEMBER ?)
        ISPEXEC SETMSG MSG(UTLZ001)
    END


EXIT

HELPSEC: +
WRITE
WRITE         *** HELP FOR EDIT MACRO 'BRANCH' ***
WRITE
WRITE THE BRANCH MACRO IS AN EDIT MACRO WHICH IS EXECUTABLE FROM AN EDIT
WRITE SESSION OF A COBOL OR COBOL2 PROGRAM.
WRITE
WRITE THE BRANCH MACRO WILL ENABLE A USER WHO IS EDITING A COBOL PROGRAM
WRITE TO PLACE THE CURSOR ANYWHERE ON A LINE IN THE SOURCE CODE WHICH
WRITE CONTAINS A 'PERFORM ' OR 'GO TO' STATEMENT.  BY DEFINING SINGLE PF
WRITE KEY WITH THE WORD 'BRANCH' THE KEY CAN BE PRESSED AND THE SCREEN
WRITE WILL BRANCH DIRECTLY TO THE PARAGRAPH NAMED IN THE "PERFORM" OR
WRITE "GO TO" STATEMENT.
WRITE
WRITE UPON ENTERING A COBOL PROGRAM FOR THE FIRST TIME, THE BRANCH PF
WRITE KEY MAY BE PRESSED AND THE CURSOR WILL JUMP DIRECTLY TO THE
WRITE PROCEDURE DIVISION.
WRITE
WRITE ONCE IN THE PROCDEURE DIVISION THE CURSOR SHOULD BE PLACED ON A
WRITE LINE WHICH CONTAINS A PERFORM OR "GO TO" STATEMENT.  IF THERE IS
WRITE NO PERFORM OR "GO TO" STATEMENT, A MESSAGE STATING THAT WILL BE
WRITE DISPLAYED ON THE TOP RIGHT CORNER OF THE SCREEN.
WRITE
WRITE MULTIPLE BRANCHES MAY BE STACKED UP TO A MAXIMUM OF 9999 BRANCHES.
WRITE THIS MEANS THAT A PERSON MAY BRANCH TO SECTION A, SEE A PERFORM
WRITE AND BRANCH TO SECTION B.  ONCE FINISHED WITH B, A BRANCHBK MAY BE
WRITE EXECUTED TO RETURN TO THE PERFORM STATEMENT IN SECTION A.  IF
WRITE DESIRED ANOTHER BRANCHBK MAY BE EXECUTED TO RETURN TO THE
WRITE STATEMENT WHICH PERFORMED SECTION A.
WRITE
WRITE NOTE, EVERYTIME A BRANCH IS MADE TO THE PROCEDURE DIVISION FROM
WRITE SOMEWHERE EARLIER IN THE PROGRAM THE BRANCH COUNTER IS ZEROED OUT
WRITE AND THE COUNTING OF BRANCHES UP TO THE 9999 MAXIMUM BEGINS AGAIN.
WRITE
WRITE IF THERE HAS BEEN NO INITIAL BRANCH EXECUTED, AND BRANCHBK IS
WRITE EXECUTED A MESSAGE STATING 'NO BRANCH BACK POINT' IS DISPLAYED.
WRITE
WRITE         *** END OF HELP *** NO PROCESSING PERFORMED ***
FINISH: +
EXIT
            


Documentation

 This edit macro will allow you to branch to a subroutine by placing your cursor
 on a line with a PERFORM statement and typeing BRANCH on the command line (you
 would probably put the command on an unused pf key).  Then by using the
 BRANCHBK edit macro (probably on another PF key), you could branch back to
 where you were in the edit session.  This combination of edit macros can be
 useful for finding your way through code in a COBOL program without losing your
 place.  It is especially helpful if you don't have a hard copy version to
 reference.            


Leave a Reply

Your email address will not be published. Required fields are marked *