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.

0 Comments