TITLE 'ALEXCMDS - PROGRAM TO PERFORM OPERATOR FUNCTIONS' ********************************************************************* * AUTHOR - BILL SWEENEY SSC, INC. * * DATE - JULY 1997 * * * * PROGRAM TO PASS MVS COMMANDS THROUGH AN SVC 34. * * SVC 34 IS ISSUED IN PSW KEY 0, WHICH IS SET BY THE 'MODESET' * * MACRO. ONCE THE SVC 34 IS FINISHED THE PSW KEY MUST BE RESET TO * * THE PROBLEM PROGRAM STATE USING THE 'MODESET' MACRO AGAIN. INPUT * * IS PROVIDED BY THE DDNAME 'CMDIN' FOR BOTH THE VERIFICATION AND * * THE ACTUAL COMMANDS. * * SPECIAL FUNCTIONS ARE ALSO INCLUDED AND MUST SPECIFY THE * * ACTION IN COLUMN 1 OR ELSE IT WILL BE TREATED AS A COMMAND. * * * ********************************************************************* ALEXCMDS CSECT ALEXCMDS AMODE 24 ALEXCMDS RMODE 24 PRINT ON,GEN R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 EJECT **************************************************************** * SAVE LOGIC AND ENTRY SETUP OF PROGRAM. * **************************************************************** STM R14,R12,12(R13) SAVE IN CALLERS SAVEAREA LR R12,R15 LA R6,2048(R12) LA R6,2048(R6) USING ALEXCMDS,R12,R6 LA R3,STORAGE_SIZE GET THE SIZE OF OUR STORAGE GETMAIN R,LV=(3) GOOD_STORAGE EQU * ST R1,8(R13) SAVE OUR SAVERAREA ST R13,4(R1) SAVE THEIR SAVEAREA LR R13,R1 LOAD OURS USING STORAGE,R13 LA R1,PARMLIST SAVE THE ADDRESS ST R1,PARM_ADDRESS LA R1,PARM_ADDRESS ICM R15,15,ALEXTDAT BZ OPENFILE * L R15,ALEXTDAT BALR R14,R15 *********************** * VERIFY A HOLIDAY DD STATEMENT EXIST BEFORE TRYING TO OPEN RDJFCB HOLIDAY LTR R15,R15 DID THEY EVEN SPECIFY A HOLIDAY FILE BNZ OPENFILE NO, THEN DO NOT TRY TO OPEN OPEN HOLIDAY TM HOLIDAY+48,X'10' GOOD OPEN BZ OPENFILE NO, THEN JUST GO AROUN LOOPHOL GET HOLIDAY CLI 0(R1),C'*' IS THIS A COMMENT BE LOOPHOL YES, THEN GET NEXT RECORD CLC DATE(8),0(R1) COMPARE THE DATES BNE LOOPHOL NO, THEN READ NEXT OI FLAG,X'02' YES, THEN SET FLAG AND CONTINUE EODHOL CLOSE HOLIDAY *********************** OPENFILE EQU * OPEN CMDIN TM CMDIN+48,X'10' WAS OPEN SUCCESSFUL BO GETAREC YES, THEN CONTINUE WTO 'CMDIN DDNAME NOT OPENED. NO COMMANDS.',ROUTCDE=2 MVI RETCODE+3,X'10' EXIT WITH RC 16 B FREESTOR EXIT WITH OTHER THAN 0 RC EJECT ********************************************************************** * WE WILL PROCESS THE COMMANDS THEMSELVES NOW. THE END OF THE RECORD * * WILL BE CHECKED UNTIL THE FIRST NON-BLANK IS FOUND. COMMAND WILL * * THEN BE MOVED TO THE COMMAND AREA OF SVC 34. * ********************************************************************** GETAREC GET CMDIN GET A RECORD CLI 0(R1),C'*' IS THIS STATEMENT A COMMENT BE GETAREC YES, THEN GO NEXT RECORD LR R9,R1 TM FLAG,X'01' IS THIS A CONTINUATION BZ NOT_CONTINUE NI FLAG,X'FE' RESET CONTINUATION LA R15,70(R9) INCREMENT OA CLI 71(R9),C'C' TWO CONTINUATIONS NOT ALLOWED BE BADCONT LOOPCONT CLI 0(R15),C' ' IS IT A NON-BLANK BNE ENDCONT YES, THEN GET OUT OF LOOP BCTR R15,0 NO, DECREMENT R15 AND TRY AGAIN CR R9,R15 BL LOOPCONT B BAD_COMMAND ENDCONT LH R14,LENGTH_INPUT LENGTH LA R2,INPUT_RECORD LA R2,0(R2,R14) INCR PAST THE FIRST PART OF RECORD SR R15,R9 EX R15,MOVE_COMMANDC MVC 0(0,R2),0(R9) LA R15,1(R14,R15) ADD THE TWO LENGTHS STH R15,LENGTH_INPUT SAVE IT B CONTINUE ************************************************************* NOT_CONTINUE EQU * MVC FUNCTION_BYTE(1),0(R9) SAVE THE FUNCTION BYTE MVI INPUT_RECORD,C' ' CLEAR THESE TWO AREAS MVC INPUT_RECORD+1(141),INPUT_RECORD TO BLANKS BEFORE WE MVC COMMAND_TEXT(126),INPUT_RECORD WE START TRT 0(40,R9),NBLANK BZ GETAREC LA R15,70(R9) POINT TO 71ST BYTE OF RECORD CLI 71(R9),C'C' IS THIS A CONTINUATIONS BE ENDCMD YES, THEN MOVE IT ALL LOOPIT CLI 0(R15),C' ' IS IT A NON-BLANK BNE ENDCMD YES, THEN GET OUT OF LOOP BCTR R15,0 NO, DECREMENT R15 AND TRY AGAIN CR R1,R15 JUST MAKE SURE THERE WILL BE DATA BL LOOPIT YES, THEN KEEP LOOKING B BAD_COMMAND IF WE GOT HERE THEN JUST EXIT ENDCMD SR R15,R1 EX R15,MOVE_RECORD MVC INPUT_RECORD(0),0(R1) LA R15,1(R15) INCR FOR EXECUTE STH R15,LENGTH_INPUT SAVE THE LENGTH CLI 71(R9),C'C' IS IT A CONTINUATION BNE CONTINUE SEE IF CONTINUATION OI FLAG,X'01' FLAG FOR CONTINUATION B GETAREC READ THE NEXT RECORD ************************************************************* CONTINUE EQU * LA R9,INPUT_RECORD POINT TO BEGINNING OR RECORD CLI FUNCTION_BYTE,C'+' DO WE WANT TO ISSUE A ROLL MSG BE ITSWTO YES, THEN PROCESS WTO CLI FUNCTION_BYTE,C'@' DO WE WANT TO ISSUE A NO ROLL MSG BNE DOCMDS NO, THEN GO DO COMMANDS ************************************************************* ITSWTO LH R15,LENGTH_INPUT BCTR R15,0 REMOVE ONE FOR WTO CHAR, 1ST BYTE CH R15,HW126 MAKE SURE NOT TOO LONG BNH OKWTOLNG LH R15,HW126 IF TOO LONG THEN DECREMENT OKWTOLNG STH R15,WTO_LENGTH SAVE THE LENGTH BCTR R15,0 REMOVE ONE MORE FOR MOVE EX R15,MOVE_WTO MVC COMMAND_TEXT(0),1(R9) LA R4,WTO_LENGTH ADDRESS FOR WTO CLI 0(R9),C'+' CHECK AGAIN FOR TYPE OF WTO BNE NOROLL WTO TEXT=((4)) B GETAREC NOROLL EQU * WTO TEXT=((4)),DESC=11 B GETAREC ************************************************************* DOCMDS CLI FUNCTION_BYTE,C'#' DO WE WANT TO ISSUE A WAIT (STIMER) BE DOWAIT YES, THEN GO ISSUE STIMER CLI FUNCTION_BYTE,C'?' DO WE WANT TO REPLY TO A WTOR BE REPLYTO YES, THEN GO FIND MESSAGE CLI FUNCTION_BYTE,C'%' DO WE WANT TO SEE A TASK ACTIVE BE DOSTOP YES, THEN SEARCH ACTIVE ASCB CLI FUNCTION_BYTE,C'=' DO WE WANT TO CHECK THE TIME FOR JES BE DOAUTO YES, THEN GO LOOK AT AUTOMATIC CMD CLI FUNCTION_BYTE,C'/' DO WE WANT TO EXECUTE A REXX EXEC BE DOREXX YES, THEN GO LOOK AT AUTOMATIC CMD ISSUECMD LH R15,LENGTH_INPUT CH R15,HW126 MAKE SURE NOT TOO LONG BNH OKCMDLNG LH R15,HW126 IF TOO LONG THEN DECREMENT OKCMDLNG BCTR R15,0 REMOVE ONE MORE FOR MOVE EX R15,MOVE_COMMAND MVC COMMAND_TEXT(0),INPUT_RECORD LA R15,5(R15) INCR FOR EX AND TWO HW'S XC WTO_LENGTH(2),WTO_LENGTH CLEAR TO ZERO STH R15,MVS_COMMAND SAVE THE LENGTH ******************************************************************* * IN ORDER TO ISSUE AN SVC 34 THE PSW KEY MUST BE 0 AND BE IN * * THE SUPERVISOR STATE. AFTER SVC IS ISSUED RETURN TO PROPER KEY * * AND MODE. * ******************************************************************* MODESET MF=(E,SUPRMOD) LA R2,MVS_COMMAND GET ADDRESS IN R2 2/6/06 SR R0,R0 CLEAR R0 LA R4,CMDAREA PUT IN REG4 2/6/06 * SVC 34 ISSUE SVC 2/6/06 REM, ADD MGCRE MGCRE TEXT=(R2),CONSID=CONSID,MF=(E,(R4)) MODESET MF=(E,PROBMOD) B GETAREC GET ANOTHER RECORD ************************************************************* * PROCESS A REXX EXEC HERE * ************************************************************* DOREXX LH R15,LENGTH_INPUT BCTR R15,0 REMOVE ONE FOR REXX /, 1ST BYTE STH R15,WTO_LENGTH SAVE THE LENGTH CLI 1(R9),C' ' MAKE SURE 2ND BYTE IS EXEC NAME BE BAD_COMMAND IF BLANK, THEN JUST GIVE UP TRT 1(9,R9),BLANK MAKE SURE 8 OR LESS CHARACTERS BZ BAD_COMMAND NO, THEN IT IS BAD BCTR R15,0 REMOVE ONE MORE FOR MOVE EX R15,MOVE_WTO MVC COMMAND_TEXT(0),1(R9) LA R4,WTO_LENGTH ADDRESS FOR WTO ICM R15,15,ADDRESS_IRXJCL BNZ CALL_IRXJCL LOAD EP=IRXJCL,ERRET=NOREXX ST R0,ADDRESS_IRXJCL LR R15,R0 CALL_IRXJCL EQU * LA R14,SET31CALL GET ADDRESS FOR BR AND SET MASK ICM R14,8,=X'80' TURN ON HI ORDER BIT BSM R0,R14 SET TO 31 BIT MODE SET31CALL EQU * CALL (15),((4)),VL LA R14,GETAREC GET ADDRESS FOR BR AND SET MASK ICM R14,8,=X'00' TURN ON HI ORDER BIT BSM R0,R14 SET BACK TO 24 BIT MODE ************************************************************* * ISSUE STIMER HERE COMMAND R9 BEGINNING * ************************************************************* DOWAIT LA R10,1(R9) POINT TO BYTE AFTER # FINDWAIT TRT 0(7,R10),NBLANK FIND FIRST NON BLANK BZ BAD_COMMAND FOUNDWT CLC 0(5,R1),=C'WAIT=' VERIFY VALID COMMAND SYNTAX BNE BAD_COMMAND NO, THEN TAKE DEFAULT VALUE LA R10,5(R1) POINT TO FIRST CHARACTER LR R15,R10 SAVE THE LOCATION FOR SUBTRACT SR R15,R9 GET RID OF BEGINNING LH R11,LENGTH_INPUT GET THE OVERALL LENGTH SR R11,R15 GET THE REMAINING LENGTH LTR R11,R11 SEE IF ZERO LENGTH BNP DOSTIMER CH R11,HW3 THIS IS THE MAXIMUM WAIT BH SETMAX IF GT THEN SET MAX WAIT BCTR R11,0 DECR ONCE FOR EX EX R11,TRTNUMBR VERIFY NUMERIC BNZ BAD_COMMAND NO, THEN DO NOT LET GET S0C7 A R11,=F'112' THIS WILL ADD X'70' FOR L1 OF PACK EX R11,PACKTIME MOVE IN THE TIME CVB R15,DOUBLE_WORD AND CONVERT TO BINARY MH R15,HW100 MULTIPLY FOR BINARY TIME ST R15,BINARY SAVE FOR STIMER B DOSTIMER ISSUE STIMER SETMAX MVC BINARY(4),=F'60000' YES, SET UPPER LIMIT VALUE DOSTIMER EQU * STIMER WAIT,,BINTVL=BINARY B GETAREC GET NEXT RECORD **************************************************************** **************************************************************** REPLYTO LA R11,1(R9) POINT TO BYTE PAST ? * DIFFERENT ERROR MESSAGE * MVC WTOREPLY+8(30),0(R9) STORE THIS FOR INVALID MSG TRT 0(8,R11),NBLANK LOOK FOR BEGINNING BZ BAD_COMMAND IF BAD TELL AND GET NEXT CLC 0(2,R1),=C'M=' BEGINNING OF MESSAGE FIELD BNE BAD_COMMAND IF NOT THERE THEN FORGET IT LA R11,2(R1) POINT TO ACTUAL MESSAGE TRT 0(12,R11),SEMICOL FIND DELIMITER, MSG MAX OF 12 BZ BAD_COMMAND 12 OR GT THEN ERROR SR R1,R11 GET LENGTH BCTR R1,0 DECR FOR EXECUTE INSTR STH R1,MSGID_COMPARE SAVE FOR LATER COMPARE EX R1,MOVEMSG MVC REPMSGID(0),0(R11) LA R11,2(R1,R11) POINT TO REPLY AREA CLC 0(2,R11),=C'R=' REPLY FORMAT BEGINNING BNE BAD_COMMAND NO, THEN TELL HIM TO FORGET IT LA R11,2(R11) POINT TO FIRST BYTE OF REPLY LH R1,LENGTH_INPUT GERT THE LENGTH IN REG1 LA R1,INPUT_RECORD(R1) POINT TO END OF DATA BCTR R1,0 BACK UP ONE BYTE CLI 0(R11),X'7D' ENCLOSED IN SINGLE QUOTES BNE ENDREPLY NO, SUBTRACT LENGTH LA R11,1(R11) INCREMENT ONE PAST CLI 0(R1),X'7D' VERIFY THAT LAST BYTE IS QUOTE BNE BAD_COMMAND NOT FOUND, THEN JUST EXIT BCTR R1,0 DECR ONE MORE FOR TIC MARK ENDREPLY SR R1,R11 GET LENGTH OF REPLY *DECRREP1 BCTR R1,0 DON'T DECR MVI COMMAND_TEXT,C' ' BLANK OUT COMMAND MVC COMMAND_TEXT(125),COMMAND_TEXT CLEAR IT * ADDED TWO FOR 4 CHARACTER REPLY ID FOR NEXT 2 INSTRUCTIONS EX R1,MVEREPLY MVC COMMAND_TEXT+7(0),0(R11) LA R15,13(R1) GET LENGTH OF COMMAND IN R15 XC WTO_LENGTH(2),WTO_LENGTH STH R15,MVS_COMMAND SAVE IT L R2,16 CVT USING CVT,R2 L R3,CVTCUCB UCMBASE USING UCM,R3 LH R4,UCMCTID CONSOLE ADDRESS SPACE STH R4,CONSASID SAVE THE CONSOLE ADDR SPACE ID LR R4,R3 RESET R4 SH R4,=H'4' GO BACK 4 SPACES L R4,0(R4) UCM PREFIX USING UCMPRFX,R4 * THE FOLLOWING CODE WILL NOT WORK IN Z/OS R1.8 AND IT IS * UNNECESSARY ANYWAY. COMMENTED OUT WHS 7 DEC 06 * L R14,UCMMCENT ADDR UCM FOR MASTER CONSOLE 12/7/6 * USING UCMLIST,R14 12/7/6 XR R15,R15 CLEAR R15 FOR INSERT * IC R15,UCMID GET ID OF MASTER CONSOLE 12/7/6 * STH R15,MASTCONS SAVE IT FOR LATER 12/7/6 L R15,UCMASCB GET ASCB OF COMMTASK ADDRESS SPACE ST R15,COMMASCB AND PUT IT AWAY * DROP R2,R14 12/7/6 DROP R2 MODESET MF=(E,SUPRMOD) ESAR R2 GET SECONDARY ADDRESS SPACE ST R2,SASID STORE IT AWAY FOR LATER AXSET AX=ONE GET AUTHORIZATION ANYWHERE LH R2,CONSASID LOAD UP ASID OF CONSOLE ADDRESS SPACE SSAR R2 * MODE (CONSOLE ASID) L R11,COMMASCB GET ASCB OF COMM TASK ST R9,R9SAVE SAVE REGISTER 9 FOR RELOAD LR R9,R13 TEMPORARILY ADDRESS R13 STORAGE DROP R13 USING STORAGE,R9 LA R13,LOCKSAVE LOAD UP SAVEAREA FOR LOCK GETLOCK SETLOCK OBTAIN,TYPE=CML,ASCB=(11),REGS=USE,MODE=UNCOND, X RELATED=(CONASCB,RELLOCK) * ADDED 31 BIT ADDRESSING MODE FOR MVS/ESA 4.3 REPLYIT EQU * LA R14,SET31BIT GET ADDRESS FOR BR AND SET MASK ICM R14,8,=X'80' TURN ON HI ORDER BIT BSM R0,R14 SET TO 31 BIT MODE * WE WILL SEARCH THE CHAIN OF ORE ELEMENTS, LOOKING FOR ONE WITH A * WQE TO MATCH WHAT WE WANT. SET31BIT L R4,UCMRPYQ LOAD ADDRESS OF FIRST ORE ENTRY * LA R4,0(R4) ** CLEAR HIGH ORDER BYTE ** LTR R4,R4 IF NO OUTSTANDING WTORS BZ FINMSG THEN GET TO END OF LOOP LA R7,20 OTHERWISE, ASSUME AT MOST 20. USING OREF,R4 ORELOOP DS 0H L R5,ORERWQE GET ASSOCIATED WQE USING WQE,R5 ADDRESS IT ******************************************************************** ******************************************************************** * HERE WE KNOW WE ARE LOOKING FOR MESSAGE TEXT ******************************************************************** LOOKMSG DS 0H LA R10,70 MAX LENGTH IN R10 SLR R15,R15 CLEAR FOR MOVE CHAR PRIMARY LA R11,MSG ADDRESS MESSAGE AREA LA R8,WQETXT+4 ADDRESS MESSAGE MVCP 0(R10,R11),0(R8),R15 MOVE IN 70 BYTES OF MSG LH R1,MSGID_COMPARE RELOAD VALUE EX R1,COMPMSG CLC REPMSGID(0),0(R11) BE GOTMSG GOT THE MESSAGE TRYNEXT DS 0H L R4,ORELKP TRY NEXT ORE * LA R4,0(R4) ** CLEAR HIGH ORDER BYTE ** LTR R4,R4 IS THERE ANYTHING THERE BZ FINMSG NO, THEN WE ARE FINISHED BCT R7,ORELOOP SEARCH NO MORE THAN 20 B FINMSG AND GET OUT OF CROSS MEM LOOP GOTMSG DS 0H MVI COMMAND_TEXT,C'R' MOVE IN REPLY COMMAND * ADD CODE FOR 4 CHARACTER REPLY CLC OREID(2),=X'0000' CHECK IF 4 CHARACTER WHS 09/11/07 BE DO4CHAR YES, THEN DO 4 CHAR WHS 09/11/07 MVC COMMAND_TEXT+4(2),OREID AND ID FROM OPER REQ ELEMENT B SETREPLY_FLAG DO4CHAR L R15,ORERPIDB GET BINARY REPLY ID CVD R15,DOUBLE_WORD MVC REPLYID(6),=X'402020202021' ED REPLYID(6),DOUBLE_WORD+5 MVC COMMAND_TEXT+2(4),REPLYID+2 SETREPLY_FLAG EQU * MVI COMMAND_TEXT+6,C',' AND DELIMETER R XXXX, OI FLAG,X'80' SET FLAG FOR REPLY FINMSG EQU * LA R14,SET24BIT GET ADDRESS FOR RETURN BSM N R14,=X'7FFFFFFF' TURN OFF HI ORDER BIT BSM R0,R14 SET TO 31 BIT MODE SET24BIT L R2,SASID GET BACK ID OF SAVED ASID SSAR R2 L R11,COMMASCB GET ASCB OF COMM TASK RELLOCK SETLOCK RELEASE,TYPE=CML,ASCB=(11), X RELATED=(CONASCB,GETLOCK) LR R13,R9 L R9,R9SAVE DROP R9 USING STORAGE,R13 *********************************************************8 * ISSUE REPLY TM FLAG,X'80' DID WE WANT TO ISSUE A REPLY BZ SETPROB NO, THEN GO BACK TO PROBLEM STATE NI FLAG,X'7F' RESET FLAG LA R2,MVS_COMMAND GET ADDRESS IN R2 2/6/06 LA R2,0(R2) CLEAR HI-ORDER BYTE 2/6/06 SR R0,R0 CLEAR R0 LA R4,CMDAREA PUT IN REG4 2/6/06 * SVC 34 ISSUE SVC 2/6/06 REM,ADD MGCRE MGCRE TEXT=(R2),CONSID=CONSID,MF=(E,(R4)) SETPROB EQU * DROP R3,R4,R5 MODESET MF=(E,PROBMOD) B GETAREC ************************************************************* * SEARCH ACTIVE ASCB TO FIND JOB * * ************************************************************* DOSTOP LA R10,1(R9) POINT TO BYTE AFTER # TRT 0(8,R10),NBLANK FIND FIRST NON BLANK BZ GETAREC NO, THEN JUST READ NEXT RECORD FOUNDSP CLC 0(5,R1),=C'STOP=' VERIFY VALID COMMAND SYNTAX BE GOTSTOP YES, THEN CONTINUE CLC 0(5,R1),=C'STRT=' VERIFY VALID COMMAND SYNTAX BNE GETAREC NO, THEN LEAVE ALONE OI FLAG,X'08' SET FOR ISSUING CMDS GOTSTOP LA R10,5(R1) POINT TO FIRST CHARACTER STOPSEMI TRT 0(9,R10),SEMICOL SEE IF DELIMETER BZ STOPBLNK WILL NOT PROCESS OI FLAG,X'40' SET FLAG TO SAY DATA AFTER STOP LA R11,1(R1) POINT TO BYTE PAST B GOTLSTJ BRANCH AROUND STOPBLNK TRT 0(9,R10),BLANK FIND BLANK AFTER STOP BZ GETAREC NO, THEN JUST FORGET IT GOTLSTJ SLR R1,R10 GET LENGTH IN R1 LTR R1,R1 IS LENGTH ZERO BZ GETAREC YES, THEN JUST FORGET THIS BCTR R1,0 DECREMENT FOR MOVE MVC JOBNAME(8),BLANKS BLANK IT OUT TO START CLEAN EX R1,MVEJOB MOVE IN JOB NAME TO SEARCH ASCB TM FLAG,X'40' IS THERE AN ACTION IN THIS COMMAND BZ GOTHRUAS NO, THEN GO SEARCH ASCB LR R10,R11 SAVE R11 FOR LATER LA R1,70 GET OVERALL LENGTH TO PARSE SLR R11,R9 GET LENGTH IN R11 SLR R1,R11 AND NOW LENGTH OF COMMAND OR WTO LR R3,R1 SAVE IN R3 FOR LENGTH LA R11,70(R9) POINT R11 TO END OF CONTROL CARD LR R9,R10 READDR R9 TO BEGGINING OF CMD OR WTO GOTHRUAS L R15,16 CVT ADDRESS USING CVT,R15 L R15,CVTASVT ASVT (ADDR SPACE VECTOR TABLE) DROP R15 USING ASVT,R15 L R5,ASVTSTRT SIZE OF START/SASI QUEUE L R1,ASVTNONR SIZE OF NON-REUSABLE QUEUE AR R5,R1 COMBINE L R1,ASVTMAXI MAXUSER AR R5,R1 TOTAL IS LOOP THRU ASVT LA R14,ASVTFRST POINTER FIRST ENTRY LOOPASVT ICM R1,15,0(R14) LOAD UP ASCB ADDRESS OR NEXT ASVT BC 13,INCRASVT BIF HI ORDER ZERO AND REST 0 L R15,176(R1) LOAD POINTER TO JOB NAME LTR R15,R15 ANYTHINGTHERE BZ INCRASVT NO, THEN GET NEXT ADDRESS CLC 0(8,R15),=C'INIT ' IS IT A BATCH JOB BNE COMPJOBN NO, THEN COMPARE WHERE IT IS L R15,172(R1) GET ADDRESS OF BATCH JOBNAME LTR R15,R15 ANYTHING ACTIVE IN THIS INITIATOR BZ INCRASVT NO, THEN GET NEXT ONE COMPJOBN CLC JOBNAME(8),0(R15) IS THIS OUR JOB BE GOTASID YES, THEN STOP LOOKING INCRASVT LA R14,4(R14) POINT TO NEXT ADDRESS BCT R5,LOOPASVT LOOP THRU ALL ADDRESSES ASIDCMD TM FLAG,X'40' DO WE HAVE AN ACTION TO PERFORM BZ GETAREC NO, THEN JUST GET NEXT RECORD NI FLAG,X'BF' RESET 40 TM FLAG,X'08' WAS THIS A STRT= BZ SEEIF_WTOSTOP NO, THEN CHECK IF WTO TO ISSUE NI FLAG,X'F7' RESET FLAG AND GO BACK B GETAREC GET NEXT RECORD SEEIF_WTOSTOP EQU * * FIRST CHECK TO SEE IF THEY WANT TO WAIT A LITTLE BIT LR R14,R9 LA R15,INPUT_RECORD POINT TO BEGINNING LH R2,LENGTH_INPUT GET INITIAL LENGTH OF DATA SR R14,R15 REMOVE THE BEGINNING SR R2,R14 AND TAKE AWAY FROM OVERALL STH R2,LENGTH_INPUT SAVE IT BACK CLI 0(R9),C'#' DID WE WANT TO WAIT ? BE DOWAIT YES, THEN GO PROCESS WAIT CLI 0(R9),C'+' DO WE WANT TO ISSUE A ROLL MSG BE ITSWTO YES, THEN GO DO THE WTO CLI 0(R9),C'@' DO WE WANT TO ROLL THE MESSAGE BE ITSWTO YES, THEN GO DO THE WTO CLI 0(R9),C'/' DO WE WANT TO EXECUTE A REXX EXEC BE DOREXX YES, THEN GO EXECUTE IT B ISSUECMD NO, THEN ISSUE CMD FOR STOP GOTASID TM FLAG,X'40' DID WE HAVE A ; FOR TAKING AN ACTION BZ NOSTOP NO, THEN SET RC TO 12 AND CONTINUE NI FLAG,X'BF' RESET THIS FLAG TM FLAG,X'08' WAS THIS A STRT= REQUEST BZ GETAREC NO, THEN JUST GET NEXT RECORD NI FLAG,X'F7' RESET FLAG * WE ARE GOING TO CHECK TO SEE IF THEY WANTED TO WAIT LONGER LR R14,R9 LA R15,INPUT_RECORD POINT TO BEGINNING LH R2,LENGTH_INPUT GET INITIAL LENGTH OF DATA SR R14,R15 REMOVE THE BEGINNING SR R2,R14 AND TAKE AWAY FROM OVERALL STH R2,LENGTH_INPUT SAVE IT BACK CLI 0(R9),C'#' DID WE WANT TO WAIT ? BE DOWAIT YES, THEN GO PROCESS WAIT CLI 0(R9),C'+' DO WE WANT TO ISSUE A ROLL MSG BE ITSWTO YES, THEN SET IT TO ROLL CLI 0(R9),C'@' DO WE WANT TO ROLL THE MESSAGE BE ITSWTO NO, THEN JUST ISSUE COMMAND B ISSUECMD * NOSTOP WAS OLD CODE TO SET RC 12 IF NO ACTION AND STOP WAS * REQUESTED. LEFT IT IN, BUT DID NOT EXIT PROGRAM NOSTOP MVI RETCODE+3,X'0C' NI FLAG,X'F7' RESET FLAG JUST IN CASE B GETAREC ************************************************************* * PROCESS JES2 AUTOMATIC COMMAND TO SEE IF TIME HAS PAST * * ************************************************************* DOAUTO TRT 1(60,R9),AUTOTABL LOOK FOR $ OR , BZ GETAREC NOTHING, THEN GET NEXT RECORD CLC 0(3,R1),=C'$TA' IS THIS AN AUTOMATIC COMMAND BNE GETAREC NO, THEN DO NOT ISSUE LR R14,R1 SAVE LOCATION COUNTER BCTR R14,0 DECREMENT OFF ONE LA R15,3(R1) INCREMENT PAST PART OF CMD TRT 0(8,R15),AUTOTABL LOOK FOR COMMA BZ GETAREC NOT FOUND THEN JUST READ NEXT REC CLC 1(2,R1),=C'T=' DID THEY SPECIFY A TIME BNE GETAREC NOT SURE, THEN JUST GET OUT CLC 3(5,R1),=C'HH.MM' DO THEY WANT NEXT HOUR VALUE BNE VERIFY_TIME NO, THEN SEE IF TIME PAST MVC 3(5,R1),HOURNEXT MOVE IN NEXT HOUR VALUE B BLANK_SIGN AND GO AROUND VERIFY_TIME EQU * CLC 3(5,R1),HOUR COMPARE OUR TIMES BL GETAREC IF LT CURRENT TIME THEN FORGET BLANK_SIGN EQU * MVI 0(R9),C' ' BLANK OUT = SIGN CR R9,R14 SEE IF ANY DISTANCE BETWEEN $TA BE ISSUECMD NO, THEN JUST ISSUE COMMAND SR R14,R9 GET LENGTH TO CLEAR BCTR R14,0 ONE MORE FOR EXECUTE EX R14,COMPARE_BLANKDAY SEE IF ALL BLANKS ANYWAY BE ISSUECMD YES, THEN JUST GO ISSUE CMD CLC 1(5,R9),=C'EVERY' SHOULD IT BE DONE EVERY DAY BE OKAY_TOISSUE YES, THEN GO ISSUE IT CLC 1(5,R9),=C'FIRST' SHOULD IT BE DONE FIRST OF MONTH BNE VERIFY_LAST NO, THEN CHECK LAST OF MONTH CLC DD(2),=C'01' IT IS THE FIRST BNE GETAREC NO, THEN GET NEXT RECORD B OKAY_TOISSUE YES, THEN GO ISSUE IT VERIFY_LAST EQU * CLC 1(4,R9),=C'LAST' SHOULD IT BE DONE LAST OF MONTH BNE LOAD_WEEK NO, THEN GET THE WEEKDAY CLI LASTDAY,C'Y' DID WE SAY IT WAS LAST OF MONTH BNE GETAREC NO, THEN GET NEXT RECORD B OKAY_TOISSUE YES, THEN GO ISSUE IT LOAD_WEEK SLR R1,R1 CLEAR REG1 FOR INSERT IC R1,DAY_NUMBER GET VALUE OF WEEKDAY HERE LA R1,1(R9,R1) INCREMENT TO LOCATION CLI 0(R1),C'H' EVEN ISSUE ON A HOLIDAY BE OKAY_TOISSUE YES, THEN GO ISSUE IT CLI 0(R1),C' ' IS IT NON-BLANK BE GETAREC NO, THEN DO NEXT COMMAND TM FLAG,X'02' IS IT A HOLIDAY BO GETAREC YES,THEN DO NEXT COMMAND OKAY_TOISSUE EQU * EX R14,BLANKDAY BLANK OUT DATE PORTION OF CMD B ISSUECMD AND ALLOW CMD TO BE ISSUED ************************************************************* EODAD CLOSE CMDIN CLOSE INPUT FILE AND FREESTOR EQU * L R4,RETCODE L R0,GETMAIN_LENGTH LR R1,R13 L R13,4(R13) SO WE CAN GET OUT OF HERE FREEMAIN RC,A=(1),LV=(0) RETURN LR R15,R4 LOAD UP OVERALL RETURN CODE L R14,12(R13) LM R0,R9,20(R13) BR R14 EJECT ************************************************************* * ANY PROBLEMS ENCOUNTERED SET HERE. * ************************************************************* NOREXX EQU * WTO 'UNABLE TO LOAD REXX INTERFACE PROGRAM, IRXJCL' B BUILDBAD BADCONT EQU * WTO 'CONTINUATION NOT ALLOWED ON MORE THAN ONE STATEMENT' B BUILDBAD BAD_COMMAND EQU * WTO 'INVALID COMMAND FORMAT; VERIFY COMMAND.' BUILDBAD LH R15,LENGTH_INPUT CH R15,HW126 BNH DECRBAD LH R15,HW126 DECRBAD STH R15,WTO_LENGTH BCTR R15,0 EX R15,MOVE_COMMAND LA R4,WTO_LENGTH WTO TEXT=((4)) MVI RETCODE+3,X'10' B EODAD ************************************************************* CMDIN DCB DDNAME=CMDIN,MACRF=GL,EODAD=EODAD,DSORG=PS HOLIDAY DCB DDNAME=HOLIDAY,MACRF=GL,EODAD=EODHOL,DSORG=PS, X EXLST=JFCBLIST * 2/6/06 CMDAREA MGCRE MF=L LIST FORM OF MACRO JFCBLIST DS 0F DC X'87',AL3(JFCBAREA) JFCBAREA DC 176C' ' ALEXTDAT DC V(ALEXTDAT) BINARY DC F'500' SUPRMOD MODESET MODE=SUP,KEY=ZERO,MF=L PROBMOD MODESET KEY=NZERO,MODE=PROB,MF=L MVEJOB MVC JOBNAME(0),0(R10) MOVE_WTO MVC COMMAND_TEXT(0),1(R9) MOVE_RECORD MVC INPUT_RECORD(0),0(R1) MOVE_COMMANDC MVC 0(0,R2),0(R9) MOVE_COMMAND MVC COMMAND_TEXT(0),0(R9) PACKTIME PACK DOUBLE_WORD(0),0(0,R10) TRTNUMBR TRT 0(0,R10),NUMTABL **********************************************************8 ONE DC H'1' HW3 DC H'3' HW100 DC H'100' HW126 DC H'126' MOVEMSG MVC REPMSGID(0),0(R11) MVEREPLY MVC COMMAND_TEXT+7(0),0(R11) COMPARE_BLANKDAY CLC 1(0,R9),BLANKS BLANKDAY MVC 1(0,R9),BLANKS COMPMSG CLC REPMSGID(0),0(R11) IS THIS THE CORRECT MSGID * 2/6/06 CONSID DC X'00000000' <- MASTER CONS AUTH MSGIDLN DC X'00' REPMSGID DC CL12' ' REPLYNUM DC CL2' ' BLANKS DC CL16' ' ************************************************************* LTORG SEMICOL DC 256X'00' ORG SEMICOL+C';' DC X'FF' ORG BLANK DC 256X'00' ORG BLANK+C' ' DC X'FF' ORG NBLANK DC 256X'FF' ORG NBLANK+C' ' DC X'00' ORG NUMTABL DC 256X'FF' ORG NUMTABL+C'0' DC 10X'00' ORG AUTOTABL DC 256X'00' ORG AUTOTABL+C'$' DC X'FF' ORG AUTOTABL+C',' DC X'FF' ORG *********************** STORAGE DSECT SAVEAREA DS 18F DOUBLE_WORD DS D GETMAIN_LENGTH DS F RETCODE DS F LOCKSAVE DS 6F SAVE AREA FOR SETLOCK R9SAVE DS F SAVE R9 FOR R13 FOR SETLOCK SASID DS F CONSASID DS H EXITRC DS H COMMASCB DS F MASTCONS DS H PARM_ADDRESS DS F ADDRESS_IRXJCL DS F MSGID_COMPARE DS H MVS_COMMAND EQU * 2/6/06 FOR MGCRE WTO_LENGTH DS H COMMAND_TEXT DS CL126 LENGTH_INPUT DS H INPUT_RECORD DS CL142 MSG DS CL80 JOBNAME DS CL8 REPLYID DS CL6 FLAG DS X FUNCTION_BYTE DS X ** * PARMLIST EQU * HOUR DS CL2 DS C MINUTE DS CL2 DS C SECOND DS CL2 HOURNEXT DS CL5 DATE EQU * MM DS CL2 DS C DD DS CL2 DS C YY DS CL2 JULIAN_DAY DS CL3 DAY_NUMBER DS X LASTDAY DS C DAY_WEEK DS CL9 MONTH DS CL9 YEAR DS CL4 * STORAGE_SIZE EQU *-SAVEAREA * SPACE 1 CVT DSECT=YES IHAASVT DSECT=YES,LIST=YES IHAORE UCM DSECT IEECUCM IHAWQE IHAPSA END