/* Main program */ say add(5,6) exit add: PARSE ARG a,b return a + b say arg()
/* Main program */ say add(5,6) exit add: PARSE ARG a,b return a + b c = add(5,6) say say c
/* Main program */ list.1 = 10 list.1.1 = 11 list.1.2 = 12 say list.1 say list.1.1 say list.1.2 /* add(list.1.1,list.1.2) add: parse arg result say result exit */
/*REXX*/ /* expnd */ /*ISPEXEC "VIEW DATAID("DATID") MEMBER("MEMBR") MACRO(WHATEVER)" */ ADDRESS ISREDIT " MACRO" /* ADDRESS ISREDIT " MACRO (Z) PROCESS" */ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" X = V "ISREDIT (LNE) = LINE .ZCSR" "ISREDIT (LNENUM) = LINENUM .ZCSR" "ISREDIT (R1 C1) = CURSOR" LODLIBSTACK.0 = 0 PVARSTACK.0 = 0 PARMSTACK.0 = 0 PARM_STACK_CNT = 0 CALL RUNTYPESELECT CALL VERIFYRUN IF FIRST_RUN_FLAG = 'TRUE' THEN DO CALL GETSETVAR CALL GETJCLLIB CALL GETPROCSETVAR CALL GETINCLUDEMEM CALL PROCLIBCHECK CALL WRITETOFILE "ISREDIT (LNE) = LINE" LNENUM IF PARM_TYPE = 'TRUE' THEN DO CALL PARMOPENPARA END IF PROC_TYPE = 'TRUE' THEN DO CALL PROCOPENPARA END IF COBOL_TYPE = 'TRUE' THEN DO CALL COBOPENPARA END IF FILE_TYPE = 'TRUE' THEN DO CALL FILEOPENPARA END IF INC_MEM_TYPE = 'TRUE' THEN DO CALL OPENINCMEMPARA END CALL TERMPARA END ELSE DO CALL READJCLDATA CALL GETPROCVARS CALL GETPROCSETVAR CALL FINALPROCVARSET CALL GETINCLUDEMEM "ISREDIT (LNE) = LINE" LNENUM IF PROC_TYPE = 'TRUE' THEN DO "ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE" "EXECIO" PVARSTACK.0 "DISKW PFILE ( STEM PVARSTACK. FINIS" "FREE FI(PFILE)" CALL PROCOPENPARA END IF COBOL_TYPE = 'TRUE' THEN DO CALL COBOPENPARA END IF INC_MEM_TYPE = 'TRUE' THEN DO CALL OPENINCMEMPARA END IF FILE_TYPE = 'TRUE' THEN DO CALL FILEOPENPARA END END EXIT VERIFYRUN: "ISREDIT (RCHK) = LINE" 1 IF COPYBOOK_TYPE = 'TRUE' THEN DO CALL READCPYBKLIB RETURN END FIRST_RUN_FLAG = 'FALSE' PVARFILE = "'TTYA."]]USERID()]]".PVAR.FILE'" SETVARFILE = "'TTYA."]]USERID()]]".SETVAR.FILE'" JNAME = "'TTYA."]]USERID()]]".JNAME.FILE'" PLIB = "'TTYA."]]USERID()]]".PLIB.FILE'" LLIB = "'TTYA."]]USERID()]]".LLIB.FILE'" /* JINCMEM = "'TTYA.SUNNY.JINC.FILE'" */ PARSE VAR RCHK '//' JOBNAME ' JOB ' J1 JOBSTACK.1 = JOBNAME JOBSTACK.0 = 1 IF POS(' JOB ',RCHK) > 0 THEN DO FIRST_RUN_FLAG = 'TRUE' IF SYSDSN(PVARFILE) = 'OK' THEN DO ADDRESS TSO "DELETE " PVARFILE END IF SYSDSN(PLIB) = 'OK' THEN DO ADDRESS TSO "DELETE " PLIB END IF SYSDSN(LLIB) = 'OK' THEN DO ADDRESS TSO "DELETE " LLIB END IF SYSDSN(JNAME) = 'OK' THEN DO ADDRESS TSO "DELETE " JNAME END IF SYSDSN(SETVARFILE) = 'OK' THEN DO ADDRESS TSO "DELETE " SETVARFILE END /* IF SYSDSN(JINCMEM) = 'OK' THEN DO ADDRESS TSO "DELETE " JINCMEM END */ "ALLOCATE DATASET("PVARFILE") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800) RECFM(F B)" "ALLOCATE DATASET("SETVARFILE") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800) RECFM(F B)" "ALLOCATE DATASET("JNAME") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800) RECFM(F B)" "ALLOCATE DATASET("PLIB") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800) RECFM(F B)" "ALLOCATE DATASET("LLIB") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800) RECFM(F B)" /* "ALLOCATE DATASET("JINCMEM") NEW SPACE(5,1) DSORG(PS)", "LRECL(80) BLKSIZE(800)" */ END ELSE DO IF (POS('PROC',RCHK) > 0) THEN DO IF SYSDSN(PVARFILE) <> 'OK' THEN DO SAY 'YOU CANNOT VIEW FILES DIRECTLY FROM PROC' EXIT END IF SYSDSN(SETVARFILE) <> 'OK' THEN DO SAY 'YOU CANNOT VIEW FILES DIRECTLY FROM PROC' EXIT END END END RETURN PARMOPENPARA: ERR_FLAG = 'TRUE' DO O = 1 TO PARMSTACK.0 CALL SYMCHKNPROC(PARMSTACK.O) PARMSTACK.O = DATA PARMSTACK.O = "'"]] PARMSTACK.O ]]"'" IF SYSDSN(PARMSTACK.O) = 'OK' THEN DO ERR_FLAG = 'FALSE' ADDRESS ISPEXEC " VIEW DATASET("PARMSTACK.O")" /* RETURN */ END END IF ERR_FLAG = 'TRUE' THEN DO SAY 'PARM CANNOT BE EXPANDED :' LNE EXIT END RETURN GETSETVAR: LOOP_EXIT_FLAG = 'FALSE' CLINE = 0 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */ I=0 DO UNTIL LOOP_EXIT_FLAG='TRUE' CLINE = CLINE +1 "ISREDIT (LNE) = LINE" CLINE IF (POS('EXEC',LNE) > 0 ) THEN DO LOOP_EXIT_FLAG='TRUE' END IF SUBSTR(LNE,3,1) = '*' THEN DO ITERATE END IF POS(' SET ',LNE) > 0 THEN DO CALL GETSETVARPROC(LNE) END END RETURN GETSETVARPROC: PARSE ARG LNE PARSE VAR LNE V0 ' SET ' V1 ',' V2 QUOTE_PROC_COMPLETE = 'FALSE' IF POS("'",V1) > 0 THEN DO PARSE VAR LNE V0 ' SET ' V2 DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE' CALL QUOTEPARMPROC(V2 VARSTACK) V2 = PVAR2 END END IF LOOP_EXIT_FLAG = 'TRUE' THEN DO LEAVE END IF QUOTE_PROC_COMPLETE = 'FALSE' THEN DO I=I+1 VARSTACK.I = STRIP(V1) VARSTACK.0 = I END MORE_SET_VAR_FLAG = 'TRUE' DO UNTIL MORE_SET_VAR_FLAG = 'FALSE' IF POS(',',V2) > 0 THEN DO LNE = V2 PARSE VAR LNE V1 ',' V2 QUOTE_PROC_COMPLETE = 'FALSE' IF POS("'",V1) > 0 THEN DO DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE' CALL QUOTEPARMPROC(LNE VARSTACK) LNE = PVAR2 V2 = PVAR2 END END IF LOOP_EXIT_FLAG = 'TRUE' THEN DO MORE_SET_VAR_FLAG = 'FALSE' LEAVE END IF QUOTE_PROC_COMPLETE = 'TRUE' THEN DO ITERATE END I=I+1 CALL VARSTACKINS(I V1) END ELSE DO IF POS('=',V2) > 0 THEN DO LNE = V2 PARSE VAR LNE V1 V2 I=I+1 CALL VARSTACKINS(I V1) END MORE_SET_VAR_FLAG = 'FALSE' END END RETURN GETJCLLIB: /* THIS PROCEDURE IS TO GET ALL OF THE JCLLIB PRESENT IN THE JCL */ LOOP_EXIT_FLAG = 'FALSE' CLINE = 1 I = 1 JCLLIB_END_FLAG = ' ' DO UNTIL LOOP_EXIT_FLAG = 'TRUE' CLINE = CLINE + 1 "ISREDIT (LNE) = LINE" CLINE IF (POS('JCLLIB',LNE) > 0) THEN DO JCLLIB_END_FLAG = 'FALSE' END IF JCLLIB_END_FLAG = 'FALSE' THEN DO IF (POS(')',LNE) > 0) THEN DO JCLLIB_END_FLAG = 'TRUE' LOOP_EXIT_FLAG = 'TRUE' END IF(POS('JCLLIB',LNE) > 0) THEN DO IF (POS('ORDER=(',LNE) > 0) THEN DO IF (POS(')',LNE) > POS('(',LNE)) THEN DO PARSE VAR LNE J1 'ORDER=(' J2 ')' JCLLIB_END_FLAG = 'TRUE' LOOP_EXIT_FLAG = 'TRUE' END ELSE DO PARSE VAR LNE J1 'ORDER=(' J2 ',' J3 END END ELSE DO PARSE VAR LNE J1 'ORDER=' J2 ',' J3 JCLLIB_END_FLAG = 'TRUE' LOOP_EXIT_FLAG = 'TRUE' END CALL JCLLIBSTACKINS(I J2) I=I+1 IF (STRIP(J3) != '') THEN DO PARSE VAR J3 J2 ',' J4 CALL JCLLIBSTACKINS(I J2) I=I+1 END END ELSE DO PARSE VAR LNE '//' J2 ',' J3 IF JCLLIB_END_FLAG = 'TRUE' THEN DO IF (POS(',',LNE) > 0) THEN DO PARSE VAR LNE '//' J2 ',' J3 CALL JCLLIBSTACKINS(I J2) I=I+1 PARSE VAR J3 J2 ')' CALL JCLLIBSTACKINS(I J2) I=I+1 LEAVE END PARSE VAR LNE '//' J2 ')' J3 CALL JCLLIBSTACKINS(I J2) I=I+1 LEAVE END CALL JCLLIBSTACKINS(I J2) I=I+1 IF (STRIP(J3) != '') THEN DO PARSE VAR J3 J2 ',' J4 CALL JCLLIBSTACKINS(I J2) I=I+1 END END END END RETURN PROCLIBCHECK: "ISREDIT (LNE) = LINE" LNENUM IF ((POS('EXEC',LNE) = 0) & (POS('DD',LNE) = 0)) THEN DO IF (POS('ORDER=',LNE) > 0) THEN DO IF (POS('ORDER=(',LNE) > 0) THEN DO PARSE VAR LNE L1 'ORDER=(' L2 ',' L3 END ELSE DO PARSE VAR LNE L1 'ORDER=' L2 ',' L3 END IF POS(')',L2) > 0 THEN DO PARSE VAR L2 F ')' L2 = F END CALL SYMCHKNPROC(L2) L2 = DATA ADDRESS ISPEXEC " VIEW DATASET('"L2"')" EXIT END END RETURN COBOPENPARA: CSTNAME = '' /* VARIABLE TO HOLD STEP NAME OF COBOL PGM */ CPRNAME = '' /* VARIABLE TO HOLD PROC NAME OF COBOL PGM */ SLIB = "'TTYA.DBCRD.SRCLIB.FILE'" "ALLOC FILE(SFILE) DATASET("SLIB") SHR REUSE" "EXECIO * DISKR SFILE ( STEM SLIBSTACK. FINIS " "FREE FI(SFILE)" IF SLIBSTACK.0 <> 0 THEN DO DO I = 1 TO SLIBSTACK.0 SLIBSTACK.I = STRIP(SLIBSTACK.I) END END IF POS('PGM=',LNE) > 0 THEN DO PARSE VAR LNE '//' CSTNAME 'EXEC ' J 'PGM=' PGMNAME ',' REST END IF POS('PROG(',LNE) > 0 THEN DO PARSE VAR LNE FIRST 'PROG(' PGMNAME ')' REST LNUM = LNENUM - 1 "ISREDIT (LNE) = LINE" LNUM IF POS('PGM=',LNE) > 0 THEN DO PARSE VAR LNE '//' CSTNAME 'EXEC ' J END ELSE DO LNUM = LNUM - 1 "ISREDIT (LNE) = LINE" LNUM IF POS('PGM=',LNE) > 0 THEN DO PARSE VAR LNE '//' CSTNAME 'EXEC ' J END ELSE DO LNUM = LNUM - 1 "ISREDIT (LNE) = LINE" LNUM IF POS('PGM=',LNE) > 0 THEN DO PARSE VAR LNE '//' CSTNAME 'EXEC ' J END END END END LNUM = LNENUM LOOP_EXIT_FLAG = 'FALSE' DO UNTIL LOOP_EXIT_FLAG = 'TRUE' LNUM = LNUM - 1 IF LNUM = 0 THEN DO SAY 'PROC NAME NOT FOUND, ERROR CODE 1001' LEAVE END "ISREDIT (LNE) = LINE" LNUM IF SUBSTR(LNE,3,1) = '*' THEN DO ITERATE END IF POS(' PROC ',LNE) > 0 THEN DO PARSE VAR LNE '//' CPRNAME 'PROC' CPRNAME = STRIP(CPRNAME) LOOP_EXIT_FLAG = 'TRUE' ITERATE END END CALL SYMCHKNPROC(PGMNAME) PGMNAME = DATA SRCLIB_FOUND = 'FALSE' IF LODLIBSTACK.0 = 0 THEN DO SAY ' NO LOADLIB FOUND. CHECK JCL OR CONTACT DEVELOPER' END DO I = 1 TO LODLIBSTACK.0 /* THIS IS TO SEARCH FOR LOAD IN STEPLIBS PRESENT */ PARSE VAR LODLIBSTACK.I IND ',' LPNME ','LSNME ',' LODLIB LODLIB = STRIP(LODLIB) PGMNAME = STRIP(PGMNAME) IF ((CPRNAME = LPNME) & (CSTNAME = LSNME)) THEN DO DSN = "'" ]] LODLIB ]] '(' ]] PGMNAME ]] ')' ]] "'" IF SYSDSN(DSN) = 'OK' THEN DO SRCLIB_FOUND = 'FALSE' DO J = 1 TO SLIBSTACK.0 PARSE VAR SLIBSTACK.J SLODLIB ',' SSRCLIB ',' SLODLIB = STRIP(SLODLIB) SSRCLIB = STRIP(SSRCLIB) IF (SLODLIB = LODLIB) THEN DO SRCLIB_FOUND = 'TRUE' DSN = "'"]]SSRCLIB]]'(']]PGMNAME]]')']]"'" IF SYSDSN(DSN) = 'OK' THEN DO ADDRESS ISPEXEC " VIEW DATASET("DSN")" LEAVE END ELSE DO /* TO HANDLE WHAT TO DO IF LOAD IS NOT AVAILABLE IN STEPLIB */ SRCLIB_FOUND = 'FALSE' END END END IF SRCLIB_FOUND = 'TRUE' THEN DO LEAVE END END END END IF SRCLIB_FOUND = 'FALSE' THEN DO /* THIS PARA IS TO SERACH FOR LOAD IN JOBLIB */ DO I = 1 TO LODLIBSTACK.0 PARSE VAR LODLIBSTACK.I IND ',' LPNME ','LSNME ',' LODLIB IF (IND = 'S') THEN DO ITERATE END LODLIB = STRIP(LODLIB) DSN = "'" ]] LODLIB ]] '(' ]] PGMNAME ]] ')' ]] "'" IF SYSDSN(DSN) = 'OK' THEN DO SRCLIB_FOUND = 'FALSE' DO J = 1 TO SLIBSTACK.0 PARSE VAR SLIBSTACK.J SLODLIB ',' SSRCLIB ',' SLODLIB = STRIP(SLODLIB) SSRCLIB = STRIP(SSRCLIB) IF (SLODLIB = LODLIB) THEN DO SRCLIB_FOUND = 'TRUE' DSN = "'"]]SSRCLIB]]'(']]PGMNAME]]')']]"'" IF SYSDSN(DSN) = 'OK' THEN DO ADDRESS ISPEXEC " VIEW DATASET("DSN")" LEAVE END END END LEAVE END END END IF SRCLIB_FOUND = 'FALSE' THEN DO SAY ' COBOL PROGRAM NOT FOUND IN ANY SRC LIB PRESENT' END RETURN PROCOPENPARA: IF (POS('PROC=',LNE) > 0) THEN DO PARSE VAR LNE P1 'PROC=' P2 ',' P3 END ELSE DO PARSE VAR LNE P1 'EXEC' P2 ',' P3 END CALL SYMCHKNPROC(P2) P2 = DATA DO I = 1 TO JCLLIBSTACK.0 DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(P2) ]] ')' ]] "'" IF SYSDSN(DSN) = 'OK' THEN DO /* ADDRESS ISPEXEC "VIEW DATASET("JCLLIBSTACK.I") MEMBER("P2")" */ ADDRESS ISPEXEC " VIEW DATASET("DSN")" LEAVE END IF I = JCLLIBSTACK.0 THEN DO SAY 'PROC NOT AVAILABLE IN ANY OF THE LIBRARY' EXIT END END RETURN FILEOPENPARA: IF POS('DSN=',LNE) = 0 THEN DO SAY ' NOT A VALID DSN TO OPEN' EXIT END PARSE VAR LNE V1 'DSN=' V2 ',' V3 CALL SYMCHKNPROC(V2) V2 = DATA SELECT WHEN POS('(+1)',V2) > 0 THEN DO PARSE VAR V2 V1 '+1' V3 V2 = V1 ]] '0' ]] V3 END WHEN POS('(+2)',V2) > 0 THEN DO PARSE VAR V2 V1 '+2' V3 V2 = V1 ]] '0' ]] V3 END WHEN POS('(+3)',V2) > 0 THEN DO PARSE VAR V2 V1 '+3' V3 V2 = V1 ]] '0' ]] V3 END OTHERWISE DO END END ADDRESS ISPEXEC " VIEW DATASET('"V2"')" IF RC <> 0 THEN DO SAY 'NOT FOUND' SYSDSN(V2) V2 END RETURN OPENINCMEMPARA: PARSE VAR LNE M1 'MEMBER=' INCMEM CALL SYMCHKNPROC(INCMEM) INCMEM = DATA DO I = 1 TO JCLLIBSTACK.0 DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(V2) ]] ')' ]] "'" IF SYSDSN(DSN) = 'OK' THEN DO /* ADDRESS ISPEXEC "VIEW DATASET("JCLLIBSTACK.I") MEMBER("P2")" */ ADDRESS ISPEXEC " VIEW DATASET("DSN")" LEAVE END END RETURN GETPROCSETVAR: /* THIS IS TO GET ALL OF THE PARAMETER SET FOR A PARTICULAR PROC */ LOOP_EXIT_FLAG = 'FALSE' CLINE = 1 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */ I=PVARSTACK.0 DO UNTIL LOOP_EXIT_FLAG='TRUE' CLINE = CLINE +1 "ISREDIT (LNE) = LINE" CLINE IF RC <> 0 THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END IF SUBSTR(LNE,3,1) = '*' THEN DO ITERATE END IF POS(' EXEC ',LNE) > 0 THEN DO PROC_FOUND_FLAG='TRUE' IF POS('PGM=',LNE) > 0 THEN DO PROC_FOUND_FLAG = 'FALSE' ITERATE END ELSE DO PARSE VAR LNE PVAR1 ',' PVAR2 IF POS('PROC=',LNE) > 0 THEN DO PARSE VAR LNE PNAME1 'PROC=' PNAME ',' PNAME2 END ELSE DO PARSE VAR LNE PNAME1 ' EXEC ' PNAME ',' PNAME2 END CALL GETMPROCSETVAR ITERATE END END IF PROC_FOUND_FLAG = 'TRUE' THEN DO IF (SUBSTR(LNE,3,1) = ' ') THEN DO PARSE VAR LNE PVAR1 PVAR2 CALL GETMPROCSETVAR END ELSE DO PROC_FOUND_FLAG= 'FALSE' END END END RETURN GETMPROCSETVAR: MORE_PROC_VAR_FLAG = 'TRUE' DO UNTIL MORE_PROC_VAR_FLAG = 'FALSE' QUOTE_PROC_COMPLETE = 'FALSE' IF POS(',',PVAR2) > 0 THEN DO LNE = PVAR2 PARSE VAR PVAR2 PVAR1 ',' PVAR3 /*FROM HERE */ IF POS("'",PVAR1) > 0 THEN DO DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE' CALL QUOTEPARMPROC(PVAR2 PVARSTACK) IF QUOTE_PROC_COMPLETE = 'TRUE' THEN DO MORE_PROC_VAR_FLAG = 'FALSE' END END END ELSE DO PARSE VAR LNE PVAR1 ',' PVAR2 I = I + 1 CALL PVARSTACKINS(I PNAME PVAR1) END /* PVARSTACK.I = STRIP(PNAME)]]',']]STRIP(PVAR1) PVARSTACK.0=I */ END ELSE DO MORE_PROC_VAR_FLAG = 'FALSE' IF POS('=',PVAR2) > 0 THEN DO LNE = PVAR2 PARSE VAR LNE PVAR1 PVAR2 I = I + 1 CALL PVARSTACKINS(I PNAME PVAR1) /* PVARSTACK.I = STRIP(PNAME)]]',']]STRIP(PVAR1) PVARSTACK.0=I */ END END END RETURN RETURN TERMPARA: ADDRESS TSO "DELETE " PVARFILE ADDRESS TSO "DELETE " SETVARFILE ADDRESS TSO "DELETE " JNAME ADDRESS TSO "DELETE " PLIB ADDRESS TSO "DELETE " LLIB RETURN WRITETOFILE: "ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE" "EXECIO" PVARSTACK.0 "DISKW PFILE ( STEM PVARSTACK. FINIS" "FREE FI(PFILE)" "ALLOC FILE(SFILE) DATASET("SETVARFILE") SHR REUSE" "EXECIO" VARSTACK.0 "DISKW SFILE ( STEM VARSTACK. FINIS " "FREE FI(SFILE)" "ALLOC FILE(JFILE) DATASET("JNAME") SHR REUSE" "EXECIO" JOBSTACK.0 "DISKW JFILE (STEM JOBSTACK. FINIS " "FREE FI(JFILE)" "ALLOC FILE(PFILE) DATASET("PLIB") SHR REUSE" "EXECIO" JCLLIBSTACK.0 "DISKW PFILE (STEM JCLLIBSTACK. FINIS " "FREE FI(PFILE)" "ALLOC FILE(LFILE) DATASET("LLIB") SHR REUSE" "EXECIO" LODLIBSTACK.0 "DISKW LFILE (STEM LODLIBSTACK. FINIS " "FREE FI(LFILE)" RETURN READJCLDATA: "ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE" "EXECIO * DISKR PFILE ( STEM PVARSTACK. FINIS " "FREE FI(PFILE)" IF PVARSTACK.0 <> 0 THEN DO DO I = 1 TO PVARSTACK.0 PVARSTACK.I = STRIP(PVARSTACK.I) END END "ALLOC FILE(SFILE) DATASET("SETVARFILE") SHR REUSE" "EXECIO * DISKR SFILE ( STEM VARSTACK. FINIS " "FREE FI(SFILE)" IF VARSTACK.0 <> 0 THEN DO DO I = 1 TO VARSTACK.0 VARSTACK.I = STRIP(VARSTACK.I) END END "ALLOC FILE(PFILE) DATASET("PLIB") SHR REUSE" "EXECIO * DISKR PFILE ( STEM JCLLIBSTACK. FINIS " "FREE FI(PFILE)" IF JCLLIBSTACK.0 <> 0 THEN DO DO I = 1 TO JCLLIBSTACK.0 JCLLIBSTACK.I = STRIP(JCLLIBSTACK.I) END END "ALLOC FILE(LFILE) DATASET("LLIB") SHR REUSE" "EXECIO * DISKR LFILE ( STEM LODLIBSTACK. FINIS " "FREE FI(LFILE)" IF LODLIBSTACK.0 <> 0 THEN DO DO I = 1 TO LODLIBSTACK.0 LODLIBSTACK.I = STRIP(LODLIBSTACK.I) END END "ALLOC FILE(JFILE) DATASET("JNAME") SHR REUSE" "EXECIO * DISKR JFILE ( STEM JOBSTACK. FINIS " "FREE FI(JFILE)" IF JOBSTACK.0 <> 0 THEN DO DO I = 1 TO JOBSTACK.0 JOBSTACK.I = STRIP(JOBSTACK.I) END END RETURN GETPROCVARS: PVARFILE = "'TTYA."]]USERID()]]".PVAR.FILE'" SETVARFILE = "'TTYA."]]USERID()]]".SETVAR.FILE'" JNAME = "'TTYA."]]USERID()]]".JNAME.FILE'" PLIB = "'TTYA."]]USERID()]]".PLIB.FILE'" PROCPVARSTACK.0=0 "ISREDIT (PDATA) = LINE" 1 IF (POS('PROC',PDATA) > 0) THEN DO PARSE VAR PDATA '//' PNAME ' PROC ' REST PNAME_GLOBAL = PNAME LOOP_EXIT_FLAG = 'FALSE' CLINE = 0 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */ I=0 DO UNTIL LOOP_EXIT_FLAG='TRUE' CLINE = CLINE +1 "ISREDIT (LNE) = LINE" CLINE IF SUBSTR(LNE,3,1) = '*' THEN DO ITERATE END IF ((POS(' PROC ',LNE) = 0) & (SUBSTR(LNE,3,1) <> ' ')) THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END IF POS(' PROC ',LNE) > 0 THEN DO PARSE VAR LNE L1 ' PROC ' PVAR2 END ELSE DO PARSE VAR LNE '//' PVAR2 END PVAR2 = STRIP(PVAR2) IF PVAR2 = '' THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END QUOTE_PROC_COMPLETE = 'FALSE' IF POS(',',PVAR2) > 0 THEN DO /* PARSE VAR PVAR2 PVAR1 ',' PVAR2 */ PARSE VAR PVAR2 PVAR1 ',' PVAR3 /*FROM HERE */ IF POS("'",PVAR1) > 0 THEN DO DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE' CALL QUOTEPARMPROC(PVAR2 PROCPVARSTACK) END /* PARSE VAR PVAR2 PVAR1 "='" PVAR3 "'" PVAR4 PVAR1 = PVAR1 ]] "='" ]] PVAR3 ]]"'" I = I + 1 PROCPVARSTACK.I = STRIP(PVAR1) PROCPVARSTACK.0 = I PVAR4 = STRIP(PVAR4) IF PVAR4 = '' THEN DO LOOP_EXIT_FLAG = 'TRUE' LEAVE END ELSE DO PARSE VAR PVAR4 ',' PVAR2 END */ END /* TILL HERE */ IF QUOTE_PROC_COMPLETE = 'TRUE' THEN DO ITERATE END IF LOOP_EXIT_FLAG = 'TRUE' THEN DO LEAVE END PARSE VAR PVAR2 PVAR1 ',' PVAR2 /*FROM HERE */ MORE_PROC_VAR = 'TRUE' I = I + 1 PROCPVARSTACK.I = STRIP(PVAR1) PROCPVARSTACK.0 = I MORE_FLAG = 'FALSE' DO UNTIL MORE_FLAG = 'TRUE' PVAR2=STRIP(PVAR2) IF PVAR2 = '' THEN DO MORE_FLAG = 'TRUE' ITERATE END ELSE IF POS('*',PVAR2) > 0 THEN DO MORE_FLAG = 'TRUE' ITERATE END ELSE DO IF POS('=',PVAR2) > 0 THEN DO I = I + 1 PROCPVARSTACK.I = STRIP(PVAR2) PROCPVARSTACK.0 = I END IF POS(',',PVAR2) > 0 THEN DO PARSE VAR PVAR2 P1 ',' P2 PAVR2 = P2 END ELSE DO MORE_FLAG = 'TRUE' END END END END ELSE DO I = I + 1 PROCPVARSTACK.I = PVAR2 PROCPVARSTACK.0 = I LOOP_EXIT_FLAG = 'TRUE' END END END ELSE DO SAY 'NOT A VALID PROC FOR FURTHER PROCESSING' CALL TERMPARA EXIT END /* /********************DELETE FROM HERE ********************/ DO A = 1 TO PVARSTACK.0 OVERRIDE_FOUND = 'FALSE' PARSE VAR PVARSTACK.A PRC ','VARSTK_NAME '=' VARSTK_VAL IF PRC <> CUR_PROC_NAME THEN DO ITERATE END DO B = 1 TO PROCPVARSTACK.0 PARSE VAR PROCPVARSTACK.B VAR_NAME '=' VAR_VAL IF VAR_NAME = VARSTK_NAME THEN DO OVERRIDE_FOUND = 'TRUE' PROCPVARSTACK.B = VAR_NAME ]] '=' ]] VARSTK_VAL B = PROCPVARSTACK.0 END END IF OVERRIDE_FOUND = 'FALSE' THEN DO B = PROCPVARSTACK.0 B = B + 1 PROCPVARSTACK.B = VARSTK_NAME ]] '=' ]] VARSTK_VAL PROCPVARSTACK.0 = B END END /********************DELETE FROM HERE ********************/ */ RETURN FINALPROCVARSET: /* THIS PARA WILL OVERRIDE THE PARAMETERS FOR VARIABLES COMING FROM JCL */ PNAME = PNAME_GLOBAL DO I = 1 TO PVARSTACK.0 PARSE VAR PVARSTACK.I PROCNAME ',' JVAR '=' JVAL ' ' IF PNAME <> PROCNAME THEN DO ITERATE END JCL_PARM_FOUND = 'FALSE' DO J = 1 TO PROCPVARSTACK.0 PARSE VAR PROCPVARSTACK.J PVAR '=' PVAL ' ' IF (PVAR = JVAR) THEN DO PVAL = JVAL PROCPVARSTACK.J = PVAR ]] '=' ]] JVAL JCL_PARM_FOUND = 'TRUE' END END IF JCL_PARM_FOUND = 'FALSE' THEN DO J = PROCPVARSTACK.0 J = J + 1 PROCPVARSTACK.J = JVAR ]] '=' ]] JVAL PROCPVARSTACK.0 = J END END K = VARSTACK.0 DO I = 1 TO PROCPVARSTACK.0 K = K + 1 VARSTACK.K = PROCPVARSTACK.I VARSTACK.0 = K END RETURN GETINCLUDEMEM: LOOP_EXIT_FLAG = 'FALSE' CLINE = 1 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */ I=0 JINCSTACK.0 = 0 DO UNTIL LOOP_EXIT_FLAG='TRUE' CLINE = CLINE +1 "ISREDIT (LNE) = LINE" CLINE IF RC <> 0 THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END IF SUBSTR(LNE,3,1) = '*' THEN DO ITERATE END IF FIRST_RUN_FLAG = 'TRUE' THEN DO IF (POS('EXEC',LNE) > 0) THEN DO IF (POS('PGM=',LNE) > 0) THEN DO ITERATE END IF (POS('PROC=',LNE) > 0 ) THEN DO PARSE VAR LNE P1 'PROC=' P2 ',' P3 END ELSE DO PARSE VAR LNE P1 'EXEC' P2 ',' END JPROCNAME = STRIP(P2) END END ELSE DO JPROCNAME = PNAME IF POS('EXEC',LNE) > 0 THEN DO PARSE VAR LNE '//'STEPNAME 'EXEC' REST STEPNAME = STRIP(STEPNAME) END END IF ((POS('STEPLIB',LNE) > 0) ] (POS('JOBLIB',LNE)>0)) THEN DO /* INSERT HERE THE CODE FOR INCLUDE MEMBER IN A STEPLIB */ INCCLINE = CLINE CALL GETLOADLIB(CLINE Y) CLINE = INCCLINE JOBLIB_FLAG = 'FALSE' STEPLIB_FLAG = 'FALSE' LOOP_EXIT_FLAG = 'FALSE' ITERATE END IF POS(' INCLUDE ',LNE) > 0 THEN DO CALL READINCMEMDATA IF JINCTSTACK.0 = 0 THEN DO ITERATE END I = 0 K = VARSTACK.0 DO I = 1 TO JINCTSTACK.0 IF (SUBSTR(JINCTSTACK.I,3,1) = '*') THEN DO ITERATE END /* IF (SUBSTR(JINCTSTACK.I,3,1) <> ' ') THEN DO STEP_LIB_FLAG = 'FALSE' JOB_LIB_FLAG = 'FALSE' END */ IF POS(' SET ',JINCTSTACK.I) > 0 THEN DO CALL GETSETVARPROC(JINCTSTACK.I) ITERATE END /* PARSE VAR JINCTSTACK.I 'DSN=' DSNAME ',' CALL SYMCHKNPROC(DSNAME) DSNAME = DATA DSN_CHECK = "'" ]] DSNAME ]] "'" IF SYSDSN(DSN_CHECK) = 'OK' THEN DO IF STEP_LIB_FLAG = 'TRUE' THEN DO DSNAME_T = 'S,' ]] JPROCNAME ]] ',' DSNAME_T = DSNAME_T ]] STEPNAME ]] ',' ]] DSNAME END ELSE DO DSNAME_T = 'J,,,' ]] DSNAME END END ELSE DO ITERATE END O = LODLIBSTACK.0 O = O + 1 LODLIBSTACK.O = DSNAME_T LODLIBSTACK.0 = O */ /* REDUDANDT CODE */ IF (((SUBSTR(JINCTSTACK.I,3,7) = 'STEPLIB') ], (SUBSTR(JINCTSTACK.I,3,6) = 'JOBLIB')) &, ((STEP_LIB_FLAG = 'FALSE') &, (JOB_LIB_FLAG = 'FALSE'))) THEN DO PARSE VAR JINCTSTACK.I 'DSN=' DSNAME ',' CALL SYMCHKNPROC(DSNAME) DSNAME = DATA DSN_CHECK = "'" ]] DSNAME ]] "'" IF SUBSTR(JINCTSTACK.I,3,7) = 'STEPLIB' THEN DO STEP_LIB_FLAG = 'TRUE' JOB_LIB_FLAG = 'FALSE' END ELSE DO STEP_LIB_FLAG = 'FALSE' JOB_LIB_FLAG = 'TRUE' END IF SYSDSN(DSN_CHECK) = 'OK' THEN DO O = LODLIBSTACK.0 O = O + 1 IF STEP_LIB_FLAG = 'TRUE' THEN DO DSNAME_T = 'S,' ]] JPROCNAME ]] ',' DSNAME_T = DSNAME_T ]] STEPNAME ]] ',' LODLIBSTACK.O = DSNAME_T ]] DSNAME END ELSE DO DSNAME = 'J,,,' ]] DSNAME LODLIBSTACK.O = DSNAME END LODLIBSTACK.0 = O END ELSE DO ITERATE END END /*REDUDANT CODE */ END /* */ END END RETURN GETLOADLIB: PARSE ARG CLINE EXIT_FLAG LOOP_EXIT_FLAG = 'FALSE' LOADLIB_FOUND_FLAG = 'FALSE' PROC_LOADLIB_VALD = 'NOT-INIT' I = LODLIBSTACK.0 DO UNTIL LOOP_EXIT_FLAG='TRUE' "ISREDIT (LNE) = LINE" CLINE CLINE = CLINE +1 IF RC <> 0 THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END IF (SUBSTR(LNE,3,1) = '*') THEN DO ITERATE END /* IF (SUBSTR(LNE,3,1) <> '*' & SUBSTR(LNE,3,1) <> ' ') THEN DO LOOP_EXIT_FLAG='TRUE' ITERATE END */ IF (POS('EXEC',LNE) > 0) THEN DO JOBLIB_FLAG = 'FALSE' STEPLIB_FLAG = 'FALSE' IF (POS('PGM=',LNE) > 0) THEN DO ITERATE END IF (POS('PROC=',LNE) > 0 ) THEN DO PARSE VAR LNE P1 'PROC=' P2 ',' P3 END ELSE DO PARSE VAR LNE P1 'EXEC' P2 ',' END JPROCNAME = STRIP(P2) END IF ((POS('JOBLIB',LNE) > 0 ] POS('STEPLIB',LNE) > 0) &, (LOADLIB_FOUND_FLAG <> 'TRUE')) THEN DO IF FIRST_RUN_FLAG = 'TRUE' THEN DO IF (POS('STEPLIB',LNE) > 0) THEN DO STEPLIB_FLAG = 'TRUE' JOBLIB_FLAG = 'FALSE' PARSE VAR LNE '//' S 'DD' REST PARSE VAR S STEPNAME '.' STEPLIB END ELSE DO JOBLIB_FLAG = 'TRUE' STEPLIB_FLAG = 'FALSE' END END ELSE DO STEPLIB_FOUND = 'TRUE' DO Y = 1 TO LODLIBSTACK.0 PARSE VAR LODLIBSTACK.Y IND ',' LPNME ','LSNME ',' R IF ((JPROCNAME = LPNME) & (LSNME = STEPNAME)) THEN DO LOOP_EXIT_FLAG = 'TRUE' LEAVE END END END IF LOOP_EXIT_FLAG = 'TRUE' THEN DO ITERATE END LOADLIB_FOUND_FLAG = 'TRUE' PARSE VAR LNE L1 'DSN=' L2 ',' L3 I = LODLIBSTACK.0 I = I + 1 CALL SYMCHKNPROC(L2) L2 = DATA IF JOBLIB_FLAG = 'TRUE' THEN DO V = 'J' ]] ',,,' ]] STRIP(L2) END ELSE DO V = 'S' ]] ',' ]] JPROCNAME ]] ',' ]] STEPNAME V = V ]] ',' ]] STRIP(L2) END LODLIBSTACK.I = V LODLIBSTACK.0 = I ITERATE END IF LOADLIB_FOUND_FLAG = 'TRUE' THEN DO IF SUBSTR(LNE,3,1) <> ' ' THEN DO LOADLIB_FOUND_FLAG = 'FALSE' IF EXIT_FLAG = 'Y' THEN DO LOOP_EXIT_FLAG = 'TRUE' LEAVE END END IF (SUBSTR(LNE,3,1) = ' ') THEN DO IF POS(' INCLUDE ',LNE) > 0 THEN DO CALL READINCMEMDATA IF JINCTSTACK.0 = 0 THEN DO ITERATE END CNTR = 0 VARSTACK_COUNT = VARSTACK.0 DO CNTR = 1 TO JINCTSTACK.0 IF (SUBSTR(JINCTSTACK.CNTR,3,1) = '*') THEN DO ITERATE END PARSE VAR JINCTSTACK.CNTR 'DSN=' DSNAME ',' CALL SYMCHKNPROC(DSNAME) DSNAME = DATA DSN_CHECK = "'" ]] DSNAME ]] "'" IF SYSDSN(DSN_CHECK) = 'OK' THEN DO IF STEP_LIB_FLAG = 'TRUE' THEN DO DSNAME_T = 'S,' ]] JPROCNAME ]] ',' DSNAME_T = DSNAME_T ]] STEPNAME ]] ',' DSNAME_T = DSNAME_T ]] DSNAME END ELSE DO DSNAME_T = 'J,,,' ]] DSNAME END END ELSE DO ITERATE END O = LODLIBSTACK.0 O = O + 1 LODLIBSTACK.O = DSNAME_T LODLIBSTACK.0 = O END /* IF CNTR = JINCTSTACK.0 THEN DO LOOP_EXIT_FLAG = 'TRUE' ITERATE END */ END ELSE DO PARSE VAR LNE L1 'DSN=' L2 ',' L3 IF STRIP(L2) = '' THEN DO ITERATE END I = LODLIBSTACK.0 I = I + 1 CALL SYMCHKNPROC(L2) L2 = DATA IF JOBLIB_FLAG = 'TRUE' THEN DO V = 'J' ]] ',,,' ]] STRIP(L2) END ELSE DO V = 'S' ]] ',' ]] JPROCNAME ]] ',' ]] STEPNAME V = V ]] ',' ]] STRIP(L2) END LODLIBSTACK.I = V LODLIBSTACK.0 = I END END END END RETURN STEMSEARCH: PARSE ARG INPUT STKNAME ',' VALUE RETURN RUNTYPESELECT: JCLLIB_TYPE = 'FALSE' FILE_TYPE = 'FALSE' COBOL_TYPE = 'FALSE' COBOL_PGM_TYPE= 'FALSE' PROC_TYPE = 'FALSE' INC_MEM_TYPE = 'FALSE' COPYBOOK_TYPE = 'FALSE' PARM_TYPE = 'FALSE' IF POS('DD',LNE) > 0 THEN DO FILE_TYPE = 'TRUE' END IF POS(' CALL ',LNE) > 0 THEN DO COBOL_PGM_TYPE = 'TRUE' END IF POS('EXEC',LNE) > 0 THEN DO IF POS('PGM=',LNE) > 0 THEN DO COBOL_TYPE = 'TRUE' END ELSE DO PROC_TYPE = 'TRUE' PARSE VAR LNE ',' TMP PARSE VAR TMP '=' PARM_DATA ' ' IF POS(',',PARM_DATA) > 0 THEN DO EXIT_FLAG = 'FALSE' DO UNTIL EXIT_FLAG = 'TRUE' PARSE VAR PARM_DATA PARM_DATA_T ',' P_DATA_T PARM_DATA = PARM_DATA_T PARM_STACK_CNT = PARMSTACK.0 PARM_STACK_CNT = PARM_STACK_CNT + 1 PARMSTACK.PARM_STACK_CNT = PARM_DATA PARMSTACK.0 = PARM_STACK_CNT IF STRIP(P_DATA_T) = '' THEN DO EXIT_FLAG = 'TRUE' END ELSE DO PARSE VAR P_DATA_T '=' PARM_DATA P_DATA_T = '' END END PARSE VAR PARM_DATA PARM_DATA_T ',' PARM_DATA = PARM_DATA_T END END END IF POS('JCLLIB',LNE) > 0 THEN DO JCLLIB_TYPE = 'TRUE' END IF ((POS('MEMBER',LNE)> 0) & (SUBSTR(LNE,3,1) <> '*')) THEN DO INC_MEM_TYPE = 'TRUE' END IF POS('PROG(',LNE) > 0 THEN DO COBOL_TYPE = 'TRUE' END IF ((POS(' COPY ',LNE) > 0 ) ] (POS(' INCLUDE ',LNE)> 0)) THEN DO IF POS('MEMBER=',LNE) = 0 THEN DO COPYBOOK_TYPE = 'TRUE' END END IF PROC_TYPE = 'FALSE' & , INC_MEM_TYPE = 'FALSE' & , JCLLIB_TYPE = 'FALSE' & , COPYBOOK_TYPE = 'FALSE' & , COBOL_TYPE = 'FALSE' & , COBOL_PGM_TYPE = 'FALSE' & , FILE_TYPE = 'FALSE' THEN DO IF POS('=',LNE) > 0 THEN DO PARM_TYPE = 'TRUE' PARSE VAR LNE '=' PARM_DATA ' ' IF POS(',',PARM_DATA) > 0 THEN DO EXIT_FLAG = 'FALSE' DO UNTIL EXIT_FLAG = 'TRUE' PARSE VAR PARM_DATA PARM_DATA_T ',' P_DATA_T PARM_DATA = PARM_DATA_T PARM_STACK_CNT = PARMSTACK.0 PARM_STACK_CNT = PARM_STACK_CNT + 1 PARMSTACK.PARM_STACK_CNT = PARM_DATA PARMSTACK.0 = PARM_STACK_CNT IF STRIP(P_DATA_T) = '' THEN DO EXIT_FLAG = 'TRUE' END ELSE DO PARSE VAR P_DATA_T '=' PARM_DATA P_DATA_T = '' END END END PARM_STACK_CNT = PARMSTACK.0 PARM_STACK_CNT = PARM_STACK_CNT + 1 PARMSTACK.PARM_STACK_CNT = PARM_DATA PARMSTACK.0 = PARM_STACK_CNT END ELSE DO SAY ' WRONG TYPE CHOOSEN, PROGRAM TERMINATING' EXIT END END RETURN VARSTACKINS: PARSE ARG ITR VAL VARSTACK.ITR = STRIP(VAL) VARSTACK.0 = ITR RETURN PVARSTACKINS: PARSE ARG ITR PROC_NAME VAR_NAME PVARSTACK.ITR = STRIP(PROC_NAME)]]',']]STRIP(VAR_NAME) PVARSTACK.0=ITR RETURN PROCPVARSTACKINS: PARSE ARG ITR VAL PROCPVARSTACK.ITR = STRIP(VAL) PROCPVARSTACK.0 = ITR RETURN JCLLIBSTACKINS: PARSE ARG ITR VAL CALL SYMCHKNPROC(VAL) VAL = DATA JCLLIBSTACK.ITR = STRIP(VAL) JCLLIBSTACK.0 = ITR RETURN READCPYBKLIB: "ISREDIT (LNE) = LINE" LNENUM IF POS(' COPY ',LNE) > 0 THEN DO PARSE VAR LNE ' COPY ' CPYNAME_T '.' PARSE VAR CPYNAME_T CPYNAME ' ' END IF POS(' INCLUDE ',LNE) > 0 THEN DO PARSE VAR LNE ' INCLUDE ' CPYNAME_T '.' PARSE VAR CPYNAME_T CPYNAME ' ' END CPYNAME = STRIP(CPYNAME) SLIB = "'TTYA.DBCRD.SRCLIB.FILE'" "ALLOC FILE(SFILE) DATASET("SLIB") SHR REUSE" "EXECIO * DISKR SFILE ( STEM SLIBSTACK. FINIS " "FREE FI(SFILE)" IF RC <> 0 THEN DO SAY ' SRCLIB FILE IS NOT PRESENT PLEASE CHECK DOCUMENTATION' EXIT END IF SLIBSTACK.0 <> 0 THEN DO COPYBOOK_FOUND = 'FALSE' DO I = 1 TO SLIBSTACK.0 SLIBSTACK.I = STRIP(SLIBSTACK.I) PARSE VAR SLIBSTACK.I A ',' B ',' CPYLIB CPYLIB = STRIP(CPYLIB) DSN = "'"]]CPYLIB]]'(']]CPYNAME]]')']]"'" IF SYSDSN(DSN) = 'OK' THEN DO COPYBOOK_FOUND = 'TRUE' ADDRESS ISPEXEC " VIEW DATASET("DSN")" EXIT END END IF COPYBOOK_FOUND = 'FALSE' THEN DO SAY 'COPYBOOK COULDNOT BE FOUND IN THE LIB. CHECK DOCUMENT' EXIT END END RETURN QUOTEPARMPROC: PARSE ARG PVAR2 STACK PARSE VAR PVAR2 PVAR1 "='" PVAR3 "'" PVAR4 PVAR1 = PVAR1 ]] "='" ]] PVAR3 ]]"'" I = I + 1 IF STACK = 'VARSTACK' THEN DO CALL VARSTACKINS(I STRIP(PVAR1)) END IF STACK = 'PROCPVARSTACK' THEN DO CALL PROCPVARSTACKINS(I STRIP(PVAR1)) END PVAR4 = STRIP(PVAR4) IF PVAR4 = "," THEN DO QUOTE_PROC_COMPLETE = 'TRUE' END IF PVAR4 = '' THEN DO QUOTE_PROC_COMPLETE = 'TRUE' LOOP_EXIT_FLAG = 'TRUE' END ELSE DO PARSE VAR PVAR4 ',' PVAR2 PARSE VAR PVAR2 PVAR1 ',' PVAR3 IF POS("'",PVAR1) = 0 THEN DO QUOTE_PROC_COMPLETE = 'TRUE' END END RETURN READINCMEMDATA: PARSE VAR LNE INC1 'MEMBER=' INCMEM I2 = STRIP(INCMEM) CALL SYMCHKNPROC(I2) I2 = DATA JINCTSTACK.0 = 0 DO I = 1 TO JCLLIBSTACK.0 JCLLIBSTACK.I = STRIP(JCLLIBSTACK.I) DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(I2) ]] ')' ]] "'" IF SYSDSN(DSN) = 'OK' THEN DO "ALLOC FILE(JINC) DATASET("DSN") SHR REUSE" "EXECIO * DISKR JINC ( STEM JINCTSTACK. FINIS " "FREE FI(JINC)" LEAVE END END DO I = 1 TO JINCTSTACK.0 JINCTSTACK.I = STRIP(JINCTSTACK.I) END RETURN SYMCHKNPROC: PARSE ARG DATA V2 = STRIP(DATA) CALL STRSYMCHECK IF SYM_FLAG = 'TRUE' THEN DO CALL STRSYMPROCESS END DATA = V2 RETURN STRSYMCHECK: SYM_FLAG = 'FALSE' IF POS('&',V2) > 0 THEN DO SYM_FLAG = 'TRUE' END RETURN STRSYMPROCESS: /* THIS PARAGRAPH IS TO CONVERT ALL SYMBOLIC PARAMETERS PRESENT IN A FILE NAME OR ON A PROC NAME */ SYMPOS = POS('&',V2) DO UNTIL SYMPOS = 0 PARSE VAR V2 V0 '&' V1 '.' V3 /***************DELETE FROM HERE ***************/ IF POS('&',V1) > 0 THEN DO PARSE VAR V1 T1 '&' T2 V3 = '&']]T2 ]] V3 V1 = T1 END /***************TILL HERE ***************/ IF POS('(',V1) > 0 THEN DO PARSE VAR V1 V1_T '(' V3 V1 = V1_T V3 = '(' ]] V3 END VARLEN = LENGTH(V1) Y = 0 DO Y = 1 TO VARSTACK.0 PARSE VAR VARSTACK.Y VAR1 '=' VAL1 IF VAR1 == V1 THEN DO V1 = STRIP(VAL1) IF POS("'",V1) > 0 THEN DO PARSE VAR V1 "'" V1_TEMP "'" V1 = V1_TEMP END V2 = V0 ]] V1 ]] V3 IF (POS('&',V2) > 0 ) THEN DO SYMPOS = POS('&',V2) PARSE VAR V2 V0 '&' V1 '.' V3 IF POS('&',V1) > 0 THEN DO PARSE VAR V1 T1 '&' T2 V3 = '&']]T2 ]] V3 V1 = T1 END IF POS('(',V1) > 0 THEN DO PARSE VAR V2 V0 '&' V1 '(' V3 V3 = '(' ]] STRIP(V3) END IF STRIP(V3) = '' THEN DO IF POS(')',V1) > 0 THEN DO PARSE VAR V2 V0 '&' V1 ')' V3 V3 = ')' END IF POS(',',V1) > 0 THEN DO PARSE VAR V2 V0 '&' V1 ',' V3 V3 = ',' END END Y=1 END ELSE DO LEAVE END END IF ((VARSTACK.0 = Y) & (SYMPOS <> 0)) THEN DO SYMPOS = 0 SAY ' UNKNOWS SYMBOLIC PARAMTER FOUND, EXITTING :' V2 EXIT END END SYMPOS = POS('&',V2) END RETURN
/* Main program */ A=3 B=3 C=3 IF B < (A + C) & A < (B + C) & C < (A + B) THEN DO IF (A = B ) & (B = C) THEN SAY ' TRIANGULO EQUILATERO ' ELSE IF (A = B) | (B = C) | (A = C) THEN SAY ' TRIANGULO ISOSCELES ' ELSE SAY ' TRIANGULO ESCALENO ' END ELSE SAY ' NAO FORMA TRIANGULO '
/* Programa "Hola Mundo", codificado en Rexx*/ say "Hola mundo, mi nombre es Sergio Plata"
/* Main program */ X = 0e10 Y = 0e30 SAY 'DOES' X '=' Y '?' IF (X = Y) THEN SAY 'TRUE' ELSE SAY 'FALSE' SAY '' SAY 'DOES' X '==' Y '?' IF (X == Y) THEN SAY 'TRUE' ELSE SAY 'FALSE' EXIT 0
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more