PRINT OFF MACRO IKJCPPL CPPL DSECT CPPLCBUF DC A(0) A(COMMAND BUFFER) CPPLUPT DC A(0) A(UPT) CPPLPSCB DC A(0) A(PSCB) CPPLECT DC A(0) A(ECT) MEND PRINT ON,GEN LCLC &MDLNM,&MDLEP,&MDLVR &MDLNM SETC 'POSTCC' SET THIS MODULE NAME &MDLVR SETC 'R1.2A' SET THIS MODULE VERSION LEVEL &MDLNM TITLE 'DONE WITH SPECIFIED COMPLETION CODE' *********************************************************************** * R1.2A SUPPORT MSP,VOS3 AND MVS3.8(TRADITIONAL MVS OS) * * R1.20 ADD TIMER WAIT OPTION TO SYNCHRONIZE TO OTHER JOB. * * R1.10 AVAILABLE TO RUN WITH TSO COMMAND MODE. * * R1.00 SET SPECIFIED CC FOR JCL COND PARAMETER TEST. * *********************************************************************** EJECT , *=====================================================================* *======= STANDARD HOUSE KEEPING PROCEDURE(SAMPLE) ====================* *=====================================================================* &MDLNM CSECT , DEFINE CODE SECTION ****** AMODE 24 DEFINE DEFAULT AMODE ****** RMODE 24 DEFINE DEFAULT RMODE USING *,12 DEFINE BASE REGISTER SAVE (14,12),, SAVE CALLER REGISTERS + &MDLNM-&MDLVR-&SYSDATE-&SYSTIME LR 12,15 GR12 --> OUR 1ST BASE ADDRESS LR 15,13 SAVE CALLER SAVEAREA CNOP 0,4 INSURE FULL WORD BOUNDARY BAL 13,*+4+72 AROUND OUR SAVEAREA DC 18F'-1' OUR GPR SAVEAREA ST 15,4(,13) SAVE CALLER SAVEAREA POINTER ST 13,8(,15) FORWARD CHAIN FOR LINK TRACE B MAINPROC DO MAINLINE PROCESSING *---------------------------------------------------------------------* * EXIT PROCESSING * *---------------------------------------------------------------------* SYSABEND DS 0H ABEND (15),,,SYSTEM REQUEST SYSTEM ABEND USRABEND DS 0H ABEND (15),,,USER REQUEST USER ABEND SLEEP DS 0H MH RF,=H'100' CONVERT TO 1/100SEC UNIT ST RF,SLPTIMR STORE WAITING TIME STIMER WAIT,BINTVL=SLPTIMR WAIT SPECIFIED SECOND AT HERE LTR R2,R2 SPECIFIED COMPLETION CODE ? BZ EXITPROC NO, DONE CC=0 LR R1,R2 COPY PARM ADDRESS LR R0,R3 COPY PARM LENGTH B CHKCCTYP EXTRACT SPECIFIED COMP CODE SPACE , EXITPROC DS 0H L RD,4(,RD) LOAD CALLER SAVEAREA ST RF,16(,RD) PASS RETURN CODE TO CALLER LM RE,RC,12(RD) RESTORE CALLER REGISTERS BR RE RETURN TO CALLER EJECT , *********************************************************************** * MAIN LINE PROCEDURE * *---------------------------------------------------------------------* * GR0 ----> N/A * * GR1 ----> EXEC PARAMETER PLIST * * GR12 ---> BASE ADDRESS * * GR13 ---> OUR GPR SAVEAREA * *---------------------------------------------------------------------* * OPERATION: * * EXEC PGM=POSTCC,PARM=CC VALUE AS FOLLOWS, * * PARM=9999 DO NORMAL END WITH 0000-4095. * * PARM=U9999 DO ABEND WITH U0000-U4095. * * PARM=SXXX DO ABEND WITH S001-SFFF. * * PARM=W9999 DO SLEEP WITH 99.99SECOND. * * PARM=W9999[,U|S|9999] SLEEP WITH ANY COMP CODE. * * * * //STEP1 EXEC PGM=POSTCC,COND=EVEN,PARM=0 * * //STEP2 EXEC PGM=POSTCC,COND=EVEN,PARM=38 * * //STEP3 EXEC PGM=POSTCC,COND=EVEN,PARM=U123 * * //STEP4 EXEC PGM=POSTCC,COND=EVEN,PARM=S0C7 * * //STEP5 EXEC PGM=POSTCC,COND=EVEN * * //* * * //STEP6 EXEC PGM=POSTCC,COND=EVEN,PARM='W10' * * //STEP7 EXEC PGM=POSTCC,COND=EVEN,PARM='W5,U747' * * //STEP8 EXEC PGM=POSTCC,COND=EVEN,PARM='W7,S0C3' * * //STEP9 EXEC PGM=POSTCC,COND=EVEN,PARM='W12,43' * * // * * * * INPUTS: * * GR1 --- STANDARD EXEC PARAMETER LIST ADDRESS. * * GR1 --> +-------------------+ * * I A(EXEC PARAMETER) I * * +-------------------+ * * EXEC PARAMETER * * +------------------+--------------------------+ * * I H(STRING LENGTH) I CL100'PARAMETER STRINGS' I * * +------------------+--------------------------+ * * * * GR1 --- TSO CPPL * * GR1 --> +-+---------+-+---------+-+---------+-+---------+ * * I0I A(CBUF) I0I A(UPT) I0I A(PSCB) I0I A(ECT) I * * +-+---------+-+---------+-+---------+-+---------+ * * CBUF STRUCTURE * * +-----------------+-------------------+ * * I H(TOTAL LENGTH) I H(OFFSET TO PARM) I * * +-----------------+-------------------+---------+ * * I CL???'VERB+PARAMETER STRINGS' I * * +-----------------------------------------------+ * *********************************************************************** MAINPROC DS 0H *=====================================================================* * EXTRACT COMMAND PARAMETER STRING * * ===================================================== * * GR0 ----> N/A * * GR1 ----> OS EXEC PARAMETER LIST OR TSO/CPPL * *=====================================================================* * *----------------------------------* * * EXTRACT COMMAND PARAMETER * * * (1ST FETCH REQUEST PROGRAM AND * * * PARAMETER STRING) * * * ============================== * * * GR1 CONTAIN PLIST OF EXEC PARM * * * OR TSO CPPL. * * *----------------------------------* TM 0(R1),X'80' PLIST HAS ONLY 1WORD ? BNO CMNDPARM NO, WE ARE TSO COMMAND PROCESSOR AND GR1 POINTED TSO CPPL + YES, WE CALLED BY TSO CALL CMD SPACE , CALLPARM DS 0H L R1,0(,R1) LOAD EXEC PATAMETER ADDRESS LH R0,0(,R1) GR0 --> LENGTH OF PARM STRING LA R1,2(,R1) GR1 --> BEGIN OF PARM STRING B ENDXPARM SPACE , CMNDPARM DS 0H GR1 POINTED TO TSO CPPL OI STSORUN,MTSORUN INDICATE WE RUN UNDER TSO L R1,CPPLCBUF-CPPL(,R1) LOAD COMMAND BUFFER AREA LH RF,2(,R1) LOAD COMMAND VERB LENGTH + (WITH TRAILING BLANK) LA RE,4(RF,R1) LOCATE TO BEGIN OF STRING LH RF,0(,R1) LOAD COMMAND VERB+PARM LENGTH SH RF,2(,R1) SUBTRACT VERB LENGTH SH RF,=H'4' SUBTRACT HEADER FIELD LENGTH + GR14: BEGIN OF PARAMETER STRING+ GR15: PARAMETER STRING LENGTH LR R4,RE SAVE COMMAND PARAMETER POINTER LR R5,RF SAVE COMMAND PARAMETER LENGTH LH R0,2(,R1) LOAD COMMAND VERB LENGTH AGAIN LA R1,4(,R1) LOCATE BEGIN OF COMMAND VERB LR R2,R1 SAVE COMMAND VERB POINTER CLI 0(R1),C' ' END OF COMMAND VERB ? BE *+4+4+4 YES, LA R1,1(,R1) NO, LOCATE TO NEXT VERB BYTE BCT R0,*-4-4-4 LOOP UNTIL END OF COMMAND VERB SLR R1,R2 CALCULATE ACTUAL CMD VERB LNGTH LR R3,R1 SAVE COMMAND VERB LENGTH + GR2 --> COMMAND VERB ADDRESS ************************************** GR3 --> COMMAND VERB LENGTH ************************************** GR4 --> COMMAND PARM ADDRESS ************************************** GR5 --> COMMAND PARM LENGTH LR R0,R5 LR R1,R4 ENDXPARM DS 0H GR0 --> LENGTH OF PARM STRING + GR1 --> BEGIN OF PARM STRING SPACE , LA RF,0 SET DEFAULT CC LTR R0,R0 SPECIFIED EXEC PARAMETER ? BNZ CHK2NDPM YES, TEST 2ND PARAMETER TM STSORUN,MTSORUN WE RUN UNDER TSO ? BNO EXITPROC NO, DONE WITH CC=0 SPACE , * *----------------------------------* * * QUERY COMPLETION CODE * * * ============================== * * * - USE QSAM TO GET COMPLETION * * * CODE STRING FROM TERMIANL. * * *----------------------------------* OPEN (SYSIN,INPUT) OPEN SYSIN(TERMINAL) GET SYSIN GET COMPLETION CODE MVC INPUTXT,0(R1) MOVE 1ST 9BYTES TO OUR AREA CLOSE (SYSIN) CLOSE SYSIN(TERMINAL) SLR R0,R0 GET LENGTH OF ENTERED TEXT LNG LA R1,INPUTXT I LR RE,R1 I CLI 0(RE),C' ' I BNH *+4+4+4+4 I AH R0,=H'1' I LA RE,1(,RE) I B *-4-4-4-4 V SPACE , * *----------------------------------* * * TEST 2ND PARAMETER * * * ============================== * * * - GR0 --> PARM STRING LENGTH * * * GR1 --> PARM STRING AREA * * *----------------------------------* CHK2NDPM DS 0H SLR R2,R2 INDICATE NO 2ND PARM MVI SCANTAB+C',',4 SEARCH C',' (END OF 1ST PARM) LR RE,R1 COPY PARM ADDRESS LR RF,R0 COPY PARM LENGTH BCTR RF,0 MAKE IT A S/370 LENGTH EX RF,PARSTRT FIND END OF 1ST PARAMETER + (GR1: FOUND ADDRESS) *************************************** (GR2: FOUND ARGBYTE) *************************************** ( HI-ORDER 3BYTES CONTAIN ) *************************************** ( BEFORE TRT INSTRUCTION. ) *************************************** (BC 8,NOT FOUND) *************************************** (BC 4,FOUND IT) *************************************** (BC 2,FOUND IT ON LAST BYTE) BC 8,CHKCCTYP IF NOT FOUND, 1ST PARM ONLY BC 4,*+4+4 FOUND IN STRING, BRANCH BY ARG BC 2,CHKCCTYP FOUND IN STRING AT LAST + CHARACTER, THEREFORE IGNORE IT. SPACE , LA R2,1(,R1) SAVE 2ND PARM ADDR LR R0,R1 SLR R0,RE ADJUST 1ST PARM LENGTH LR R1,RE RESTORE 1ST PARM ADDRESS LR R3,RF SLR R3,R0 SAVE 2ND PARM LENGTH B CHKCCTYP CONTINUE PROCESSING... SPACE , * *----------------------------------* * * SET COMPLETION CODE * * * ============================== * * * - CONVERT (HEX)DECIMAL TEXT TO * * * BINARY INTO GR15. * * *----------------------------------* CHKCCTYP DS 0H CLI 0(R1),C'S' REQUESTED SYSTEM ABEND ? BE CNVHEXCH YES, SPACE , LR RE,R1 COPY PARM ADDRESS LR RF,R0 COPY PARM LENGTH CLI 0(RE),C'0' REQUESTED NORMAL COMPLETION ? BNL *+4+4+2 YES, LA RE,1(,RE) LOCATE TO BEGIN OF ABEND CODE BCTR RF,0 CORRECT REMAINING LENGTH BCTR RF,0 MAKE IT A S/370 LENGTH EX RF,*+4+4 CONVERT TO DECIMAL B *+4+6 (SKIP MODEL INSTRUCTION) PACK DOUBLE,0(0,RE) PACK SPECIFIED DECIMAL VALUE CVB RF,DOUBLE CONVERT TO BINARY SPACE , CLI 0(R1),C'U' REQUESTED USER ABEND ? BE USRABEND YES, DO IT SPACE , CLI 0(R1),C'W' REQUESTED TIMER WAIT(SLEEP) ? BE SLEEP YES, SPACE , B EXITPROC NO, DONE WITH SPECIFIED CODE SPACE , CNVHEXCH DS 0H LA R1,1(,R1) LOCATE TO BEGIN OF HEX-TEXT BCTR R0,0 CORRECT REMAINING LENGTH BAL RE,CNVXTR CONVERT IT TO BINARY LR RF,R0 SET SYSTEM ABEND CODE B SYSABEND DO IT EJECT , *********************************************************************** * I N T E R N A L S U B R O U T I N E S * *********************************************************************** PARSTRT TRT 0(0,RE),SCANTAB SEARCH DELIMITER *---------------------------------------------------------------------* * CNVXTR - CONVERT HEX DECIMAL-TEXT TO BINARY (REGISTER TYPE) * * CALL INTERFACE - * * GR0: HEX DECIMAL-TEXT LENGTH * * GR1: HEX DECIMAL-TEXT ADDRESS * * GR13: 18WORDS STANDARD SAVEAREA * * BAS 14,CNVXTR * * OUTPUTS - * * GR0: FULL-WORD BINARY * * GR15: RETURN CODE * * 0: CONVERSION COMPLETED * * 4: LENGTH ERROR * * 8: DATA VALIDATION ERROR * *---------------------------------------------------------------------* CNVXTR DS 0H LA 15,4 SET LENGTH ERROR LTR 0,0 CHECK LENGTH BNPR 14 IF NOT PLUS CH 0,=H'8' MORE THAN 8DIGITS ? BHR 14 YES, AVOID OVERFLOW ST 14,12(,13) (CNVDWRK) SAVE RETURN ADDRESS ST 1,16(,13) (CNVDWRK+4) SAVE INPUT PARAMETER LR 14,0 GR14 -> LENGTH LR 15,1 GR15 -> ADDRESS CNVXTR10 DS 0H CLI 0(15),C'A' LESS THAN A ? BL CNVXTRER YES, DATA ERROR CLI 0(15),C'9' MORE THAN 9 ? BH CNVXTRER YES, DATA ERROR CLI 0(15),C'0' MORE THAN 0 ? BNL CNVXTR11 YES, CHECK NEXT CLI 0(15),C'F' MORE THAN F ? BH CNVXTRER YES, DATA ERROR SLR 1,1 IC 1,0(,15) GET HEX-BYTE(A-F) LA 1,57(,1) CONVERT TO ZONE(XFA-XFF) STC 1,0(,15) SET HEX-BYTE(A-F) CNVXTR11 DS 0H LA 15,1(,15) SET NEXT BYTE BCT 14,CNVXTR10 TEST NEXT BYTE L 14,12(,13) (CNVDWRK) RESTORE RETURN ADDRESS L 1,16(,13) (CNVDWRK+4) RESTORE INPUT PARAMETER LR 15,0 GR15 -> LENGTH BCTR 15,0 EX 15,CNVMVHEX MOVE TO WORKAREA LA 15,12(15,13) (CNVDWRK) GET SIGN POINTER MVI 1(15),X'C0' SET DUMMY SIGN LR 15,0 !!! NEVER MINUS 1 !!! EX 15,CNVPKHEX CONVERT TO HEX-DECIMAL L 0,20(,13) (CNVFWRK) SET INTO GR0 SLR 15,15 CLEAR RETURN CODE BR 14 RETURN TO CALLER CNVXTRER DS 0H LA 15,8 SET VALIDATION ERROR L 14,12(,13) (CNVDWRK) RESTORE RETURN ADDRESS L 1,16(,13) (CNVDWRK+4) RESTORE INPUT PARAMETER BR 14 RETURN TO CALLER CNVMVHEX MVC 12(0,13),0(1) (CNVDWRK) MOVE TO WORKAREA CNVPKHEX PACK 20(5,13),12(0,13) (CNVFWRK) CONVERT TO HEX-DECIMAL *---------------------------------------------------------------------* EJECT , *********************************************************************** * DATA AREA (CONSTANTS) * *********************************************************************** DS 0D * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* SPACE , *********************************************************************** * DATA AREA * *********************************************************************** * *----------------------------------* * * MISCELLANEOUS * * *----------------------------------* DOUBLE DC D'0' DOUBLE WORD WORKAREA SLPTIMR DC F'0' SLEEP TIMER VALUE(1/100SEC) FLAGS DC XL1'00' CONTROL FLAGS STSORUN EQU *-1,1 MTSORUN EQU X'80' RUN UNDER TSO INPUTXT DC CL9' ' INPUT COMMAND PARM(TSO ONLY) SPACE , SCANTAB DC XL256'00' CHARACTER SCAN TABLE SPACE , * *----------------------------------* * * QSAM I/O CONTROLS AND WORKS * * *----------------------------------* SYSIN DCB DDNAME=SYSIN, + MACRF=GL,DSORG=PS,RECFM=FB,LRECL=80 *---------------------------------------------------------------------* LTORG , USER LITERAL PLACE AT HERE DROP , FORGET ALL BASE REGISTER *********************************************************************** * DATA AREA (OUTSIDE OUR BASE) * *********************************************************************** *---------------------------------------------------------------------* * LOCAL WORKAREA * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * LOCAL DSECTS * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * GLOBAL DSECTS * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * S/370, ESA/390 REGISTER EQUATES * *---------------------------------------------------------------------* *------- YREGS , OS: REGISTER EQUATES R0 EQU 0 GENERAL REGISTER 0 R1 EQU 1 GENERAL REGISTER 1 R2 EQU 2 GENERAL REGISTER 2 R3 EQU 3 GENERAL REGISTER 3 R4 EQU 4 GENERAL REGISTER 4 R5 EQU 5 GENERAL REGISTER 5 R6 EQU 6 GENERAL REGISTER 6 R7 EQU 7 GENERAL REGISTER 7 R8 EQU 8 GENERAL REGISTER 8 R9 EQU 9 GENERAL REGISTER 9 RA EQU 10 GENERAL REGISTER 10 RB EQU 11 GENERAL REGISTER 11 RC EQU 12 GENERAL REGISTER 12 RD EQU 13 GENERAL REGISTER 13 RE EQU 14 GENERAL REGISTER 14 RF EQU 15 GENERAL REGISTER 15 *---------------------------------------------------------------------* * OS CONTROL BLOCKS * *---------------------------------------------------------------------* PRINT NOGEN IKJCPPL , TSO CPPL END