PUNCH ' SETCODE AC(1) ' 00010000 MACRO 00020000 &L $AUTHON 00030000 &L LA R1,=C'AUTH' 00040000 SVC 999 REPLACE WITH YOUR OWN AUTHORIZATION SVC 00050000 MEND 00060000 MACRO 00070000 &L $AUTHOFF 00080000 &L LA R1,=C'NONE' 00090000 SVC 999 REPLACE WITH YOUR OWN AUTHORIZATION SVC 00100000 MEND 00110000 ********************************************************************** 00120000 * * 00130000 * ATTR: NORENT, REUSE, AMODE=31, RMODE=24 ,AC=1 * 00140000 * EITHER USE AN AUTHORIZATION SVC OR * 00150000 * LINK YOUR COPY OF FIXDSCB WITH AC=1 * 00160000 * INTO AN AUTHORIZED LIBRARY AND THEN * 00170000 * IF YOU WANT TO USE IT FROM TSO THEN: * 00180000 * UPDATE YOUR IKJTSO00 TO ADD FIXDSCB TO AUTHCMD AND THEN* 00190000 * ISSUE TSO PARMLIB UP(00) TO AUTHORIZE * 00200000 * * 00210000 * F I X D S C B * 00220000 * * 00230000 * THIS IS A SYSTEM PROGRAMMER UTILITY PROGRAM DESIGNED * 00240000 * TO FACILITATE THE MODIFICATION (OR REPAIR) OF DATA SET * 00250000 * CONTROL BLOCKS (DSCB'S). THIS PROGRAM DOES NOT DO * 00260000 * ANY TYPE OF SECURITY VALIDATION. CHANGES ARE MADE TO * 00270000 * THE DSCB'S AS REQUESTED, WITHOUT REGARD TO THEIR * 00280000 * CORRECTNESS OR APPLICABILITY TO THE SPECIFIC DATASET. * 00290000 * TO SOME PERSONS (AUDITORS OR SECURITY TYPES IN PARTICULAR) * 00300000 * THIS PROGRAM WILL REPRESENT ONE BIG INTEGRITY EXPOSURE. * 00310000 * SOME MEANS MUST BE FOUND TO CONTROL THE AVAILABILITY * 00320000 * AND USE OF THIS UTILITY. THIS RESPONSIBILITY IS LEFT * 00330000 * TO THE INDIVIDUAL SHOP TO IMPLEMENT. * 00340000 * * 00350000 * AUTHOR: DAVID ALAN WEAVER * 00360000 * AMDAHL SYSTEMS ENGINEER * 00370000 * HOUSTON LIGHTING & POWER * 00380000 * * 00390000 * DATE WRITTEN: NOVEMBER, 1979 * 00400000 * * 00410000 * RELEASE LEVEL 1.0 * 00420000 * * 00430000 * MODIFICATION RECORD: * 00440000 * * 00450000 * MODIFIED: SAM BASS (SJB) * 00460000 * OCCIDENTAL PETROLEUM INC * 00470000 * BMC SOFTWARE * 00480000 * MCLANE CO. INC * 00490000 * * 00500000 * DATE INITIALS MODIFICATION * 00510000 * 12/15/79 DAW CHANGED TO RUN UNDER TSO AS A CP * 00520000 * 01/01/80 DAW CHANGED TO REQUIRE OPER STATUS UNDER TSO * 00530000 * 06/29/84 SJB CHANGE TO EXCLUDE INDEXED VTOCS AND FIX * 00540000 * DYNAMIC ALLOCATION. * 00550000 * 04/29/88 SJB CHANGE TO USE CVAF MACROS AND WORK WITH * 00560000 * INDEX VTOCS * 00570000 * 08/13/90 SJB FIX DISASTER ERROR AFTER ENTERING A * 00580000 * NON-EXISTING DATASET NAME * 00590000 * 08/13/90 SJB ADDED RESERVE/DEQ LOGIC * 00600000 * 08/01/91 SJB ADDED SUPPORT FOR ALL NUMBER VOLSERS * 00610000 * INSERT A 'V' AHEAD OF VOLSER * 00620000 * 09/12/91 SJB ADDED RACFON AND RACFOFF COMMANDS * 00630000 * 03/18/92 SJB ADDED DEQUE IF READDSCB ERROR * 00640000 * 03/18/92 SJB ADDED ESTAE TO TURN OFF AUTHORIZATION * 00650000 * 05/08/92 SJB MOVED VOLSTAT BACK INTO RIGHT PLACE * 00660000 * FIXED READDSCB NOT SETTING ERROR RET * 00670000 * * 00680000 * * 00690000 *********************************************************************** 00700000 EJECT 00710000 *********************************************************************** 00720000 * * 00730000 * OPERATION: FIXDSCB MUST BE LINKEDITED WITH AN AUTHORIZATION * 00740000 * CODE OF 1 AND PLACED IN AN AUTHORIZED LIBRARY. * 00750000 * * 00760000 * FIXDSCB OPERATES IN ONE OF THREE MODES: BATCH, TSO, OR * 00770000 * STARTED TASK. WHEN EXECUTED AS A BATCH PROGRAM * 00780000 * ALL I/O IS HANDLED THROUGH SYSIN/SYSPRINT DD * 00790000 * CARDS. WHEN EXECUTED AS A STARTED TASK ALL I/O * 00800000 * IS DONE VIA WTO/WTOR THROUGH THE STARTING CONSOLE. * 00810000 * WHEN EXECUTED AS A TSO COMMAND PROCESSOR ALL I/O * 00820000 * IS DONE VIA TPUT/TGET TO THE TSO SESSION. * 00830000 * NOTE: UNDER MVS, IF FIXDSCB IS TO BE USED UNDER TSO * 00840000 * THE NAME IT IS LINKEDITED UNDER MUST BE ADDED * 00850000 * TO THE COMMAND AUTHORIZATION TABLE (IKJEFTE2) * 00860000 * IN THE TMP (IKJEFT02). SEE THE SPL: TSO FOR * 00870000 * DETAILS ABOUT USING AUTHORIZED COMMANDS UNDER * 00880000 * TSO. * 00890000 * * 00900000 * IF AN EXECUTION PARAMETER OF "TEST" IS SUPPLIED * 00910000 * DURING ANY EXECUTION OF FIXDSCB, NO MODIFICATIONS * 00920000 * WILL BE APPLIED TO ANY DSCB. THE PROGRAM WILL * 00930000 * SIMPLY RUN THROUGH IT'S LOGIC. * 00940000 * * 00950000 * ALL PRIMARY COMMANDS (SEE BELOW) MUST SUPPLY * 00960000 * A DATASET NAME AND THE VOLUME SERIAL ON WHICH * 00970000 * IT RESIDES. THIS CRITERIA WAS CHOSEN OVER CATALOG * 00980000 * SEARCHES TO AVOID THE ACCIDENTAL MODIFICATION OF * 00990000 * A DSCB OF THE SAME NAME ON ANOTHER VOLUME THAN * 01000000 * INTENDED IF THE CATALOG POINTS SOMEWHERE ELSE. * 01010000 * THE THEORY IS: IF YOU KNOW IT NEEDS TO BE FIXED * 01020000 * THEN YOU BETTER KNOW WHERE IT IS. * 01030000 * * 01040000 * FIXDSCB WILL OPERATE UNDER SVS OR MVS. * 01050000 * WHEN USED UNDER MVS SOME ADDITIONAL FLEXIBILITY IS * 01060000 * GAINED BY THE FACT THAT FIXDSCB WILL DYNAMICALLY ALLO- * 01070000 * CATE THE SPECIFIED VOLUME IF IT CANNOT FIND A REFER- * 01080000 * ENCE TO IT IN THE TIOT. THIS ALLOWS A VERY SIMPLE * 01090000 * PROC TO BE USED FOR STARTED TASK. UNDER SVS YOU WILL * 01100000 * HAVE TO INCLUDE AN ANYNAME DD CARD FOR EACH VOLUME * 01110000 * YOU INTEND TO MODIFY. FOR MVS BATCH USAGE, IT IS * 01120000 * SUGGESTED THAT YOU INCLUDE AN ANYNAME DD CARD FOR * 01130000 * EACH VOLUME TO BE MODIFIED TO SAVE THE OVERHEAD OF * 01140000 * ALLOCATING THEM DYNAMICALLY. * 01150000 * * 01160000 * NOTE: IT IS ENTIRELY POSSIBLE (USING THIS UTILITY) * 01170000 * TO RENAME A DATSET TO A NAME WHICH ALREADY * 01180000 * EXIST ON THE PACK. CAUTION SHOULD BE USED * 01190000 * WHEN DOING RENAMES TO SEE THAT THIS CONDITION * 01200000 * DOES NOT ARISE. * 01210000 * SUBNOTE: THIS "FLAW" WAS LEFT IN INTENTIONALLY. * 01220000 * I LEAVE IT TO YOUR IMAGINATION JUST HOW * 01230000 * IT COULD BE EXPLOITED CONSTRUCTIVELY. * 01240000 * * 01250000 * * 01260000 * * 01270000 *********************************************************************** 01280000 EJECT 01290000 *********************************************************************** 01300000 * * 01310000 * A WORD OR TWO ABOUT THE SCRATCH COMMAND: * 01320000 * * 01330000 * THE SCRATCH PRIMARY COMMAND IS EXECUTED IN A RATHER * 01340000 * UNIQUE WAY. THE DATASET IS FIRST RENAMED TO A SPECIAL * 01350000 * NAME (FIXDSCB.SCRATCH.DATASET) AND ANY EXPIRATION DATE * 01360000 * AND PASSWORD FLAGS ARE SET TO ZERO. THE RENAMED * 01370000 * DATASET IS THEN SCRATCHED VIA THE SCRATCH SVC. * 01380000 * THIS PROCEDURE FACILITATES SCRATCHING DATASETS WHICH * 01390000 * MAY HAVE THE SAME NAME AS A DATASET WHICH IS OPEN * 01400000 * (AND THUS ENQUED) ON ANOTHER PACK (SUCH AS SYS1.LINKLIB). * 01410000 * THIS ALSO MAKES IT POSSIBLE TO SCRATCH A DATASET * 01420000 * WHICH IS REALLY OPEN BY SOME OTHER TASK SO BE VERY * 01430000 * CAUTIOUS IN USING THIS COMMAND. * 01440000 * * 01450000 *********************************************************************** 01460000 SPACE 3 01470000 *********************************************************************** 01480000 * * 01490000 * FIXDSCB PROGRAM INFORMATION: * 01500000 * * 01510000 * * 01520000 * FUNCTION: TO MODIFY A DATASETS DSCB ACCORDING TO SUPPLIED * 01530000 * COMMANDS. SUPPORTED FUNCTIONS ARE: * 01540000 * * 01550000 * RENAME .......... RENAME A DATASET TO A NEWNAME * 01560000 * PROTECT ......... TURN ON A DSCB'S PASSWORD BITS * 01570000 * RACFON ......... TURN ON A DSCB'S RACF BIT * 01580000 * RACFOFF ......... TURN OFF A DSCB'S RACF BIT * 01590000 * SETNOPWR ........ TURN ON A DSCB'S NOPASSWORD READ ENABLE * 01600000 * UNLOCK .......... TURN OFF A DSCB'S PASSWORD&RACF BIT S * 01610000 * RENEW ........... RESET CREATION DATE TO CURRENT DATE * 01620000 * EXPIRE .......... SWAP CREATION AND EXPIRATION DATES * 01630000 * EXTEND .......... SET EXPIRATION DATE TO 99:365 * 01640000 * ZEROEXPD ........ SET EXPIRATION DATE TO 00:000 * 01650000 * SCRATCH ......... DELETE SPECIFIED DATASET * 01660000 * * 01670000 * IN ADDITION TO THESE FUNCTIONS A NAME DEFINITION CARD * 01680000 * FOLLOWED BY SUBCOMMAND CARDS PERTAINING TO THAT * 01690000 * DATASET MAY BE ENTERED. VALID SUBCOMMANDS ARE: * 01700000 * * 01710000 * RECFM ........... RESET RECORD FORMAT TO THAT SPECIFIED * 01720000 * LRECL ........... RESET LRECL TO SPECIFIED VALUE * 01730000 * BLKSIZE ......... RESET BLKSIZE TO SPECIFIED VALUE * 01740000 * DSORG ........... RESET DSORG TO THAT SPECIFIED * 01750000 * KEYL ............ RESET KEY LENGTH TO THAT SPECIFIED * 01760000 * RKP ............. RESET RELATIVE KEY POSITION * 01770000 * OPTCODE ......... RESET OPTCODE VALUE (SEE JCL MANUAL) * 01780000 * * 01790000 *********************************************************************** 01800000 EJECT , 01810000 *********************************************************************** 01820000 * * 01830000 * COMMAND FORMATS ARE AS FOLLOWS: * 01840000 * * 01850000 * INPUT IS FREE FORM RESTRICTED ONLY THAT COMMANDS MAY BEGIN IN * 01860000 * COLUMN 1 OR AFTER AND SUBCOMMANDS OF THE NAME COMMAND MUST BEGIN * 01870000 * IN COLUMN 2 OR AFTER. * 01880000 * THE KEYWORDS VOLUME, DSNAME, AND NEWNAME MAY APPEAR IN ANY ORDER. * 01890000 * * 01900000 * AT LEAST ON KEYWORD MUST APPEAR ON THE COMMAND CARD. COMMAND * 01910000 * CARDS MAY BE CONTINUED ONTO A NEW CARD. CONTINUE CARDS ARE * 01920000 * FREE FORMAT (COL 1-71 MAY BE USED). EMBEDDED BLANKS MAY NOT * 01930000 * APPEAR IN THE KEYWORD STRINGS. COMMENTS MAY BE ENTERED ON * 01940000 * COMMAND CARDS BY SEPERATING THEM FROM ANY VALUES BY AT LEAST * 01950000 * ONE BLANK. COMMENT CARDS MAY BE CODED BY PLACING AN ASTERISK * 01960000 * IN COLUMN 1. COMMENT CARDS MAY APPEAR ANYWHERE IN THE INPUT * 01970000 * STREAM. * 01980000 * NOTE: COLUMN 72 MUST CONTAIN A BLANK AT ALL TIMES * 01990000 * * 02000000 * CARD FORMATS: * 02010000 * RENEW VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02020000 * RACFON VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02030000 * RACFOFF VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02040000 * PROTECT VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02050000 * UNLOCK VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02060000 * EXPIRE VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02070000 * EXTEND VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02080000 * RENAME VOLUME=XXXXXX,DSNAME=DATASET-NAME,NEWNAME=NEW-DATASET-NAME * 02090000 * SCRATCH VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02100000 * NAME VOLUME=XXXXXX,DSNAME=DATASET-NAME * 02110000 * WHERE: * 02120000 * XXXXXX IS THE DASD VOLUME SERIAL THAT CONTAINS THE * 02130000 * DATASET (DSCB) TO BE MODIFIED. * 02140000 * DATASET-NAME IS THE NAME OF THE DATA SET (DSCB) TO * 02150000 * BE MODIFIED. * 02160000 * NEW-DATASET-NAME IS THE NEW NAME TO BE ASSIGNED TO THE * 02170000 * DATASET SPECIFIED BY THE DSNAME KEYWORD (RENAME COMMAND ONLY). * 02180000 * * 02190000 * KEYWORDS MAY BE ABBREVIATED AS FOLLOWS: * 02200000 * * 02210000 * DSNAME - DSN OR D * 02220000 * VOLUME - VOL OR V * 02230000 * NEWNAME- NEWN OR N * 02240000 * * 02250000 *********************************************************************** 02260000 SPACE 3 02270000 *********************************************************************** 02280000 * * 02290000 * NAME COMMAND: SUBCOMMAND SPECIFICATIONS * 02300000 * * 02310000 * NAME VOLUME=XXXXXX,DSNAME=DATASET-NAME (SEE ABOVE) * 02320000 * NOTE: THE NAME CARD DEFINES A DATASET DSCB TO BE WORKED ON. * 02330000 * ALL MODIFICATION CARDS THAT FOLLOW IT PERTAIN TO THAT * 02340000 * DATASET UNTIL ANOTHER PRIMARY COMMAND IS ENCOUNTERED * 02350000 * (RENEW, SCRATCH, EXPIRE, ETC...) OR AN END-OF-FILE * 02360000 * OCCURS. * 02370000 * * 02380000 * LRECL=XXXXX (WHERE XXXXX IS THE DESIRED LRECL) * 02390000 * BLKSIZE=XXXXX (WHERE XXXXX IS THE DESIRED BLOCK SIZE) * 02400000 * RECFM=XXXXX (WHERE XXXXX IS THE DESIRED RECORD FORMAT) * 02410000 * (SEE RECFMTAB FOR SUPPORTED RECFM VALUES) * 02420000 * DSORG=XXX (WHERE XXX IS THE DESIRED DATASET ORGANIZATION) * 02430000 * (CAUTION: NO CHECKING IS DONE!) * 02440000 * (SEE DSORGTAB FOR SUPPORTED DSORG VALUES) * 02450000 * KEYL=XXX (WHERE XXX IS THE DESIRED KEY LENGTH) * 02460000 * RKP=XXX (WHERE XXX IS THE DESIRED RELATIVE KEY POSITION) * 02470000 * OPTCODE=X (WHERE X IS THE DESIRED OPTCODE LETTER) * 02480000 * * 02490000 * ONLY ONE DSNAME SUBCOMMAND IS ALLOWED PER CARD. * 02500000 * IF A PARTICULAR SUBCOMMAND IN ENTERED MORE THAN * 02510000 * ONCE THE LAST OCCURENCE OF THE SUBCOMMAND WILL * 02520000 * BE THE ONE USED. IF AN ERROR OCCURS DURING PROCESSING * 02530000 * OF ANY SUBCOMMAND THE ENTIRE SUBCOMMAND SET * 02540000 * FOR THE CURRENT NAME COMMAND WILL BE DISCARDED. * 02550000 * * 02560000 * * 02570000 *********************************************************************** 02580000 EJECT 02590000 *********************************************************************** 02600000 * * 02610000 * REGISTER USAGE: * 02620000 * * 02630000 * R0 ..... LOCAL USAGE * 02640000 * R1 ..... LOCAL USAGE * 02650000 * R2 ..... LOCAL USAGE * 02660000 * R3 ..... LOCAL USAGE * 02670000 * R4 ..... LOCAL USAGE * 02680000 * R5 ..... POINTER TO CARD KEYWORDS (SCAN POINTER) * 02690000 * R6 ..... BAL TO CARD SCAN LOGIC (COMCARD) * 02700000 * R7 ..... ADDRESS TO BUFLIST * 02710000 * R8 ..... ADDRESS CVAF PARAMETER * 02720000 * R9 ..... ADDRESS DSCB DSCBAREA * 02730000 * R10 ..... PROGRAM BASE REGISTER 1 * 02740000 * R11 ..... PROGRAM BASE REGISTER 2 * 02750000 * R12 ..... PROGRAM BASE REGISTER 3 * 02760000 * R13 ..... SAVE AREA CHAIN POINTER * 02770000 * R14 ..... RETURN REG * 02780000 * R15 ..... ENTRY REG * 02790000 * * 02800000 *********************************************************************** 02810000 SPACE 3 02820000 *--------------------------------------------------------------------* 02830000 * REGISTER AND OTHER EQUATES * 02840000 *--------------------------------------------------------------------* 02850000 SPACE 3 02860000 R0 EQU 0 02870000 R1 EQU 1 02880000 R2 EQU 2 02890000 R3 EQU 3 02900000 R4 EQU 4 02910000 R5 EQU 5 02920000 R6 EQU 6 02930000 R7 EQU 7 02940000 R8 EQU 8 02950000 R9 EQU 9 02960000 R10 EQU 10 02970000 R11 EQU 11 02980000 R12 EQU 12 02990000 R13 EQU 13 03000000 R14 EQU 14 03010000 R15 EQU 15 03020000 SPACE 2 03030000 BLANK EQU C' ' 03040000 ASTERISK EQU C'*' 03050000 COMMA EQU C',' 03060000 EQUAL EQU C'=' 03070000 LINES1 EQU C' ' 03080000 LINES2 EQU C'0' 03090000 SIGN EQU X'F0' 03100000 HEXZERO EQU X'00' 03110000 HEXFOUR EQU X'04' 03120000 FULLMASK EQU X'FF' 03130000 SPACE 3 03140000 *--------------------------------------------------------------------* 03150000 * MSGEXIT MACRO * 03160000 *--------------------------------------------------------------------* 03170000 * PRINT OFF 03180000 MACRO 03190000 &NAME MSGEXIT &SPMSG=,&MSG=,&RETURN=,&ABEND=,&RC=8 03200000 LCLC &ERRID 03210000 LCLC &NAMEX 03220000 AIF ('&SPMSG' NE '').MSGOK 03230000 AIF ('&MSG' NE '').MSGOK 03240000 MNOTE 8,'** ERROR - NO MESSAGE NUMBER SPECIFIED.' 03250000 MEXIT 03260000 .MSGOK ANOP 03270000 AIF ('&RETURN' NE '' OR '&ABEND' NE '').RETOK 03280000 MNOTE 8,'** ERROR - NO RETURN LABEL OR ABEND CODE SPECIFIED.' 03290000 MEXIT 03300000 .RETOK ANOP 03310000 AIF ('&NAME' NE '').NAMEOK 03320000 &ERRID SETC 'ERROR&MSG' 03330000 AGO .IDSET 03340000 .NAMEOK ANOP 03350000 &ERRID SETC '&NAME' 03360000 .IDSET ANOP 03370000 &ERRID DS 0H 03380000 ST R15,RCSAVE 03390000 AIF ('&RC' EQ '').NORC 03400000 AIF ('&MSG' EQ '').SPRC 03410000 LA R0,&RC 03420000 ST R0,FUNCRC 03430000 C R0,HIGHRC 03440000 BL MSGRC&MSG 03450000 ST R0,HIGHRC 03460000 MSGRC&MSG DS 0H 03470000 AGO .NORC 03480000 .SPRC ANOP 03490000 &NAMEX SETC 'SPRC'.'&SYSNDX' 03500000 LA R0,&RC 03510000 ST R0,FUNCRC 03520000 C R0,HIGHRC 03530000 BL &NAMEX 03540000 ST R0,HIGHRC 03550000 &NAMEX DS 0H 03560000 .NORC ANOP 03570000 AIF ('&SPMSG' NE '').DOSP 03580000 LA R1,&MSG 03590000 STH R1,MPLNUM 03600000 XC MPLSPADR,MPLSPADR 03610000 AGO .DUMPX 03620000 .DOSP ANOP 03630000 LA R1,&SPMSG 03640000 ST R1,MPLSPADR 03650000 XC MPLNUM,MPLNUM 03660000 .DUMPX ANOP 03670000 BAL R14,MSGOUT 03680000 AIF ('&RETURN' EQ '').GODUMP 03690000 B &RETURN 03700000 MEXIT 03710000 .GODUMP ANOP 03720000 ABEND &ABEND,DUMP 03730000 MEXIT 03740000 MEND 03750000 PRINT ON 03760000 *--------------------------------------------------------------------* 03770000 * MSGSETUP MACRO * 03780000 *--------------------------------------------------------------------* 03790000 PRINT OFF 03800000 MACRO 03810000 MSGSETUP &TEXT 03820000 LCLC &SEQ 03830000 &SEQ SETC 'MSG'.'&SYSNDX' 03840000 MSGTABLE CSECT 03850000 DC A(&SEQ) ADDRESS OF MESSAGE BUFFER 03860000 MSGTEXT CSECT 03870000 &SEQ DS 0F 03880000 DC AL2(&SEQ.L) LENGTH OF TEXT 03890000 DC X'4000' MCS FLAGS FOR WTO 03900000 &SEQ.B DC C&TEXT 03910000 &SEQ.L EQU *-&SEQ LENGTH OF WTO MESSAGE SETUP 03920000 MEND 03930000 PRINT ON 03940000 *--------------------------------------------------------------------* 03950000 * $$SUB MACRO * 03960000 *--------------------------------------------------------------------* 03970000 PRINT OFF 03980000 MACRO 03990000 &L $$SUB 04000000 &L STM R14,R12,12(R13) SAVE REGS 04010000 LA R14,72(,R13) NEXT SAVE 04020000 ST R14,8(,R13) CHAIN 04030000 ST R13,4(,R14) SAVE 04040000 LR R13,R14 NEW SAVE 04050000 MEND 04060000 PRINT ON 04070000 *--------------------------------------------------------------------* 04080000 * $$ERR MACRO * 04090000 *--------------------------------------------------------------------* 04100000 PRINT OFF 04110000 MACRO 04120000 &L $$ERR 04130000 &I SETA &SYSNDX 04140000 &L LTR R15,R15 ANY ERROS 04150000 BZ $ER&I.A NO 04160000 LR R14,R0 YES 04170000 BR R14 GOTO ERROR 04180000 $ER&I.A DS 0H 04190000 MEND 04200000 PRINT ON 04210000 EJECT 04220000 FIXDSCB TITLE 'FIXDSCB - A DSCB MODIFICATION UTILITY.' 04230000 FIXDSCB AMODE 31 04240000 FIXDSCB RMODE 24 04250000 FIXDSCB CSECT 04260000 SAVE (14,12),T,'FIXDSCB_&SYSDATC._&SYSTIME.' 04270000 LR R10,R15 POINT BASE REGISTER TO ENTRY POINT 04280000 LA R11,2048(R10) SET UP 04290000 LA R11,2048(R11) SECOND BASE REG 04300000 LA R12,2048(R11) SET UP 04310000 LA R12,2048(R12) THIRD BASE REG 04320000 USING FIXDSCB,R10,R11,R12 ESTABLISH BASE REGISTERS 04330000 LA R2,SAVEAREA POINT TO SAVEAREA 04340000 ST R13,SAVEAREA+4 POINTER TO CALLERS SAVEAREA 04350000 ST R2,8(R13) POINTER TO CALLED SAVEAREA 04360000 LR R13,R2 STANDARD POINTER TO SAVEAREA 04370000 LR R2,R1 SAVE ANY PARM POINTER 04380000 EXTRACT TSOWORD,FIELDS=(TSO) CHECK FOR TSO SESSION 04390000 L R1,TSOWORD PICK UP BYTE ADDRESS 04400000 TM 0(R1),X'80' IS TSO SESSION BIT ON? 04410000 BO SETUPTSO BRANCH IF SO 04420000 SPACE 3 04430000 *--------------------------------------------------------------------* 04440000 * EXECUTION IS BATCH OR STARTED TASK * 04450000 *--------------------------------------------------------------------* 04460000 SPACE 3 04470000 LTR R2,R2 IS ANY PARM PRESENT 04480000 BZ NOPARM BRANCH IF NOT 04490000 L R1,0(R2) LOAD PARM POINTER 04500000 LH R2,0(R1) PICK UP PARM LEN 04510000 LTR R2,R2 IS LEN ZERO 04520000 BZ NOPARM BRANCH IF SO 04530000 C R2,FOUR IS LENGTH = 5 04540000 BNE ERROR27 BRANCH IF NOT 04550000 CLC TESTPARM,2(R1) IS PARM 'TEST' 04560000 BNE ERROR27 BRANCH IF NOT 04570000 OI MASTFLAG,TESTONLY 04580000 B NOPARM 04590000 SPACE 3 04600000 *--------------------------------------------------------------------* 04610000 * EXECUTION IS AS A TSO COMMAND PROCESSOR * 04620000 *--------------------------------------------------------------------* 04630000 SPACE 3 04640000 SETUPTSO DS 0H 04650000 STAX DEFER=YES DISALLOW ATTENTION INTERRUPTS 04660000 OI IOFLAG,TSOSESS MARK AS TSO SESSION 04670000 OI MPLIOF,TSOSESS FLAG MPL AS WTO I/O REQUIRED 04680000 LR R1,R2 04690000 LA R15,72(,R13) 04700000 ST R15,8(,R13) PRECHAIN 1 SAVE AREA 04710000 ST R13,4(,R15) PRECHAIN 1 SAVE AREA 04720000 L R15,=V(DSCPPL) 04730000 BALR R14,R15 04740000 LR R2,R1 04750000 ST R2,CPPLHOLD SAVE CPPL POINTER 04760000 USING CPPL,R2 ADDRESS COMMAND PROCESSOR PARM LIST 04770000 L R1,CPPLPSCB GET PSCB ADDRESS 04780000 USING PSCB,R1 04790000 TM PSCBATR1,PSCBCTRL DOES USER HAVE OPER AUTHORITY? 04800000 BNO ERROR37 GET OUT IF NOT SJB 04810000 DROP R1 04820000 L R3,CPPLCBUF PICK UP ADDRESS OF COMMAND BUFFER 04830000 USING CMDBUFR,R3 ADDRESS COMMAND BUFFER 04840000 LH R1,CMDBLEN PICK UP BUFFER LENGTH 04850000 S R1,FOUR DROP BY 4 04860000 CH R1,CMDBOFF COMPARE TO OFFSET 04870000 * IF LEN-4=OFFSET THEN NO PARMETERS 04880000 * SPECIFIED 04890000 BE NOPARM 04900000 LH R1,CMDBOFF PICK UP OFFSET VALUE 04910000 LA R1,4(R1,R3) COMPUTE FIRST PARM ADDRESS 04920000 OC 0(4,R1),BLANKS SHIFT TO UPPERCASE 04930000 TM 0(R1),X'BF' ZERO OR BLANK 04940000 BE NOPARM YES, NOPARM 04950000 CLC TESTPARM,0(R1) IS PARM "TEST" 04960000 BNE ERROR27 BRANCH TO ERROR IF NOT 04970000 OI MASTFLAG,TESTONLY 04980000 B NOPARM 04990000 DROP R2 05000000 DROP R3 05010000 EJECT 05020000 *--------------------------------------------------------------------* 05030000 * INITIALIZE FOR RUN * 05040000 *--------------------------------------------------------------------* 05050000 SPACE 3 05060000 NOPARM DS 0H 05070000 L R2,=A(ESTAEX) 05080000 ESTAE (2),CT, SJB X05090000 TERM=YES,MF=(E,ESTAE) SJB 05100000 $AUTHON SJB 05110000 MODESET KEY=ZERO,MODE=SUP 05120000 L R1,X'21C' PSAOLD (TCB) 05130000 L R1,X'B4'(R1) TCBJSCB 05140000 L R1,X'15C'(R1) JSCBACT 05150000 OI X'F3'(R1),X'80' JSCBPASS 05160000 MODESET KEY=NZERO,MODE=PROB SJB 05170000 SPACE 3 05180000 L R1,CVTPTR GET ADDRESS OF CVT 05190000 S R1,PREFIXL BACKUP TO START OF PREFIX 05200000 USING CVTFIX,R1 ADDRESS CVT AT PREFIX 05210000 CLC CVTNUMB,MVSCODE IS THIS AN MVS SYSTEM 05220000 BNE NONMVS SKIP IF NOT 05230000 OI MASTFLAG,MVSSYS TURN ON MVS FLAG 05240000 DROP R1 05250000 NONMVS DS 0H 05260000 TM IOFLAG,TSOSESS IS THIS A TSO SESSION 05270000 BO MESSAG33 BRANCH IF SO 05280000 SPACE 1 05290000 XR R1,R1 05300000 USING PSA,R1 ADDRESS PSA 05310000 L R1,PSAAOLD GET OLD ASCB ADDRESS 05320000 DROP R1 05330000 USING ASCB,R1 ADDRESS OUR ASCB 05340000 L R1,ASCBCSCB GET CSCB ADDRESS 05350000 DROP R1 05360000 USING CHAIN,R1 ADDRESS CSCB 05370000 CLI CHUCMP,HEXZERO IS THIS FROM A CONSOLE (STARTED TASK) 05380000 BE NOCON BRANCH IF NOT 05390000 OI IOFLAG,CONSOLE FLAG AS CONSOLE I/O REQUIRED 05400000 OI MPLIOF,CONSOLE FLAG MPL AS WTO I/O REQUIRED 05410000 MVC CONID,CHUCMP SAVE CONSOLE ID 05420000 MVC MPLCON,CONID SAVE CONSOLE ID IN MPL 05430000 B MESSAG33 DO NOT OPEN SYSIN/SYSPRINT FOR IO 05440000 NOCON DS 0H 05450000 OPEN (SYSIN,INPUT) 05460000 OPEN (SYSPRINT,OUTPUT) 05470000 DROP R1 05480000 EJECT 05490000 *--------------------------------------------------------------------* 05500000 * GET A COMMAND CARD AND PARSE IT FOR KEYWORDS * 05510000 *--------------------------------------------------------------------* 05520000 SPACE 3 05530000 LOOP1 DS 0H 05540000 NI FLAG2,255-($ALTER) 05550000 BAL R14,DEQUE BE SURE WE ARE NOT RESERVED 08/13/90 05560000 BAL R5,CARDIN 05570000 LOOP2 DS 0H 05580000 MVI MSGCC,LINES2 SET CARRIAGE CONTROL 05590000 BAL R14,PUTBLANK GO PRINT BLANK LINE 05600000 BAL R14,PUTCARD GO PRINT CARD 05610000 CLI CARD,ASTERISK COMMENT CARD? 05620000 BE LOOP1 SKIP IF SO 05630000 BAL R14,SKIPB SKIP LEADING BLANKS ON CARD 05640000 LTR R5,R5 IS CARD ALL BLANKS 05650000 BZ LOOP1 BRANCH IF SO 05660000 XC FUNCRC,FUNCRC ZERO OUT FUNCTION RETURN CODE 05670000 MVI DSCBNAME,BLANK SET DSN TO OMMITTED 05680000 MVI VOLUME,BLANK SET VOL TO OMMITTED 05690000 MVI COMFLAG,HEXZERO SET COMMAND CARD FLAG TO ZEROS 05700000 SPACE 1 05710000 BAL R6,COMCARD PICK APART THE COMMAND CARD 05720000 SPACE 1 05730000 TM MASTFLAG,COMBADF WAS COMMAND INVALID 05740000 BO ERROR5 05750000 SPACE 3 05760000 *--------------------------------------------------------------------* 05770000 * CHECK THAT ALL REQUIRED KEYWORDS WERE SPECIFIED * 05780000 *--------------------------------------------------------------------* 05790000 SPACE 3 05800000 L R1,CURRENTF LOAD CURRENT FUNCTION TABLE ADRS 05810000 L R1,COMTRKWL(R1) PICK UP RKW LIST ADRS 05820000 LTR R1,R1 IS RKW ADRS ZERO (NO KEYWORDS REQRD) 05830000 BZ LOOPVGO GET OUT OF LOOP IF SO 05840000 L R4,0(R1) PICK UP FIRST KWT ADRS 05850000 XR R2,R2 CLEAR REGS FOR OR 05860000 XR R3,R3 CLEAR REGS FOR OR 05870000 IC R3,COMFLAG PICK UP COMMAND FLAG 05880000 LOOPRKW DS 0H 05890000 LTR R4,R4 IS KWT ADRS ZERO 05900000 BZ LOOPVGO END OF KW TESTING IF SO 05910000 IC R2,4(R4) PICK UP REQUIRED FLAG MASK 05920000 NR R2,R3 TEST FOR KW SPECIFIED 05930000 BZ LOOPRERR BRANCH IF OMMITTED 05940000 LA R1,4(R1) BUMP TO NEXT RKW ADRS IN LIST 05950000 L R4,0(R1) PICK UP NEXT KWT ADRS 05960000 B LOOPRKW CONTINUE 05970000 LOOPRERR DS 0H 05980000 L R2,4(R4) PICK ERROR ROUTINE ADRS 05990000 BR R2 BRANCH TO ERROR ROUTINE 06000000 EJECT 06010000 *--------------------------------------------------------------------* 06020000 * COMMAND CHECKED OUT OK * 06030000 * * 06040000 * FIND A DD IN TIOT THAT MATCHES VOLUME REQUESTED * 06050000 * NOTE: WE MUST EXTRACT TIOT ADDRESS EACH TIME * 06060000 * SINCE IT MIGHT CHANGE DUE TO DYNAMIC ALLOCATION. * 06070000 *--------------------------------------------------------------------* 06080000 * 06090000 SPACE 3 06100000 LOOPVGO DS 0H 06110000 TM VTOCDCB+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN 06120000 BZ LOOPVGO2 NO, SKIP CLOSE 06130000 CLOSE (VTOCDCB) 06140000 LOOPVGO2 DS 0H 06150000 CLI VOLUME,BLANK IS A VOLUME PRESENT 06160000 BE NOVOL SKIP IF NOT 06170000 EXTRACT TIOTADRS,FIELDS=(TIOT) GET TIOT ADDRESS 06180000 L R1,TIOTADRS PICK UP TIOT ADDRESS 06190000 USING TIOT,R1 ADDRESS TIOT 06200000 LA R1,TIOENTRY 06210000 DROP R1 06220000 USING TIOENTRY,R1 ADDRESS TIOT 06230000 LOOPVOL DS 0H 06240000 CLI TIOELNGH,0 END OF TIOT? 06250000 BE CKMVS GO CHECK FOR MVS SYSTEM 06260000 SPACE 1 06270000 CLC TIOEDDNM,=XL8'00' ZERO DDNAME 09/11/91 06280000 BE CKMVS YES, END OF TIOT 09/11/91 06290000 TM TIOESTTA,TIOSLTYP FREED TIOT ENTRY 09/11/91 06300000 BO VOLINCR YES, SKIP ENTRY 09/11/91 06310000 CLI TIOEDDNM,C' ' IS IT DDNAME BLANKS(CONCAT) 08/13/90 06320000 BE VOLINCR YES, BYPASS 08/13/90 06330000 SPACE 1 06340000 L R2,TIOESTTB PICK UP TIOT ENTRY UCB ADDRESS 06350000 N R2,=A(X'00FFFFFF') CLEAR HIGH BYTE 06360000 BZ VOLINCR 06370000 USING UCBCMSEG,R2 ADDRESS UCB 06380000 CLC VOLUME,UCBVOLI VOLUME MATCH 06390000 BE FOUNDV BRANCH IF SO 06400000 VOLINCR DS 0H 08/13/90 06410000 LR R14,R15 SAVE LAST TIOT FOR DEBUGGING 06420000 LR R15,R1 SAVE LAST TIOT FOR DEBUGGING 06430000 XR R3,R3 CLEAR INDEX REG 06440000 IC R3,TIOELNGH PICK UP ENTRY LENGTH 06450000 LA R1,0(R3,R1) BUMP TO NEXT TIOT ENTRY 06460000 B LOOPVOL CONTINUE SEARCH 06470000 SPACE 2 06480000 FOUNDV DS 0H 06490000 ST R2,UCBADDR SAVE UCB ADDR FOR CVAF 06500000 MVC VOLUNIT,UCBTYP SAVE UNIT TYPE IN FOR LATER 06510000 DROP R2 06520000 LA R2,VTOCDCB @ OF DCB 06530000 USING IHADCB,R2 06540000 MVC DCBDDNAM,TIOEDDNM MOVE IN DDNAME 06550000 B VTOCCHK CHECK VTOC 06560000 DROP R1,R2 06570000 SPACE 3 06580000 CKMVS DS 0H 06590000 *--------------------------------------------------------------------* 06600000 * CHECK FOR MVS OPERATING SYSTEM * 06610000 * IF MVS THEN DYNAMICALLY ALLOCATE VOLUME REQUIRED * 06620000 *--------------------------------------------------------------------* 06630000 TM MASTFLAG,MVSSYS IS THIS MVS 06640000 BO ALOCDYN YES,ALLOCATE DYNAMICALLY 06650000 SPACE 1 06660000 TM IOFLAG,TSOSESS IS THIS A TSO SESSION 06670000 BO ALOCDAIR GO ALLOCATE WITH DAIR IF SO 06680000 B ERROR29 CANNOT DYNAMICALLY ALLOCATE 06690000 SPACE 3 06700000 ALOCDYN DS 0H 06710000 XC S99F1,S99F1 CLEAR SVC 99 R11 FLAG1 06720000 XC S99F2,S99F2 CLEAR SVC 99 R11 FLAG2 06730000 LA R1,S99RBPTR LOAD ADDRESS OF R11 POINTER 06740000 DYNALLOC 06750000 LTR R15,R15 CHECK SVC 99 RETURN CODES 06760000 BNZ DYNERROR BRANCH IF BAD 06770000 CLC S99ERROR,ZERO CHECK ERROR CODE 06780000 BNE DYNERROR BRANCH IF BAD 06790000 B LOOPVGO GO RESCAN TIOT 06800000 SPACE 3 06810000 VTOCCHK DS 0H 06820000 *--------------------------------------------------------------------* 06830000 * FOUND UCB, SEE IF IT IS INDEXED * 06840000 *--------------------------------------------------------------------* 06850000 L R2,UCBADDR SAVE UCB ADDR FOR CVAF 06860000 NI FLAG2,255-$INDEX TURN OFF INDEX FLAG 06/29/84 06870000 MVC CVAFFUNC,=CL20'VTOC-INDEXED' 05/08/92 06880000 CVAFTST UCB=(R2) ENTER CHECK FOR INDEXED VTOC 06890000 C 15,=F'8' CHECK IF INDEXED VTOC 06900000 BL VTOCOS IF NOT INDEX, SKIP 06/29/84 06910000 BE VTOCIX 06920000 ST R15,FUNCRC SAVE AS FUNCTION RETURN CODE 06930000 CVD R15,DOUBLE 06940000 UNPK SPMG8R1,DOUBLE 06950000 OI SPMG8R1+3,SIGN MAKE SIGN PRINTABLE 06960000 B MSGSP8 ERROR 06970000 VTOCIX DS 0H 06980000 OI FLAG2,$INDEX INDICATE INDEX VTOC IN USE 06/29/84 06990000 VTOCOS DS 0H 07000000 B GETJFCB GO GET THE VTOC DCB JFCB 07010000 SPACE 3 07020000 *--------------------------------------------------------------------* 07030000 * GET THE JFCB FOR THE DD FOUND AND OPEN THE VTOC * 07040000 *--------------------------------------------------------------------* 07050000 SPACE 3 07060000 GETJFCB DS 0H 07070000 RDJFCB (VTOCDCB,(UPDAT)) GET THE JFCB 07080000 LTR R15,R15 DID WE REALLY GET IT ?? 07090000 BNZ ERROR1 NO 07100000 LA R1,JFCBAREA GET ADDRESS OF INTERNAL JFCB 07110000 USING JFCBDSCT,R1 ADDRESS JFCB 07120000 MVI JFCBDSNM,HEXFOUR FIX UP THE DSNAME 07130000 MVC JFCBDSNM+1(43),JFCBDSNM OF THE VTOC 07140000 OI JFCBTSDM,JFCNWRIT DO NOT MERGE BACK 07150000 OI JFCBOPS1+4,JFCBMOD FLAG JFCB AS MODIFIED 07160000 DROP R1 DROP JFCB ADDRESSABILITY 07170000 OPEN (VTOCDCB,(UPDAT)),TYPE=J OPEN THE VTOC 07180000 LA R1,VTOCDCB PICK UP DCB ADDRESS 07190000 USING IHADCB,R1 ADDRESS DCB 07200000 TM DCBOFLGS,DCBOFOPN DID OPEN WORK 07210000 BNO ERROR31 BRANCH IF NOT 07220000 SPACE 1 07230000 L R2,DCBDEBAD DEBADDR 07240000 N R2,=A(X'00FFFFFF') 07250000 LA R2,DEBBASND-DEBBASIC(R2) 07260000 L R2,DEBUCBAD-DEBDASD(R2) UCB ADDR 07270000 N R2,=A(X'00FFFFFF') 07280000 ST R2,UCBADDR SAVE UCB ADDR FOR CVAF 07290000 DROP R1 07300000 SPACE 2 07310000 CLI DSCBNAME,BLANK DSNAME BLANK 07320000 BE NODSN YES, SKIP 07330000 SPACE 3 07340000 *--------------------------------------------------------------------* 07350000 * READ THE DSCB FOR DATASET FROM VTOC VIA CVAF READ * 07360000 *--------------------------------------------------------------------* 07370000 SPACE 3 07380000 LA R9,DSCBAREA 07390000 USING DSCB,R9 ADDRESS DSCB 07400000 LA R8,WCVAF 07410000 USING CVPL,R8 ADDRESS CVPL AREA 07420000 SPACE 3 07430000 BAL R14,READDSCB 07440000 CVAFTST1 DS 0H 07450000 $$ERR , 07460000 OI FLAG2,$CVAFDIR CVAFDIR DONE 07470000 SPACE 3 07480000 *--------------------------------------------------------------------* 07490000 * FIND THE ADDRESS OF THE ROUTINE TO PROCESS THE COMMAND * 07500000 * IN THE COMMAND TABLE. * 07510000 *--------------------------------------------------------------------* 07520000 * 07530000 SPACE 3 07540000 NODSN DS 0H 07550000 NOVOL DS 0H 07560000 L R2,CURRENTF RELOAD FUNCTION TABLE ADDRESS 07570000 L R2,COMTADR(R2) GET ADDRESS OF COMMAND ROUTINE 07580000 BR R2 07590000 EJECT 07600000 *--------------------------------------------------------------------* 07610000 * COMMAND EXECUTION 07620000 *--------------------------------------------------------------------* 07630000 * 07640000 * RENEW THE CREATION DATE TO TODAYS DATE 07650000 * 07660000 *--------------------------------------------------------------------* 07670000 SPACE 3 07680000 RENEW DS 0H 07690000 TIME DEC GET THE TIME AND DATE 07700000 MVC THYMEOYR,PACK8ZRO ZERO OUT THE YEAR 07710000 MVC DAYTHYME,PACK8ZRO ZERO OUT THE DAY 07720000 STH R1,DAYTHYME+6 CONVERT TO USABLE FORMAT 07730000 SRL R1,8 07740000 IC R1,MASKC0 07750000 SRL R1,R4 07760000 STH R1,THYMEOYR+6 07770000 CVB R1,DAYTHYME 07780000 ST R1,DAYTHYME+4 07790000 CVB R1,THYMEOYR 07800000 ST R1,THYMEOYR+4 07810000 MVC DS1CREDT(1),THYMEOYR+7 MOVE IN YEAR 07820000 MVC DS1CREDT+1(2),DAYTHYME+6 MOVE IN DAY OF YEAR 07830000 B DSCBWRIT 07840000 SPACE 3 07850000 *--------------------------------------------------------------------* 07860000 * * 07870000 * SWAP THE CREATION AND EXPIRATION DATE FIELDS * 07880000 * * 07890000 *--------------------------------------------------------------------* 07900000 SPACE 1 07910000 EXPIRE XC DS1CREDT,DS1EXPDT INVERT 07920000 XC DS1EXPDT,DS1CREDT TWO 07930000 XC DS1CREDT,DS1EXPDT FIELDS 07940000 B DSCBWRIT 07950000 SPACE 3 07960000 *--------------------------------------------------------------------* 07970000 * * 07980000 * SET THE EXPIRATION DATE TO 00:000 * 07990000 * * 08000000 *--------------------------------------------------------------------* 08010000 SPACE 1 08020000 ZEROEXPD DS 0H 08030000 MVC DS1EXPDT,ZERODATE 08040000 B DSCBWRIT 08050000 SPACE 3 08060000 *--------------------------------------------------------------------* 08070000 * * 08080000 * SET THE EXPIRATION DATE TO 99:365 * 08090000 * * 08100000 *--------------------------------------------------------------------* 08110000 SPACE 1 08120000 EXTEND DS 0H 08130000 MVC DS1EXPDT,MAXDATE 08140000 B DSCBWRIT 08150000 EJECT 08160000 *--------------------------------------------------------------------* 08170000 * * 08180000 * SET THE RACF BIT ON * 08190000 * * 08200000 *--------------------------------------------------------------------* 08210000 SPACE 1 08220000 RACFON OI DS1DSIND,DS1IND40 RACF ON 08230000 B DSCBWRIT 08240000 SPACE 3 08250000 *--------------------------------------------------------------------* 08260000 * * 08270000 * SET THE RACF BIT ON * 08280000 * * 08290000 *--------------------------------------------------------------------* 08300000 SPACE 1 08310000 RACFOFF NI DS1DSIND,FULLMASK-DS1IND40 TURN OFF RACF BIT 08320000 B DSCBWRIT 08330000 SPACE 3 08340000 *--------------------------------------------------------------------* 08350000 * * 08360000 * SET THE PASSWORD PROTECTION BITS FOR FULL PROTECTION * 08370000 * * 08380000 *--------------------------------------------------------------------* 08390000 SPACE 1 08400000 PROTECT OI DS1DSIND,DS1IND10 08410000 NI DS1DSIND,FULLMASK-DS1IND04 08420000 B DSCBWRIT 08430000 SPACE 3 08440000 *--------------------------------------------------------------------* 08450000 * * 08460000 * SET THE PASSWORD PROTECTION BITS FOR READ ONLY ACCESS * 08470000 * * 08480000 *--------------------------------------------------------------------* 08490000 SPACE 1 08500000 SETNOPWR OI DS1DSIND,DS1IND10 08510000 OI DS1DSIND,DS1IND04 08520000 B DSCBWRIT 08530000 SPACE 3 08540000 *--------------------------------------------------------------------* 08550000 * * 08560000 * SET THE PASSWORD PROTECTION BIT OFF * 08570000 * * 08580000 *--------------------------------------------------------------------* 08590000 SPACE 1 08600000 UNLOCK NI DS1DSIND,FULLMASK-DS1IND10 OS PASSWORD PROTECT 08610000 NI DS1DSIND,FULLMASK-DS1IND04 OS R/W PASSWORD 08620000 NI DS1DSIND,FULLMASK-DS1IND40 RACF SJB 08630000 B DSCBWRIT 08640000 SPACE 3 08650000 *--------------------------------------------------------------------* 08660000 * * 08670000 * CHANGE THE DSNAME TO A NEW NAME * 08680000 * * 08690000 *--------------------------------------------------------------------* 08700000 SPACE 1 08710000 RENAME DS 0H 08720000 OI FLAG2,$ALTER 08730000 MVC DS1DSNAM,NEWNAME ADD NEWDSN INDX 08740000 BAL R14,ADDVIR 08750000 $$ERR , 08760000 SPACE 3 08770000 MVC DS1DSNAM,DSCBNAME DEL OLDDSN INDX 08780000 BAL R14,DELVIR 08790000 $$ERR , 08800000 SPACE 3 08810000 MVC DS1DSNAM,NEWNAME MOVE NEWNAME INTO DSCB1 08820000 BAL R14,WRITDSCB 08830000 $$ERR , 08840000 B CLOSEX JUST AFTER DSCBWRIT 08850000 EJECT 08860000 *--------------------------------------------------------------------* 08870000 * * 08880000 * PERFORM SCRATCH REQUEST * 08890000 * * 08900000 * LOGIC: DATASET IS RENAMED TO 'FIXDSCB.SCRATCH.DATASET', * 08910000 * ANY PASSWORD PROTECTION BITS ARE TURNED OFF, * 08920000 * AND THE EXPIRATION DATE IS RESET TO ZERO. * 08930000 * THE MODIFIED DATASET IS THEN DELETED VIA * 08940000 * A SCRATCH SVC. * 08950000 * * 08960000 *--------------------------------------------------------------------* 08970000 SPACE 1 08980000 SCRATCH DS 0H 08990000 OI FLAG2,$ALTER 09000000 MVC DS1DSNAM,TEMPNAME MOVE TEMPNAME TO DSCB 09010000 NI DS1DSIND,FULLMASK-DS1IND10 TURN OFF ANY 09020000 NI DS1DSIND,FULLMASK-DS1IND04 PASSWORD BITS 09030000 NI DS1DSIND,FULLMASK-DS1IND40 RACF SJB 09040000 MVC DS1EXPDT,ZERODATE SET EXPDT TO ZERO 09050000 TM MASTFLAG,TESTONLY IS THIS A TEST 09060000 BO MESSAG28 SKIP IF SO 09070000 SPACE 1 09080000 XR R0,R0 ZERO REG 0 FOR SCRATCH (NO UCB) 09090000 SCRATCH SCRLIST SCRATCH ANY REMAINING TEMP DATASET 09100000 SPACE 3 09110000 MVC DS1DSNAM,TEMPNAME IX ADD TEMPNAME 09120000 BAL R14,ADDVIR 09130000 $$ERR , EXPECTS R0 = ERROR RETURN ADDR 09140000 SPACE 3 09150000 MVC DS1DSNAM,DSCBNAME IX DELETE DSCBNAME 09160000 BAL R14,DELVIR 09170000 $$ERR , EXPECTS R0 = ERROR RETURN ADDR 09180000 SPACE 3 09190000 MVC DS1DSNAM,TEMPNAME RENAME TO TEMPNAME 09200000 BAL R14,WRITDSCB 09210000 $$ERR , EXPECTS R0 = ERROR RETURN ADDR 09220000 CLOSE VTOCDCB CLOSE VTOC 09230000 BAL R14,DEQUE DEQUE BEFORE SCRATCH 08/13/90 09240000 SPACE 1 09250000 XR R0,R0 ZERO REG 0 FOR SCRATCH (NO UCB) 09260000 SCRATCH SCRLIST ISSUE SCRATCH REQ. TEMPNAME 09270000 SPACE 1 09280000 LTR R15,R15 SCRATCH WORK OK 09290000 BZ FUNCMSG BRANCH IF SO 09300000 SPACE 1 09310000 *--------------------------------------------------------------------* 09320000 * IF SCRATCH FAILED PRINT A MESSAGE AND ABEND * 09330000 *--------------------------------------------------------------------* 09340000 SCRFAIL DS 0H 09350000 ST R15,FUNCRC SAVE AS FUNCTION RETURN CODE 09360000 CVD R15,DOUBLE 09370000 UNPK SPMG2R1,DOUBLE 09380000 OI SPMG2R1+3,SIGN MAKE SIGN PRINTABLE 09390000 LH R15,VOLSTAT PICK UP REASON CODE 09400000 CVD R15,DOUBLE 09410000 UNPK SPMG2R2,DOUBLE 09420000 OI SPMG2R2+3,SIGN MAKE SIGN PRINTABLE 09430000 B MSGSP2 GO PRINT SPECIAL MESSAGE 09440000 EJECT 09450000 *--------------------------------------------------------------------* 09460000 * PROCESS NAME SUBCOMMANDS * 09470000 *--------------------------------------------------------------------* 09480000 SPACE 3 09490000 NAME DS 0H 09500000 B ERROR35 WRITE 'RESERVED' MSG AND GOTO NAME2 09510000 NAME2 DS 0H 09520000 OI MASTFLAG,GETSUBC FLAG GET AS SUBCOMMAND REQUEST 09530000 BAL R14,GETACARD GO GET A SUBCOMMAND CARD 09540000 NI MASTFLAG,FULLMASK-GETSUBC TURN OFF SUBC REQUEST FLAG 09550000 BAL R14,SKIPB SKIP LEADING BLANKS ON SUBCOMMAND 09560000 LTR R5,R5 ALL BLANKS (IMPOSSIBLE) 09570000 BZ NAME SKIP IF SO 09580000 LA R2,SUBTABLE GET ADDRESS OF SUBCOMMAND TABLE 09590000 SUBTCK DS 0H 09600000 CLI 0(R2),BLANK END OF TABLE? 09610000 BE SUBTPRIM BRANCH IF SO 09620000 L R3,SUBTSCL(R2) LOAD LENGTH OF SUBCOMMAND 09630000 BCTR R3,0 DROP FOR EXECUTE 09640000 EX R3,SUBCTEST TEST FOR SUBCOMMAND 09650000 BNE SUBTNO 09660000 *--------------------------------------------------------------------* 09670000 * PRINT VALID SUBCOMMAND CARD * 09680000 *--------------------------------------------------------------------* 09690000 MVI MSGCC,LINES1 SET CARRIAGE CONTROL 09700000 BAL R14,PUTCARD 09710000 L R2,SUBTADR(R2) LOAD ADDRESS OF ROUTINE 09720000 BR R2 09730000 SUBTNO DS 0H 09740000 LA R2,SUBTLEN(R2) BUMP TO NEXT ENTRY 09750000 B SUBTCK 09760000 SPACE 3 09770000 *--------------------------------------------------------------------* 09780000 * CHECK IF UNKNOWN SUBCOMMAND IS REALLY A PRIMARY COMMAND * 09790000 *--------------------------------------------------------------------* 09800000 SPACE 1 09810000 SUBTPRIM DS 0H 09820000 OI MASTFLAG,PARTSCAN SET FOR COMMAND SCAN ONLY 09830000 BAL R6,COMCARD 09840000 NI MASTFLAG,FULLMASK-PARTSCAN TURN OFF PARTSCAN FLAG 09850000 TM MASTFLAG,COMBADF WAS COMMAND INVALID 09860000 BO ERROR9 09870000 LA R2,COMTABLE GET ADDRESS OF COMMAND TABLE 09880000 SUBTPRM2 DS 0H 09890000 CLI 0(R2),BLANK END OF TABLE 09900000 BE SUBTBAD MUST BE BAD SUBCOMMAND 09910000 CLC COMMAND2,0(R2) IS THIS A PRIMARY COMMAND 09920000 BE SUBTPRMF YES, GET OUT OF LOOP 09930000 LA R2,COMTLEN(R2) BUMP TO NEXT EXTRY 09940000 B SUBTPRM2 09950000 SUBTPRMF DS 0H 09960000 OI MASTFLAG,PRIMEND FLAG NAME ENDED BY PRIMARY COMMAND 09970000 B DSCBWRIT 09980000 SUBTBAD DS 0H 09990000 *--------------------------------------------------------------------* 10000000 * PRINT INVALID SUBCOMMAND CARD * 10010000 *--------------------------------------------------------------------* 10020000 MVI MSGCC,LINES1 SET CARRIAGE CONTROL 10030000 BAL R14,PUTCARD 10040000 B ERROR9 10050000 SPACE 3 10060000 *--------------------------------------------------------------------* 10070000 * RESET THE OPTCODE TO THAT SPECIFIED * 10080000 *--------------------------------------------------------------------* 10090000 SPACE 1 10100000 OPTCODE DS 0H 10110000 LA R5,7(R5) SKIP PAST OPTCODE KEYWORD 10120000 CLI 0(R5),EQUAL IS IT AN = SIGN 10130000 BNE ERROR9 SKIP IF NOT 10140000 LA R5,1(R5) SKIP THE = 10150000 LR R3,R5 SAVE START OF OPTCODE 10160000 MVC OPTCODEH(1),0(R5) MOVE OPTCODE TO HOLDER 10170000 LA R2,OPTCODET GET ADDRESS OF OPTCODE TABLE 10180000 OPTCODEL DS 0H 10190000 CLI 0(R2),BLANK END OF TABLE 10200000 BE ERROR34 ERROR IF SO 10210000 CLC OPTCODEH,0(R2) OPTCODE MATCH TABLE ENTRY 10220000 BE OPTCODEF BRANCH IF SO 10230000 LA R2,OPTCLEN(R2) BUMP TO NEXT ENTRY 10240000 B OPTCODEL 10250000 OPTCODEF DS 0H 10260000 MVC DS1OPTCD,OPTCMASK(R2) MOVE MASK BYTE TO DSCB 10270000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 10280000 B NAME GO BACK FOR ANOTHER CARD 10290000 EJECT 10300000 *--------------------------------------------------------------------* 10310000 * RESET THE LRECL TO THE SPECIFIED VALUE * 10320000 *--------------------------------------------------------------------* 10330000 SPACE 1 10340000 LRECL DS 0H 10350000 LA R5,5(R5) SKIP PAST LRECL KEYWORD 10360000 CLI 0(R5),EQUAL IS IT AN = SIGN 10370000 BNE ERROR9 SKIP IF NOT 10380000 LA R5,1(R5) SKIP THE = 10390000 LR R3,R5 SAVE START OF LRECL 10400000 LRECLL1 DS 0H 10410000 CLI 0(R3),BLANK END OF NUMBER 10420000 BE LRECLEND 10430000 LA R3,1(R3) BUMP TO NEXT COL 10440000 B LRECLL1 CONTINUE 10450000 SPACE 1 10460000 LRECLEND DS 0H 10470000 SR R3,R5 CALCULATE LENGTH 10480000 C R3,ONE IS IT ZERO 10490000 BL NAME SKIP CARD IF SO 10500000 BCTR R3,0 DROP FOR EXECUTE 10510000 EX R3,LRECLPCK PACK THE LRECL VALUE 10520000 CVB R3,DOUBLE CONVERT LRECL TO BINARY 10530000 C R3,BIGLRECL IS LRECL TOO BIG 10540000 BH ERROR10 BRANCH IF SO 10550000 STH R3,DS1LRECL STORE IN DSCB 10560000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 10570000 B NAME GO BACK FOR ANOTHER CARD 10580000 SPACE 3 10590000 *--------------------------------------------------------------------* 10600000 * RESET THE BLKSIZE TO THE SPECIFIED VALUE * 10610000 *--------------------------------------------------------------------* 10620000 SPACE 1 10630000 BLKSIZE DS 0H 10640000 LA R5,7(R5) SKIP PAST BLKSIZE KEYWORD 10650000 CLI 0(R5),EQUAL IS IT AN = SIGN 10660000 BNE ERROR9 SKIP IF NOT 10670000 LA R5,1(R5) SKIP THE = 10680000 LR R3,R5 SAVE START OF BLKSIZE 10690000 BLKSZL1 DS 0H 10700000 CLI 0(R3),BLANK END OF NUMBER 10710000 BE BLKSZEND 10720000 LA R3,1(R3) BUMP TO NEXT COL 10730000 B BLKSZL1 CONTINUE 10740000 SPACE 1 10750000 BLKSZEND DS 0H 10760000 SR R3,R5 CALCULATE LENGTH 10770000 C R3,ONE IS IT ZERO 10780000 BL NAME SKIP CARD IF SO 10790000 BCTR R3,0 DROP FOR EXECUTE 10800000 EX R3,BLKSZPCK PACK THE BLKSIZE VALUE 10810000 CVB R3,DOUBLE CONVERT BLKSIZE TO BINARY 10820000 C R3,BIGLRECL IS BLKSIZE TOO BIG 10830000 BH ERROR11 BRANCH IF SO 10840000 STH R3,DS1BLKL STORE IN DSCB 10850000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 10860000 B NAME GO BACK FOR ANOTHER CARD 10870000 SPACE 3 10880000 *--------------------------------------------------------------------* 10890000 * RESET THE RECORD FORMAT TO THAT SPECIFIED * 10900000 *--------------------------------------------------------------------* 10910000 SPACE 1 10920000 RECFM DS 0H 10930000 LA R5,5(R5) SKIP PAST RECFM KEYWORD 10940000 CLI 0(R5),EQUAL IS IT AN = SIGN 10950000 BNE ERROR9 SKIP IF NOT 10960000 LA R5,1(R5) SKIP THE = 10970000 LR R3,R5 SAVE START OF RECMF 10980000 MVC RECFMH(5),0(R5) MOVE RECFM TO HOLDER 10990000 LA R2,RECFMTAB GET ADDRESS OF RECFM TABLE 11000000 RECFMLP DS 0H 11010000 CLI 0(R2),BLANK END OF TABLE 11020000 BE ERROR21 ERROR IF SO 11030000 CLC RECFMH,0(R2) RECFM MATCH TABLE ENTRY 11040000 BE RECFMFND BRANCH IF SO 11050000 LA R2,RECFMLEN(R2) BUMP TO NEXT ENTRY 11060000 B RECFMLP 11070000 RECFMFND DS 0H 11080000 MVC DS1RECFM,RECFMASK(R2) MOVE MASK BYTE TO DSCB 11090000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 11100000 B NAME GO BACK FOR ANOTHER CARD 11110000 SPACE 3 11120000 EJECT 11130000 *--------------------------------------------------------------------* 11140000 * RESET THE DSORG TO THAT SPECIFIED * 11150000 *--------------------------------------------------------------------* 11160000 SPACE 1 11170000 DSORG DS 0H 11180000 LA R5,5(R5) SKIP PAST DSORG KEYWORD 11190000 CLI 0(R5),EQUAL IS IT AN = SIGN 11200000 BNE ERROR9 SKIP IF NOT 11210000 LA R5,1(R5) SKIP THE = 11220000 LR R3,R5 SAVE START OF RECMF 11230000 MVC DSORGH(5),0(R5) MOVE DSORG TO HOLDER 11240000 LA R2,DSORGTAB GET ADDRESS OF DSORG TABLE 11250000 DSORGLP DS 0H 11260000 CLI 0(R2),BLANK END OF TABLE 11270000 BE ERROR22 ERROR IF SO 11280000 CLC DSORGH,0(R2) DSORG MATCH TABLE ENTRY 11290000 BE DSORGFND BRANCH IF SO 11300000 LA R2,DSORGLEN(R2) BUMP TO NEXT ENTRY 11310000 B DSORGLP 11320000 DSORGFND DS 0H 11330000 MVC DS1DSORG(2),3(R2) MOVE DSORG MASK TO DSCB 11340000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 11350000 B NAME GO BACK FOR ANOTHER CARD 11360000 SPACE 3 11370000 *--------------------------------------------------------------------* 11380000 * RESET THE KEYL TO THE SPECIFIED VALUE * 11390000 *--------------------------------------------------------------------* 11400000 SPACE 1 11410000 KEYL DS 0H 11420000 LA R5,4(R5) SKIP PAST KEYL KEYWORD 11430000 CLI 0(R5),EQUAL IS IT AN = SIGN 11440000 BNE ERROR9 SKIP IF NOT 11450000 LA R5,1(R5) SKIP THE = 11460000 LR R3,R5 SAVE START OF KEYL 11470000 KEYLL1 DS 0H 11480000 CLI 0(R3),BLANK END OF NUMBER 11490000 BE KEYLEND 11500000 LA R3,1(R3) BUMP TO NEXT COL 11510000 B KEYLL1 CONTINUE 11520000 SPACE 1 11530000 KEYLEND DS 0H 11540000 SR R3,R5 CALCULATE LENGTH 11550000 C R3,ONE IS IT ZERO 11560000 BL NAME SKIP CARD IF SO 11570000 BCTR R3,0 DROP FOR EXECUTE 11580000 EX R3,KEYLPCK PACK THE KEYL VALUE 11590000 CVB R3,DOUBLE CONVERT KEYL TO BINARY 11600000 C R3,BIGKEYL IS KEYL TOO BIG 11610000 BH ERROR23 BRANCH IF SO 11620000 STC R3,DS1KEYL STORE IN DSCB 11630000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 11640000 B NAME GO BACK FOR ANOTHER CARD 11650000 SPACE 3 11660000 *--------------------------------------------------------------------* 11670000 * RESET THE RELATIVE KEY POSITION TO THE SPECIFIED VALUE * 11680000 *--------------------------------------------------------------------* 11690000 SPACE 1 11700000 RKP DS 0H 11710000 LA R5,3(R5) SKIP PAST RKP KEYWORD 11720000 CLI 0(R5),EQUAL IS IT AN = SIGN 11730000 BNE ERROR9 SKIP IF NOT 11740000 LA R5,1(R5) SKIP THE = 11750000 LR R3,R5 SAVE START OF RKP 11760000 RKPL1 DS 0H 11770000 CLI 0(R3),BLANK END OF NUMBER 11780000 BE RKPEND 11790000 LA R3,1(R3) BUMP TO NEXT COL 11800000 B RKPL1 CONTINUE 11810000 SPACE 1 11820000 RKPEND DS 0H 11830000 SR R3,R5 CALCULATE LENGTH 11840000 C R3,ONE IS IT ZERO 11850000 BL NAME SKIP CARD IF SO 11860000 BCTR R3,0 DROP FOR EXECUTE 11870000 EX R3,RKPPCK PACK THE RKP VALUE 11880000 CVB R3,DOUBLE CONVERT RKP TO BINARY 11890000 C R3,BIGRKP IS RKP TOO BIG 11900000 BH ERROR24 BRANCH IF SO 11910000 STCM R3,3,DS1RKP STORE IN DSCB 11920000 OI COMFLAG,REWRITE FLAG DSCB TO BE REWRITTEN 11930000 B NAME GO BACK FOR ANOTHER CARD 11940000 SPACE 3 11950000 *--------------------------------------------------------------------* 11960000 * END THE NAME SUBCOMMAND SET * 11970000 *--------------------------------------------------------------------* 11980000 SPACE 3 11990000 ENDNAME DS 0H 12000000 EJECT , 12010000 *--------------------------------------------------------------------* 12020000 * REWRITE THE DSCB/VIER * 12030000 *--------------------------------------------------------------------* 12040000 DSCBWRIT DS 0H 12050000 SPACE 1 12060000 BAL R14,WRITDSCB 12070000 $$ERR , 12080000 SPACE 1 12090000 CLOSEX DS 0H ALSO ENTERED VIA ERRORMSG 12100000 TM VTOCDCB+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN 12110000 BZ CLOSEX2 NO, SKIP CLOSE 12120000 CLOSE (VTOCDCB) 12130000 CLOSEX2 DS 0H 12140000 BAL R14,DEQUE 08/13/90 12150000 SPACE 3 12160000 *--------------------------------------------------------------------* 12170000 * ISSUE THE FUNCTION COMPLETED MESSAGE * 12180000 *--------------------------------------------------------------------* 12190000 SPACE 3 12200000 FUNCMSG DS 0H 12210000 BAL R14,RLSEVIER 12220000 SPACE 3 12230000 CLC FUNCRC,ZERO WAS COMMAND SUCCESSFUL 12240000 BE MESSAG32 PRINT MESSAGE IF SO 12250000 FUNCMSG2 DS 0H 12260000 L R1,FUNCRC 12270000 CVD R1,DOUBLE 12280000 UNPK SPMG0R,DOUBLE 12290000 OI SPMG0R+3,SIGN MAKE SIGN PRINTABLE 12300000 B MSGSP0 12310000 FUNCMEND DS 0H 12320000 NI MASTFLAG,FULLMASK-COMBADF TURN OFF ANY BAD COMMAND FLAG 12330000 TM MASTFLAG,GETSUBC DID EODAD OCCUR DURING SUBC PRCS 12340000 BO CLOSE2 GET OUT IF SO 12350000 TM MASTFLAG,PRIMEND WAS A PRIMARY COMMAND FOUND 12360000 BNO LOOP1 BRANCH IF NOT 12370000 NI MASTFLAG,FULLMASK-PRIMEND TURN OFF FLAG 12380000 B LOOP2 GOTO LOOP2 12390000 EJECT 12400000 *--------------------------------------------------------------------* 12410000 * CLOSE THE FILES AND TERMINATE * 12420000 *--------------------------------------------------------------------* 12430000 SPACE 3 12440000 END DS 0H 12450000 CLOSE DS 0H 12460000 CLOSE01 DS 0H 12470000 TM MASTFLAG,GETSUBC WAS GET FOR A SUBCOMMAND 12480000 BZ CLOSE1 NO 12490000 BAL R14,WRITDSCB 12500000 B FUNCMSG 12510000 CLOSE1 DS 0H 12520000 TM MASTFLAG,CARD2TRY WAS GET FOR A CONTINUATION CARD 12530000 BO ERROR25 BRANCH IF SO 12540000 CLOSE2 DS 0H 12550000 L R1,HIGHRC 12560000 C R1,FUNCRC 12570000 BH GOTRC 12580000 L R1,FUNCRC 12590000 GOTRC DS 0H 12600000 CVD R1,DOUBLE 12610000 UNPK SPMG1R,DOUBLE 12620000 OI SPMG1R+3,SIGN MAKE SIGN PRINTABLE 12630000 B MSGSP1 GO PRINT SPECIAL MESSAGE 12640000 CLOSEND DS 0H 12650000 TM IOFLAG,CONSOLE CONSOLE I/O USED 12660000 BO RETURN 12670000 TM IOFLAG,TSOSESS TSO I/O USED 12680000 BO RETURN 12690000 CLOSE SYSIN 12700000 CLOSE SYSPRINT 12710000 RETURN DS 0H 12720000 $AUTHON SJB 12730000 MODESET KEY=ZERO,MODE=SUP 12740000 L R1,X'21C' PSAOLD (TCB) 12750000 L R1,X'B4'(R1) TCBJSCB 12760000 L R1,X'15C'(R1) JSCBACT 12770000 NI X'F3'(R1),255-X'80' JSCBPASS 12780000 MODESET KEY=NZERO,MODE=PROB 12790000 $AUTHOFF SJB 12800000 L R15,HIGHRC GET RETURN CODE 12810000 L 13,SAVEAREA+4 POINT TO CALLERS SAVEAREA 12820000 RETURN (14,12),T,RC=(15) STANDARD RETURN 12830000 EJECT 12840000 *--------------------------------------------------------------------* 12850000 * SET UP SPECIAL MESSAGE FOR DYNAMIC ALLOCATION FAILURE * 12860000 *--------------------------------------------------------------------* 12870000 SPACE 3 12880000 DYNERROR DS 0H 12890000 ST R15,DYNRETC STORE RETURN CODE IN HOLDER 12900000 SPACE 1 12910000 BAL R14,FIXDIGIT GO FIX R12 12920000 SPACE 1 12930000 STCM R15,15,SPMG3R1 STORE IN MESSAGE 12940000 LH R15,S99ERROR PICK UP ERROR CODE 12950000 SPACE 1 12960000 BAL R14,FIXDIGIT GO FIX IT 12970000 SPACE 1 12980000 STCM R15,15,SPMG3R2 STORE IN MESSAGE 12990000 LH R15,S99INFO PICK UP INFORMATION CODE 13000000 SPACE 1 13010000 BAL R14,FIXDIGIT GO FIX IT 13020000 SPACE 1 13030000 STCM R15,15,SPMG3R3 STORE IN MESSAGE 13040000 MVI DFFLAGS+1,X'32' FLAG AS SVC99 REQUEST 13050000 LA R1,S99RB 13060000 ST R1,DFS99RB STORE SVC 99 R11 ADDRS IN DF BLOCK 13070000 LA R1,DFS99RB GET ADDRESS OF DF PARM BLOCK 13080000 LINK EP=IKJEFF18 13090000 LTR R15,R15 EXTRACT WORK OK 13100000 BZ DOS99ER 13110000 XC DFBUFL1(2),DFBUFL1 CLEAR BUFFER LENGTH OF DF MSG 13120000 XC DFBUFL2(2),DFBUFL2 CLEAR BUFFER LENGTH OF DF MSG 13130000 B ERROR12 13140000 DOS99ER DS 0H 13150000 MVI DFBUF01,X'40' SET DF BUFFERS INTO WTO FORMAT 13160000 MVI DFBUF01+1,X'00' 13170000 MVI DFBUF02,X'40' 13180000 MVI DFBUF02+1,X'00' 13190000 B ERROR12 13200000 EJECT 13210000 *--------------------------------------------------------------------* 13220000 * PARSE A COMMAND CARD FOR KEYWORDS * 13230000 *--------------------------------------------------------------------* 13240000 SPACE 3 13250000 COMCARD DS 0H 13260000 MVC COMMAND,BLANKS BLANK OUT COMMAND NAME HOLDER 13270000 MVC COMMAND2,BLANKS BLANK OUT COMMAND NAME HOLDER 13280000 LR R3,R5 GET START OF CARD 13290000 LA R4,9 SET MAX COMMAND NAME LENGTH 13300000 COMCLOOP DS 0H 13310000 CLI 0(R3),BLANK BLANK? 13320000 BE COMCEND YES, END OF COMMAND NAME 13330000 CLI 0(R3),EQUAL INVALID =? 13340000 BE COMBAD YES, FLAG AS BAD 13350000 LA R3,1(R3) BUMP TO NEXT CARD COLUMN 13360000 BCT R4,COMCLOOP 13370000 B COMBAD GO FLAG AS BAD 13380000 COMCEND DS 0H 13390000 LA R4,1(R3) SAVE ADDRESS OF NEXT BYTE 13400000 SR R3,R5 SUBTRACT TO GEN COMMAND LENGTH 13410000 ST R3,COMLEN SAVE LENGTH OF COMMAND 13420000 BCTR R3,0 DROP FOR EXECUTE 13430000 TM MASTFLAG,PARTSCAN COMMAND SCAN ONLY? 13440000 BO COMMOVE2 13450000 EX R3,COMMOVE MOVE IN COMMAND NAME 13460000 B COMPRECK 13470000 SPACE 1 13480000 COMMOVE2 DS 0H 13490000 EX R3,COM2MOVE MOVE IN COMMAND NAME 13500000 BR R6 13510000 SPACE 1 13520000 COMBAD DS 0H 13530000 OI MASTFLAG,COMBADF SET BAD COMMAND FLAG 13540000 BR R6 13550000 SPACE 3 13560000 * 13570000 * CHECK THE COMMAND VERB FOR ONE THAT WE RECOGNIZE. 13580000 * 13590000 SPACE 3 13600000 COMPRECK DS 0H SEARCH FOR A KEYWORD AFTER COMMAND 13610000 LA R2,COMTABLE GET ADDRESS OF COMMAND TABLE 13620000 COMPREF DS 0H 13630000 CLI 0(R2),BLANK END OF TABLE 13640000 BE COMBAD ERROR IF SO 13650000 CLC COMMAND,0(R2) IS THIS THE COMMAND 13660000 BE COMKEYSR YES, GET OUT OF LOOP 13670000 LA R2,COMTLEN(R2) BUMP TO NEXT EXTRY 13680000 B COMPREF 13690000 SPACE 3 13700000 * 13710000 * SEARCH THE CARD FOR KEYWORDS 13720000 * 13730000 SPACE 3 13740000 COMKEYSR DS 0H 13750000 ST R2,CURRENTF SAVE TABLE ENTRY ADDRESS 13760000 LA R1,71 LOAD TOTAL CARD LENGTH - 1 13770000 S R1,COMLEN SUBTRACT OFF COMMAND LENGTH 13780000 COMKEYSX DS 0H SEARCH FOR A KEYWORD AFTER COMMAND 13790000 * ONLY KEYWORDS ALLOWED ARE: 13800000 * DSNAME=, DSN=, D= 13810000 * VOLUME=, VOL=, V= 13820000 * NEWNAME=, NEWN=, NN=, N= 13830000 * 13840000 SPACE 1 13850000 LR R5,R4 SAVE ADDRESS OF POSSIBLE KEYW START 13860000 CLI 0(R4),BLANK BLANK? 13870000 BNE COMCKWT NO 13880000 LA R4,1(R4) BUMP TO NEXT COL 13890000 BCT R1,COMKEYSX 13900000 SPACE 1 13910000 * THE REST OF THE CARD WAS BLANK. IS THIS AN ERROR? 13920000 L R2,COMTRKWL(R2) PICK UP KWT LIST ADDRESS 13930000 LTR R2,R2 IS IT ZERO (NO KEYWORDS REQUIRED) 13940000 BZR R6 RETURN IF SO 13950000 B ERROR38 ERROR IF NOT 13960000 SPACE 3 13970000 * 13980000 * TEST IF ANY OF THE REQUIRED KEYWORDS MATCHE THE KEYWORD FOUND 13990000 * 14000000 SPACE 3 14010000 COMCKWT DS 0H 14020000 L R2,COMTRKWL(R2) PICK UP REQUIRED KEYWORD LIST ADRS 14030000 LTR R2,R2 ANY KEYWORDS REQUIRED 14040000 BZ COMCOPTS CHECK FOR OPTIONAL KEYWORDS 14050000 L R3,0(R2) PICK UP FIRST KWT ADDRS 14060000 STM R2,R3,SAVEREGS SAVE REGS FOR NEXT PASS 14070000 COMCKEY DS 0H 14080000 LM R2,R3,SAVEREGS SAVE REGS FOR NEXT PASS 14090000 COMCKEY2 DS 0H 14100000 LTR R3,R3 IS NEXT KWT ADDRESS ZERO 14110000 BZ COMCOPTS GO LOOK FOR OPTIONAL KEYWORDS 14120000 L R14,0(R3) PICK UP RTN ADDRESS 14130000 LA R3,8(R3) BUMP TO LIST PROPER 14140000 XR R1,R1 CLEAR REG 1 FOR LENGTH 14150000 COMCKEYL DS 0H 14160000 IC R1,0(R3) PICK UP LENGTH 14170000 LTR R1,R1 END OF KWT 14180000 BNZ COMCKEYM BRANCH IF NOT 14190000 LA R2,4(R2) BUMP TO NEXT KWT SLOT 14200000 L R3,0(R2) PICK UP NEXT KWT ADDRESS 14210000 B COMCKEY2 PROCESS NEXT KWT 14220000 COMCKEYM DS 0H 14230000 BCTR R1,0 DROP FOR EXECUTE 14240000 EX R1,KEYWTEST COMPARE FOR KEYWORD MATCH 14250000 BNE COMCNOM BRANCH TO ROUTINE IF MATCH 14260000 L R2,CURRENTF RELOAD CURRENT FUNCTION TABLE ADRS 14270000 L R2,COMTRKWL(R2) RESER RKW LIST TO START 14280000 L R3,0(R2) PICK UP FIRST KWT ADDRS 14290000 BR R14 BRANCH TO ROUTINE 14300000 COMCNOM DS 0H 14310000 LA R3,2(R1,R3) BUMP TO NEXT ENTRY IN KWT 14320000 B COMCKEYL 14330000 SPACE 5 14340000 *--------------------------------------------------------------------* 14350000 * * 14360000 * SINCE THE KEYWORD DOES NOT MATCH A REQUIRED KEYWORD * 14370000 * SEE IF IT MAY BE AN OPTIONAL KEYWORD. * 14380000 * * 14390000 * NOTE: NO OPTIONAL KEYWORDS ARE DEFINED IN THIS RELEASE. * 14400000 * THIS FACILITY WAS BUILT IN FOR FUTURE COMPATIBILITY * 14410000 * TO ANY NEW FUNCTIONS. * 14420000 * * 14430000 *--------------------------------------------------------------------* 14440000 SPACE 3 14450000 COMCOPTS DS 0H 14460000 L R2,CURRENTF PICK UP CURRENT TABLE ENTRY ADRS 14470000 L R2,COMTOKWL(R2) PICK UP OPTIONAL KEYWORD LIST ADRS 14480000 LTR R2,R2 IS IT ZERO (NO OPTIONAL KEYWORDS) 14490000 BZ ERROR20 ERROR IF SO 14500000 L R3,0(R2) PICK UP FIRST KWT ADDRS 14510000 COMOKEY DS 0H 14520000 COMOKEY2 DS 0H 14530000 LTR R3,R3 IS NEXT KWT ADDRESS ZERO 14540000 BZ ERROR20 BAD KEYWORD IF SO 14550000 L R14,0(R3) PICK UP RTN ADDRESS 14560000 LA R3,8(R3) BUMP TO LIST PROPER 14570000 XR R1,R1 CLEAR REG 1 FOR LENGTH 14580000 COMOKEYL DS 0H 14590000 IC R1,0(R3) PICK UP LENGTH 14600000 LTR R1,R1 END OF KWT 14610000 BNZ COMOKEYM BRANCH IF NOT 14620000 LA R2,4(R2) BUMP TO NEXT KWT SLOT 14630000 L R3,0(R2) PICK UP NEXT KWT ADDRESS 14640000 B COMOKEY2 PROCESS NEXT KWT 14650000 COMOKEYM DS 0H 14660000 BCTR R1,0 DROP FOR EXECUTE 14670000 EX R1,KEYWTEST COMPARE FOR KEYWORD MATCH 14680000 BNE COMONOM BRANCH TO ROUTINE IF MATCH 14690000 L R2,CURRENTF RELOAD CURRENT FUNCTION TABLE ADRS 14700000 L R2,COMTOKWL(R2) RESER OKW LIST TO START 14710000 L R3,0(R2) PICK UP FIRST KWT ADDRS 14720000 STM R2,R3,SAVEREGS SAVE REGS FOR NEXT PASS 14730000 BR R14 BRANCH TO ROUTINE 14740000 COMONOM DS 0H 14750000 LA R3,2(R1,R3) BUMP TO NEXT ENTRY IN KWT 14760000 B COMOKEYL 14770000 SPACE 3 14780000 *--------------------------------------------------------------------* 14790000 * PROCESS THE DSNAME KEYWORD * 14800000 *--------------------------------------------------------------------* 14810000 SPACE 3 14820000 COMDSN DS 0H 14830000 LA R5,1(R1,R5) BUMP PAST KEYWORD 14840000 TM COMFLAG,DSNKEY HAS DSN ALLREADY BEEN SPECIFIED 14850000 BO ERROR13 BRANCH IF SO 14860000 OI COMFLAG,DSNKEY FLAG DSN AS SPECIFIED 14870000 LR R3,R5 LOAD START OF DSNAME 14880000 MVI DSCBNAME,BLANK BLANK OUT DSNAME HOLDER 14890000 MVC DSCBNAME+1(43),DSCBNAME 14900000 COMDSNBL DS 0H 14910000 CLI 0(R3),BLANK END OF DSNAME 14920000 BE COMDSNE YES 14930000 CLI 0(R3),COMMA END OF DSNAME 14940000 BE COMDSNE YES 14950000 LA R3,1(R3) CONTINUE 14960000 B COMDSNBL 14970000 COMDSNE DS 0H 14980000 LR R2,R3 SAVE POINTER 14990000 SR R3,R5 COMPUTE DSN LENGTH 15000000 C R3,FOURFOUR LONGER THAN 44? 15010000 BH ERROR14 BRANCH IF SO 15020000 C R3,ONE LESS THAN ONE 15030000 BL ERROR14 BRANCH IF SO 15040000 BCTR R3,0 DROP FOR EXECUTE 15050000 EX R3,DSNMOVE MOVE IN DSNAME 15060000 LR R5,R2 RESTORE TO NEXT POSSIBLE POSITION 15070000 CLI 0(R5),BLANK END OF STRING 15080000 BER R6 RETURN IF SO 15090000 LA R5,1(R5) BUMP TO NEXT CHAR 15100000 CLI 0(R5),BLANK NEW CARD REQUIRED? 15110000 BNE COMCKEY BRANCH IF NOT 15120000 OI IOFLAG,CONTINUE MARK AS CONTINUE 15130000 BAL R14,GETACARD GO GET ONE IF SO 15140000 NI IOFLAG,FULLMASK-CONTINUE TURN OFF CONT FLAG 15150000 B COMCKEY GO LOOK FOR ANOTHER KEYWORD 15160000 SPACE 3 15170000 *--------------------------------------------------------------------* 15180000 * PROCESS THE VOLUME KEYWORD * 15190000 *--------------------------------------------------------------------* 15200000 SPACE 3 15210000 COMVOL DS 0H PROCESS VOL KEYWORD 15220000 LA R5,1(R1,R5) BUMP PAST KEYWORD 15230000 TM COMFLAG,VOLKEY HAS VOL ALLREADY BEEN SPECIFIED 15240000 BO ERROR15 BRANCH IF SO 15250000 OI COMFLAG,VOLKEY FLAG VOL AS SPECIFIED 15260000 LR R3,R5 LOAD START OF VOLSER 15270000 MVC VOLUME,BLANKS BLANK OUT VOLSER HOLDER 15280000 COMVOLBL DS 0H 15290000 CLI 0(R3),BLANK END OF VOLUME 15300000 BE COMVOLE YES 15310000 CLI 0(R3),COMMA END OF VOLUME 15320000 BE COMVOLE YES 15330000 LA R3,1(R3) CONTINUE 15340000 B COMVOLBL 15350000 COMVOLE DS 0H 15360000 LR R2,R3 SAVE POINTER 15370000 SR R3,R5 COMPUTE VOL LENGTH 15380000 C R3,SIX LONGER THAN 6? 15390000 BH ERROR16 BRANCH IF SO 15400000 C R3,ONE LESS THAN ONE 15410000 BL ERROR16 BRANCH IF SO 05/08/92 15420000 C R3,=F'6' LESS THAN ONE 05/08/92 15430000 BH ERROR16 BRANCH IF SO 05/08/92 15440000 MVC S99DDLEN(2),=H'7' VVOLSER SJB 15450000 MVC S99DSLEN(2),=H'9' &&VVOLSER SJB 15460000 MVC DAIRDSNB(2),=H'9' &&VVOLSER SJB 15470000 STH R3,S99VLEN SAVE LENGTH IN VOLSER TEXT UNIT 15480000 BCTR R3,0 DROP FOR EXECUTE 15490000 EX R3,VOLMOVE MVC VOLUME(0),0(R5) 15500000 MVC VOL,VOLUME MOVE INTO VOL SJB 15510000 MVC S99VTEXT(6),VOL SVC99 VOLSER TU SJB 15520000 MVC DA08SER(6),VOL DAIR VOLSER TU SJB 15530000 MVC DA08DDN(7),VVOL DAIR DDNAME TU VVOLSER SJB 15540000 MVC DAIRDSNV(7),VVOL DAIR DSNAME TU VVOLSER SJB 15550000 MVC S99DDTXT(7),VVOL MOVE IN DDNAME VVOLSER SJB 15560000 MVC S99DSNAM(7),VVOL MOVE IN DSNAME VVOLSER PART SJB 15570000 LR R5,R2 RESTORE TO NEXT POSSIBLE POSITION 15580000 CLI 0(R5),BLANK END OF STRING 15590000 BER R6 RETURN IF SO 15600000 LA R5,1(R5) BUMP TO NEXT CHAR 15610000 CLI 0(R5),BLANK NEW CARD REQUIRED? 15620000 * (IF BLANK AFTER COMMA THEN MUST BE 15630000 * CONTINUED ON NEXT CARD.) 15640000 BNE COMCKEY 15650000 OI IOFLAG,CONTINUE MARK AS CONTINUE 15660000 BAL R14,GETACARD GO GET ONE IF SO 15670000 NI IOFLAG,FULLMASK-CONTINUE TURN OFF CONT FLAG 15680000 B COMCKEY GO LOOK FOR ANOTHER KEYWORD 15690000 SPACE 3 15700000 *--------------------------------------------------------------------* 15710000 * PROCESS THE NEWNAME KEYWORD (VALID FOR RENAME COMMAND ONLY) * 15720000 *--------------------------------------------------------------------* 15730000 SPACE 3 15740000 COMNEWN DS 0H PROCESS NEW KEYWORD 15750000 LA R5,1(R1,R5) BUMP PAST KEYWORD 15760000 TM COMFLAG,NEWNKEY HAS NEW ALLREADY BEEN SPECIFIED 15770000 BO ERROR17 BRANCH IF SO 15780000 OI COMFLAG,NEWNKEY FLAG NEW AS SPECIFIED 15790000 LR R3,R5 LOAD START OF NEWNAME 15800000 MVI NEWNAME,BLANK BLANK OUT NEWNAME HOLDER 15810000 MVC NEWNAME+1(43),NEWNAME 15820000 COMNEWBL DS 0H 15830000 CLI 0(R3),BLANK END OF NEWNAME 15840000 BE COMNEWE YES 15850000 CLI 0(R3),COMMA END OF NEWNAME 15860000 BE COMNEWE YES 15870000 LA R3,1(R3) CONTINUE 15880000 B COMNEWBL 15890000 COMNEWE DS 0H 15900000 LR R2,R3 SAVE POINTER 15910000 SR R3,R5 COMPUTE NEW LENGTH 15920000 C R3,FOURFOUR LONGER THAN 44? 15930000 BH ERROR19 BRANCH IF SO 15940000 C R3,ONE LESS THAN ONE 15950000 BL ERROR19 BRANCH IF SO 15960000 BCTR R3,0 DROP FOR EXECUTE 15970000 EX R3,NEWNMOVE MOVE IN NEWNAME 15980000 LR R5,R2 RESTORE TO NEXT POSSIBLE POSITION 15990000 CLI 0(R5),BLANK END OF STRING 16000000 BER R6 RETURN IF SO 16010000 LA R5,1(R5) BUMP TO NEXT CHAR 16020000 CLI 0(R5),BLANK NEW CARD REQUIRED? 16030000 BNE COMCKEY BRANCH IF NOT 16040000 OI IOFLAG,CONTINUE MARK AS CONTINUE 16050000 BAL R14,GETACARD GO GET ONE IF SO 16060000 NI IOFLAG,FULLMASK-CONTINUE TURN OFF CONT FLAG 16070000 B COMCKEY GO LOOK FOR ANOTHER KEYWORD 16080000 EJECT 16090000 *--------------------------------------------------------------------* 16100000 * GET A NEW CARD (REQUIRED CONTINUATION CARD) * 16110000 *--------------------------------------------------------------------* 16120000 SPACE 3 16130000 GETACARD DS 0H 16140000 $$SUB , 16150000 GCARD100 DS 0H 16160000 OI MASTFLAG,CARD2TRY FLAG AS CARD2 TRY FOR EODAD 16170000 BAL R5,CARDIN GET ANOTHER CARD 16180000 NI MASTFLAG,FULLMASK-CARD2TRY TURN OFF CARD2 FLAG 16190000 BAL R14,SKIPB CHECK FOR ALL BLANKS 16200000 LTR R5,R5 ALL BLANKS? 16210000 BNZ GCARD200 SKIP IF NOT 16220000 BAL R14,PUTCARD PRINT BLANK CARD 16230000 B GCARD100 GET ANOTHER CARD 16240000 GCARD200 DS 0H 16250000 CLI CARD,ASTERISK COMMENT CARD? 16260000 BE GCARDPRT PRINT IF SO 16270000 TM MASTFLAG,GETSUBC LOOKING FOR A SUBCOMMAND 16280000 BNO GCARDPRT GO PRINT IF NOT (CONTINUATION CARD) 16290000 CLI CARD,BLANK COULD IT BE A VALID SUBCOMMAND CARD 16300000 BE GETRCXX RETURN TO CALLER IF SO 16310000 OI MASTFLAG,PRIMEND MARK NAME SET ENDED BY PRIMARY 16320000 NI MASTFLAG,FULLMASK-GETSUBC TURN OFF SUBCOMMAND FLAG 16330000 BAL R14,WRITDSCB 16340000 B GETRC00 16350000 GCARDPRT DS 0H 16360000 MVI MSGCC,LINES1 SET CARRIAGE CONTROL 16370000 BAL R14,PUTCARD 16380000 CLI CARD,ASTERISK COMMENT CARD? 16390000 BE GCARD100 SKIP IF SO 16400000 GCARD400 DS 0H 16410000 BAL R14,SKIPB GO SKIP THE BLANKS 16420000 LTR R5,R5 ALL BLANK? 16430000 BZ GCARD100 GET ANOTHER CARD IF SO 16440000 GETRC00 DS 0H 16450000 GETRCXX DS 0H 16460000 L R13,4(,R13) PREV SAVE 16470000 ST R5,X'28'(,R13) STORE R5 16480000 RETURN (14,12),RC=0 16490000 SPACE 3 16500000 *--------------------------------------------------------------------* 16510000 * GET A CONTROL CARD FROM SOMEWHERE (TSO, SYSIN, OR CONSOLE) * 16520000 * BAL R5,CARDIN * 16530000 *--------------------------------------------------------------------* 16540000 SPACE 3 16550000 CARDIN DS 0H 16560000 TM IOFLAG,CONSOLE CONSOLE I/O REQUIRED 16570000 BO DOCONIO BRANCH IF SO 16580000 TM IOFLAG,TSOSESS TPUT/TGET TSO I/O REQUIRED 16590000 BO DOTSIO BRANCH IF SO 16600000 GET SYSIN,CARD GET A CARD FROM SYSIN DD 16610000 BR R5 RETURN TO CALLER 16620000 EJECT 16630000 *--------------------------------------------------------------------* 16640000 * CONTROL CARDS ARE OBTAINED FROM STARTING CONSOLE * 16650000 *--------------------------------------------------------------------* 16660000 SPACE 3 16670000 DOCONIO DS 0H 16680000 XC WTORECB,WTORECB CLEAR ECB 16690000 IC R0,CONID PICK UP CONSOLE IDENTIFIER 16700000 MVI CARD,C' ' BLANK OUT REPLY HOLDER 16710000 MVC CARD+1(79),CARD 16720000 TM IOFLAG,CONTINUE IS THIS A CONTINUE CARD 16730000 BO DOCONT BRANCH IF SO 16740000 *--------------------------------------------------------------------* 16750000 * ENTER CONSOLE PROMPT FOR CONTROL CARD * 16760000 *--------------------------------------------------------------------* 16770000 LA R1,CARDMSGW PICK UP MSG BUFFER ADDRESS 16780000 WTOR MF=(E,(1)) 16790000 B DOWAIT 16800000 DOCONT DS 0H 16810000 *--------------------------------------------------------------------* 16820000 * ENTER CONSOLE PROMPT FOR CONTINUATION OF CONTROL CARD 16830000 *--------------------------------------------------------------------* 16840000 LA R1,CONTMSGW PICK UP MSG BUFFER ADDRESS 16850000 WTOR MF=(E,(1)) 16860000 SPACE 1 16870000 DOWAIT DS 0H 16880000 WAIT ECB=WTORECB 16890000 OC CARD,UPMASK SHIFT TO UPPERCASE 16900000 BR R5 16910000 EJECT 16920000 *--------------------------------------------------------------------* 16930000 * CONTROL CARDS ARE OBTAINED FROM TSO CONSOLE 16940000 *--------------------------------------------------------------------* 16950000 SPACE 3 16960000 DOTSIO DS 0H 16970000 MVI CARD,C' ' BLANK OUT REPLY HOLDER 16980000 MVC CARD+1(79),CARD 16990000 TM IOFLAG,CONTINUE IS THIS A CONTINUE CARD 17000000 BO DOTSCONT BRANCH IF SO 17010000 *--------------------------------------------------------------------* 17020000 * ENTER TSO PROMPT FOR CONTROL CARD * 17030000 *--------------------------------------------------------------------* 17040000 TPUT CARDMSG,CARDMSGL 17050000 B DOTSTGET 17060000 DOTSCONT DS 0H 17070000 *--------------------------------------------------------------------* 17080000 * ENTER CONSOLE PROMPT FOR CONTINUATION OF CONTROL CARD * 17090000 *--------------------------------------------------------------------* 17100000 TPUT CONTMSG,CONTMSGL 17110000 SPACE 1 17120000 DOTSTGET DS 0H 17130000 STAX DEFER=NO ALLOW ATTENTION INTERRUPTS 17140000 TGET CARD,80 GET A CONTROL CARD 17150000 STAX DEFER=YES DISALLOW ATTENTION INTERRUPTS 17160000 OC CARD,UPMASK FOLD TO UPPERCASE 17170000 BR R5 17180000 EJECT 17190000 *--------------------------------------------------------------------* 17200000 * SKIP LEADING BLANKS ON CARDS * 17210000 * BAL R14,SKIPB * 17220000 *--------------------------------------------------------------------* 17230000 SPACE 3 17240000 SKIPB DS 0H 17250000 LA R5,CARD 17260000 LA R1,72 LOAD COUNT MAX 17270000 SKIPLOOP DS 0H SEARCH FOR FIRST NON-BLANK COL 17280000 CLI 0(R5),BLANK BLANK 17290000 BNE SKIPEND BRANCH IF NOT 17300000 LA R5,1(R5) BUMP TO NEXT COL 17310000 BCT R1,SKIPLOOP 17320000 LA R5,0 INDICATED TOTALLY BLANK 17330000 SKIPEND DS 0H 17340000 BR R14 RETURN TO CALLER 17350000 SPACE 3 17360000 *--------------------------------------------------------------------* 17370000 * PRINT CARD IMAGE * 17380000 *--------------------------------------------------------------------* 17390000 SPACE 3 17400000 PUTCARD DS 0H 17410000 $$SUB , 17420000 TM IOFLAG,CONSOLE ARE WE ON A CONSOLE 17430000 BO PUTC900 DO NOT ECHO CARD BACK IF SO 17440000 TM IOFLAG,TSOSESS ARE WE A TSO SESSION 17450000 BO PUTC900 DO NOT ECHO CARD BACK IF SO 17460000 MVI MSGLINE,BLANK BLANK OUT MESSAGE LINE 17470000 MVC MSGLINE+1(131),MSGLINE 17480000 MVC MSGLINE(80),CARD MOVE CARD IMAGE TO MESSAGE LINE 17490000 PUT SYSPRINT,MSGBUFFR PRINT CARD IMAGE 17500000 PUTC900 DS 0H 17510000 L R13,4(,R13) 17520000 RETURN (14,12),RC=0 17530000 SPACE 5 17540000 *--------------------------------------------------------------------* 17550000 * PRINT A BLANK LINE * 17560000 * BAL R14,PUTBLANK * 17570000 *--------------------------------------------------------------------* 17580000 SPACE 3 17590000 PUTBLANK DS 0H 17600000 $$SUB , 17610000 TM IOFLAG,CONSOLE ARE WE ON A CONSOLE 17620000 BO PUTB900 DO NOT PUT BLANK LINES IF SO 17630000 TM IOFLAG,TSOSESS ARE WE A TSO SESSION 17640000 BO PUTB900 DO NOT PUT BLANK LINES IF SO 17650000 MVI MSGLINE,BLANK BLANK OUT MESSAGE LINE 17660000 MVC MSGLINE+1(131),MSGLINE 17670000 PUT SYSPRINT,MSGBUFFR PRINT A BLANK LINE 17680000 PUTB900 DS 0H 17690000 L R13,4(,R13) 17700000 RETURN (14,12),RC=0 17710000 EJECT 17720000 *--------------------------------------------------------------------* 17730000 * PRINT MESSAGE * 17740000 *--------------------------------------------------------------------* 17750000 SPACE 3 17760000 MSGOUT DS 0H 17770000 $$SUB 17780000 STH R1,MPLNUM 17790000 LA R1,MPL 17800000 L R15,VMSG 17810000 BALR R14,R15 17820000 LTR R15,R15 17830000 BZ MSGOUTXX 17840000 ABEND 777,DUMP 17850000 MSGOUTXX DS 0H 17860000 L R13,4(,R13) 17870000 RETURN (14,12),RC=0 17880000 SPACE 3 17890000 *--------------------------------------------------------------------* 17900000 * * 17910000 * THIS PORTION OF CODE TAKES THE HEX RETURN CODE IN REG 15 * 17920000 * AND CONVERTS IT TO INTEGER BINARY. * 17930000 * * 17940000 *--------------------------------------------------------------------* 17950000 SPACE 3 17960000 FIXDIGIT DS 0H 17970000 $$SUB 17980000 LA R1,RCWORD+3 GET ADDRESS OF END OF WORK WORD 17990000 LR R14,R15 TRANSFER R12 TO WORK REG 18000000 LA R4,4 LOAD NUMBER OF BYTES IN R12 18010000 FIXDLOOP DS 0H 18020000 SRDL R14,4 SHIFT 4 BITS TO R2 18030000 SRL R15,28 SHIFT R3 BITS TO LOW END 18040000 STC R15,0(R1) STORE IN BYTE IN WORK AREA 18050000 BCTR R1,0 BACK UP WORD POINTER 18060000 BCT R4,FIXDLOOP DO NEXT BYTE 18070000 SPACE 3 18080000 TR RCWORD,FIXTABLE TRANSLATE TO PRINTABLE HEX 18090000 SPACE 3 18100000 L R15,RCWORD RELOAD RETURN CODE (PRINTABLE) 18110000 L R13,4(,R13) 18120000 RETURN (14,12),RC=(15) 18130000 EJECT , 18140000 *--------------------------------------------------------------------* 18150000 * ALLOCATE THE VOLUME FOR TSO SESSION USING DAIR * 18160000 * * 18170000 * NOTE: DAIR IS USED INSTEAD OF SVC 99 TO MAINTAIN * 18180000 * NON-MVS COMPATIBILITY. * 18190000 *--------------------------------------------------------------------* 18200000 SPACE 3 18210000 ALOCDAIR DS 0H 18220000 XC DECB,DECB CLEAR DAIR ECB 18230000 L R2,CPPLHOLD 18240000 USING CPPL,R2 ADDRESS CPPL 18250000 LA R1,DAPLIST 18260000 USING DAPL,R1 18270000 MVC DAPLUPT,CPPLUPT MOVE IN UPT ADDRESS 18280000 MVC DAPLECT,CPPLECT MOVE IN ECT ADDRESS 18290000 MVC DAPLPSCB,CPPLPSCB MOVE IN PSCB ADDRESS 18300000 LINK EP=IKJDAIR INVOKE DAIR 18310000 LTR R15,R15 DAIR WORK 18320000 BZ LOOPVGO BRANCH SO 18330000 SPACE 3 18340000 *--------------------------------------------------------------------* 18350000 * SET UP SPECIAL MESSAGE FOR DAIR ALLOCATION FAILURE * 18360000 *--------------------------------------------------------------------* 18370000 SPACE 3 18380000 DAIREROR DS 0H 18390000 ST R15,DYNRETC STORE DAIR RETURN CODE 18400000 SPACE 1 18410000 BAL R14,FIXDIGIT GO FIX R12 18420000 SPACE 1 18430000 STCM R15,15,SPMG4R1 STORE IN MESSAGE 18440000 LH R15,DA08DARC PICK UP ERROR CODE 18450000 SPACE 1 18460000 BAL R14,FIXDIGIT GO FIX IT 18470000 SPACE 1 18480000 STCM R15,15,SPMG4R2 STORE IN MESSAGE 18490000 LH R15,DA08CTRC PICK UP CATALOG CODE 18500000 SPACE 1 18510000 BAL R14,FIXDIGIT GO FIX IT 18520000 SPACE 1 18530000 STCM R15,15,SPMG4R3 STORE IN MESSAGE 18540000 MVI DFFLAGS+1,X'01' FLAG AS SVC99 REQUEST 18550000 LA R1,DA08CD PICK UP DAIR 08 BLOCK 18560000 ST R1,DFDAPLP STORE DAIR R11 ADDRS IN DF BLOCK 18570000 LA R1,DFDAPLP GET ADDRESS OF DF PARM BLOCK 18580000 LINK EP=IKJEFF18 18590000 LTR R15,R15 EXTRACT WORK OK 18600000 BZ DODAIRER 18610000 XC DFBUFL1(2),DFBUFL1 CLEAR BUFFER LENGTH OF DF MSG 18620000 XC DFBUFL2(2),DFBUFL2 CLEAR BUFFER LENGTH OF DF MSG 18630000 B ERROR39 18640000 DODAIRER DS 0H 18650000 MVI DFBUF01,X'40' SET DF BUFFERS INTO WTO FORMAT 18660000 MVI DFBUF01+1,X'00' 18670000 MVI DFBUF02,X'40' 18680000 MVI DFBUF02+1,X'00' 18690000 B ERROR39 18700000 DROP R2 18710000 DROP R1 18720000 EJECT 18730000 *--------------------------------------------------------------------* 18740000 * SUBROUTINE TO: * 18750000 * READ A DSCB * 18760000 * R15= 0 OK * 18770000 * R15^= 0 ERROR * 18780000 * R0 = ERROR MESSAGE * 18790000 *--------------------------------------------------------------------* 18800000 READDSCB DS 0H 18810000 $$SUB , 18820000 LA R7,WBUFDSCB 18830000 USING BUFLIST,R7 18840000 MVC WCVAF(CVAFL),CVAF 18850000 SPACE 1 18860000 XC BUFLIST(BFLHLN+BFLELN),BUFLIST ZERO BUFFERLIST 18870000 OI BFLHFL,BFLHDSCB RETURN DSCBS NOT VIRS 18880000 MVI BFLHNOE,1 1 BUFFER 18890000 MVI BFLELTH,DSCBLTH2 BUFFER LEGNTH 18900000 LA R0,DS1FMTID 18910000 ST R0,BFLEBUF @ OF BUFFER 18920000 OI BFLEFL,BFLECHR RETURN CCHHR 18930000 SPACE 1 18940000 BAL R14,DEQUE 08/13/90 18950000 PRINT NOGEN 08/13/90 18960000 RESERVE (SYSVTOC,VOLUME,E,6,SYSTEMS),UCB=UCBADDR 08/13/90 18970000 PRINT GEN 08/13/90 18980000 LTR R15,R15 08/13/90 18990000 BNZ RDSCBRES 08/13/90 19000000 OI FLAG2,$RESERVE 08/13/90 19010000 MVC DS1DSNAM,DSCBNAME 19020000 L R2,UCBADDR UCB ADDR 19030000 MVC CVAFFUNC,=CL20'DSCB-READ' 05/08/92 19040000 PRINT NOGEN 19050000 CVAFDIR ACCESS=READ, X19060000 DSN=DS1DSNAM, READ OUR DSN X19070000 UCB=(R2), X19080000 BUFLIST=BUFLIST, X19090000 BRANCH=(YES,PGM), BRANCH ENTER X19100000 MF=(E,WCVAF) 19110000 PRINT GEN 19120000 SPACE 3 19130000 CL R15,=F'4' CVAF TO DSN OK 19140000 BL RDSCBR00 YES, 19150000 BH RDSCBRNN NO, CVAF ERROR 19160000 USING CVPL,R1 19170000 CLI CVSTAT,STAT001 DATASET NOT FOUND 19180000 BE RDSCBR04 YES, DSN NOT FOUND 19190000 B RDSCBRNN OTHER CVAF ERROR 19200000 DROP R1 19210000 RDSCBR00 DS 0H 19220000 B RDSCRC00 19230000 RDSCBR04 DS 0H DSN NOT FOUND 19240000 LA R0,ERROR2 MESSAGE TO WRITE 19250000 B RDSCRCXX 19260000 RDSCBRNN DS 0H OTHER ERRORS 19270000 LA R0,ERROR3 MESSAGE TO WRITE 19280000 B RDSCRCXX 19290000 RDSCBRES DS 0H RESERVE FAILED 19300000 LA R0,ERROR44 MESSAGE TO WRITE 19310000 B RDSCRCXX 19320000 DROP R7 19330000 SPACE 3 19340000 RDSCRC00 DS 0H 19350000 SLR R15,R15 ZERO RC 19360000 SLR R0,R0 ZERO ERROR 05/08/92 19370000 RDSCRCXX DS 0H 19380000 L R5,4(,R13) 05/08/92 19390000 STM R15,R0,X'10'(R5) SAVE R15,R0 INTO SAVEAREA 05/08/92 19400000 BAL R14,DEQUE DEQUE IF ERROR 3/18/92 19410000 L R13,4(,R13) 19420000 RETURN (14,12) REG15 AND R0 PRESET 05/08/92 19430000 EJECT , 19440000 *--------------------------------------------------------------------* 19450000 * SUBROUTINE TO: * 19460000 * WRITE A DSCB * 19470000 * R15 = 0 OK * 19480000 * R15^= 0 ERROR * 19490000 * R0 = ERROR MESSAGE * 19500000 *--------------------------------------------------------------------* 19510000 WRITDSCB DS 0H 19520000 $$SUB , 19530000 SPACE 1 19540000 TM FLAG2,$ALTER 19550000 BO WDSC0100 YES 19560000 CLC COMMAND,COMNAME NAME SUBCOMMAND SET? 19570000 BNE WDSC0100 BRANCH IF NOT 19580000 TM COMFLAG,REWRITE WAS DSCB MODIFIED 19590000 BNO WDSCRC30 DO NOT WRITE IT IF NOT 19600000 WDSC0100 DS 0H 19610000 TM MASTFLAG,TESTONLY IS THIS A TEST 19620000 BO WDSCRC28 SKIP IF SO 19630000 SPACE 1 19640000 LA R7,WBUFDSCB 19650000 USING BUFLIST,R7 19660000 SPACE 1 19670000 LA R0,DS1DSNAM 19680000 ST R0,BFLEBUF @ OF BUFFER 19690000 SPACE 1 19700000 MVI BFLELTH,DSCBLTH 140 LENGTH 19710000 OI BFLHFL,BFLHDSCB RETURN DSCBS NOT VIRS 19720000 MVI BFLHNOE,1 1 BUFFER 19730000 OI BFLEFL,BFLECHR RETURN CCHHR 19740000 SPACE 1 19750000 L R2,UCBADDR UCB ADDR 19760000 SPACE 1 19770000 MVC CVAFFUNC,=CL20'DSCB-WRITE' 05/08/92 19780000 PRINT NOGEN 19790000 CVAFDIR ACCESS=WRITE,UCB=(R2), X19800000 BUFLIST=BUFLIST, BUFLIST X19810000 BRANCH=(YES,PGM), BRANCH ENTER X19820000 MF=(E,WCVAF) 19830000 PRINT GEN 19840000 LTR R15,R15 19850000 BNZ WDSCRC04 19860000 B WDSCRC00 19870000 SPACE 3 19880000 WDSCRC04 DS 0H 19890000 LA R0,ERROR4 CVAF DSCB WRITE FAILED 19900000 B WDSCRCXX 19910000 WDSCRC28 DS 0H MSG=28 19920000 LA R0,ERROR28 19930000 LA R15,32 19940000 B WDSCRCXX 19950000 WDSCRC30 DS 0H MSG=30 19960000 LA R0,ERROR30 19970000 LA R15,32 19980000 B WDSCRCXX 19990000 SPACE 3 20000000 WDSCRC00 DS 0H 20010000 SLR R15,R15 ZERO 20020000 WDSCRCXX DS 0H 20030000 L R13,4(,R13) 20040000 ST R0,X'14'(,R13) RESET R0 20050000 RETURN (14,12),RC=(15) 20060000 SPACE 3 20070000 DROP R7 20080000 SPACE 3 20090000 *--------------------------------------------------------------------* 20100000 * BAL R14,DEQUE * 20110000 *--------------------------------------------------------------------* 20120000 DEQUE DS 0H 08/13/90 20130000 TM FLAG2,$RESERVE 08/13/90 20140000 BZ DEQ0100 08/13/90 20150000 DEQ (SYSVTOC,VOLUME,6,SYSTEMS),UCB=UCBADDR 08/13/90 20160000 NI FLAG2,255-$RESERVE 08/13/90 20170000 DEQ0100 DS 0H 08/13/90 20180000 BR R14 RETURN 08/13/90 20190000 EJECT , 20200000 *--------------------------------------------------------------------* 20210000 * SUBROUTINE TO: * 20220000 * WRITE A VIER * 20230000 * R15 = 0 OK * 20240000 * R15^= 0 ERROR * 20250000 * R0 = ERROR MESSAGE * 20260000 *--------------------------------------------------------------------* 20270000 WRITVIER DS 0H 20280000 $$SUB , 20290000 SPACE 1 20300000 CLC COMMAND,COMNAME NAME SUBCOMMAND SET? 20310000 BNE WVIR0100 BRANCH IF NOT 20320000 TM COMFLAG,REWRITE WAS DSCB MODIFIED 20330000 BNO WVIRRC30 DO NOT WRITE IT IF NOT 20340000 WVIR0100 DS 0H 20350000 TM MASTFLAG,TESTONLY IS THIS A TEST 20360000 BO WVIRRC28 SKIP IF SO 20370000 SPACE 1 20380000 L R7,CVIRCDS @ OF VIER BUFFER LIST 20390000 USING BUFLIST,R7 20400000 SPACE 1 20410000 L R2,UCBADDR UCB ADDR 20420000 SPACE 1 20430000 MVC CVAFFUNC,=CL20'VIER-WRITE' 05/08/92 20440000 PRINT NOGEN 20450000 CVAFDIR ACCESS=WRITE,UCB=(R2), X20460000 BUFLIST=(R7), BRANCH ENTER X20470000 BRANCH=(YES,PGM), BRANCH ENTER X20480000 MF=(E,WCVAF) 20490000 PRINT GEN 20500000 LTR R15,R15 20510000 BNZ WVIRRC04 20520000 B WVIRRC00 20530000 SPACE 3 20540000 WVIRRC04 DS 0H 20550000 *--------------------------------------------------------------------* 20560000 * WRITE VIER FAILED PRINT A MESSAGE * 20570000 *--------------------------------------------------------------------* 20580000 ST R15,FUNCRC SAVE AS FUNCTION RETURN CODE 20590000 CVD R15,DOUBLE 20600000 UNPK SPMG9R1,DOUBLE 20610000 OI SPMG9R1+3,SIGN MAKE SIGN PRINTABLE 20620000 B MSGSP9 20630000 WVIRERR DS 0H 20640000 LA R0,ERROR4 CVAF DSCB WRITE FAILED 20650000 B WVIRRCXX 20660000 WVIRRC28 DS 0H MSG=28 20670000 LA R0,ERROR28 20680000 LA R15,32 20690000 B WVIRRCXX 20700000 WVIRRC30 DS 0H MSG=30 20710000 LA R0,ERROR30 20720000 LA R15,32 20730000 B WVIRRCXX 20740000 SPACE 3 20750000 WVIRRC00 DS 0H 20760000 SLR R15,R15 ZERO 20770000 WVIRRCXX DS 0H 20780000 L R13,4(,R13) 20790000 ST R0,X'14'(,R13) RESET R0 20800000 RETURN (14,12),RC=(15) 20810000 SPACE 3 20820000 DROP R7 20830000 EJECT , 20840000 *--------------------------------------------------------------------* 20850000 * SUBROUTINE TO: * 20860000 * DELETE A DSN INDEX * 20870000 * R15 = 0 OK * 20880000 * R15^= 0 ERROR * 20890000 * R0 = ERROR MESSAGE * 20900000 *--------------------------------------------------------------------* 20910000 DELVIR DS 0H 20920000 $$SUB , 20930000 SPACE 1 20940000 TM FLAG2,$INDEX IS THIS INDEX VTOC 20950000 BZ DELVRC00 NO 20960000 TM FLAG2,$ALTER ALTER DSNAME 20970000 BZ DELVRC00 NO 20980000 DELV0100 DS 0H 20990000 TM MASTFLAG,TESTONLY IS THIS A TEST 21000000 BO DELVRC28 SKIP IF SO 21010000 SPACE 1 21020000 LA R7,WBUFDSCB 21030000 USING BUFLIST,R7 21040000 SPACE 1 21050000 L R2,UCBADDR UCB ADDR 21060000 SPACE 1 21070000 MVC CVAFFUNC,=CL20'INDEX-DELETE' 05/08/92 21080000 PRINT NOGEN 21090000 CVAFDSM ACCESS=IXDLT,UCB=(R2), DELETE DSN INDEX X21100000 DSN=DS1DSNAM, DSNAME X21110000 BRANCH=(YES,PGM), BRANCH ENTER X21120000 MF=(E,WCVAF) 21130000 PRINT GEN 21140000 LTR R15,R15 21150000 BNZ DELVRC04 21160000 BAL R14,WRITVIER 21170000 LTR R15,R15 21180000 BNZ ADDVRCXX 21190000 B DELVRC00 21200000 SPACE 3 21210000 DELVRC04 DS 0H 21220000 LA R0,ERROR4 CVAFDSM FAILED 21230000 B DELVRCXX 21240000 DELVRC28 DS 0H MSG=28 21250000 LA R0,ERROR28 21260000 LA R15,32 21270000 B DELVRCXX 21280000 DELVRC30 DS 0H MSG=30 21290000 LA R0,ERROR30 21300000 LA R15,32 21310000 B DELVRCXX 21320000 SPACE 3 21330000 DELVRC00 DS 0H 21340000 SLR R15,R15 ZERO 21350000 DELVRCXX DS 0H 21360000 L R13,4(,R13) 21370000 ST R0,X'14'(,R13) RESET R0 21380000 RETURN (14,12),RC=(15) 21390000 SPACE 3 21400000 DROP R7 21410000 EJECT , 21420000 *--------------------------------------------------------------------* 21430000 * SUBROUTINE TO: * 21440000 * ADD A DSN INDEX * 21450000 * R15 = 0 OK * 21460000 * R15^= 0 ERROR * 21470000 * R0 = ERROR MESSAGE * 21480000 *--------------------------------------------------------------------* 21490000 ADDVIR DS 0H 21500000 $$SUB , 21510000 SPACE 1 21520000 TM FLAG2,$INDEX IS THIS INDEX VTOC 21530000 BZ ADDVRC00 NO 21540000 TM FLAG2,$ALTER ALTER DSNAME 21550000 BZ ADDVRC00 NO 21560000 ADDV0100 DS 0H 21570000 TM MASTFLAG,TESTONLY IS THIS A TEST 21580000 BO ADDVRC28 SKIP IF SO 21590000 SPACE 1 21600000 LA R7,WBUFDSCB 21610000 USING BUFLIST,R7 21620000 SPACE 1 21630000 L R2,UCBADDR UCB ADDR 21640000 SPACE 1 21650000 MVC CVAFFUNC,=CL20'VIER-ADD' 05/08/92 21660000 PRINT NOGEN 21670000 CVAFDSM ACCESS=IXADD,UCB=(R2), ADD DSN INDEX X21680000 DSN=DS1DSNAM, DSNAME X21690000 ARG=BFLEARG, CCHHR X21700000 BRANCH=(YES,PGM), BRANCH ENTER X21710000 MF=(E,WCVAF) 21720000 PRINT GEN 21730000 LTR R15,R15 21740000 BNZ ADDVRC04 21750000 BAL R14,WRITVIER 21760000 LTR R15,R15 21770000 BNZ ADDVRCXX 21780000 B ADDVRC00 21790000 SPACE 3 21800000 ADDVRC04 DS 0H 21810000 LA R0,ERROR4 CVAFDSM FAILED 21820000 B ADDVRCXX 21830000 ADDVRC28 DS 0H MSG=28 21840000 LA R0,ERROR28 21850000 LA R15,32 21860000 B ADDVRCXX 21870000 ADDVRC30 DS 0H MSG=30 21880000 LA R0,ERROR30 21890000 LA R15,32 21900000 B ADDVRCXX 21910000 SPACE 3 21920000 ADDVRC00 DS 0H 21930000 SLR R15,R15 ZERO 21940000 ADDVRCXX DS 0H 21950000 L R13,4(,R13) 21960000 ST R0,X'14'(,R13) RESET R0 21970000 RETURN (14,12),RC=(15) 21980000 SPACE 3 21990000 DROP R7 22000000 SPACE 3 22010000 EJECT , 22020000 *--------------------------------------------------------------------* 22030000 * SUBROUTINE TO: * 22040000 * ADD A DSN INDEX * 22050000 * R15 = 0 OK * 22060000 * R15^= 0 ERROR * 22070000 * R0 = ERROR MESSAGE * 22080000 *--------------------------------------------------------------------* 22090000 RLSEVIER DS 0H 22100000 $$SUB , 22110000 TM FLAG2,$CVAFDIR CVAFDIR DONE 22120000 BZ RLSE900 NO 22130000 L R2,UCBADDR UCB ADDR 22140000 MVC CVAFFUNC,=CL20'VIER-RLSE' 05/08/92 22150000 PRINT NOGEN 22160000 CVAFDIR ACCESS=RLSE,UCB=(R2), X22170000 BUFLIST=0, RELEASE AREAS X22180000 IOAREA=NOKEEP, X22190000 IXRCDS=NOKEEP, X22200000 MAPRCDS=NO, X22210000 BRANCH=(YES,PGM), X22220000 MF=(E,WCVAF) 22230000 PRINT GEN 22240000 RLSE900 DS 0H 22250000 L R13,4(,R13) PREV SAVE 22260000 RETURN (14,12),RC=0 22270000 EJECT , 22280000 EJECT 22290000 *--------------------------------------------------------------------* 22300000 * INFORMATION AND ERROR MESSAGE NODE POINTS 22310000 *--------------------------------------------------------------------* 22320000 PRINT NOGEN 22330000 SPACE 1 22340000 *--------------------------------------------------------------------* 22350000 * 22360000 * A MESSAGE NODE IS BUILT BY THE MSGEXIT MACRO. 22370000 * IT MACRO REQUIRES THE SEQUENCE NUMBER OF 22380000 * THE MESSAGE TO BE PRINTED, A RETURN LABEL OR ABEND 22390000 * CODE (BUT NOT BOTH), AND AN OPTIONAL RETURN CODE. 22400000 * THE RETURN CODE DEFAULTS TO 8 AND SETS THE FUNCTION 22410000 * IN PROGRESS RETURN CODE. 22420000 * 22430000 *--------------------------------------------------------------------* 22440000 SPACE 1 22450000 * SPECIAL EXECUTION MESSAGES (RETURN CODES, ETC.) 22460000 MSGSP0 MSGEXIT SPMSG=SPMG0WTO,RETURN=FUNCMEND,RC= 22470000 MSGSP1 MSGEXIT SPMSG=SPMG1WTO,RETURN=CLOSEND,RC= 22480000 MSGSP2 MSGEXIT SPMSG=SPMG2WTO,RETURN=ERROR36,RC= 22490000 MSGSP3 MSGEXIT SPMSG=SPMG3WTO,RETURN=MSGSP5 22500000 MSGSP4 MSGEXIT SPMSG=SPMG4WTO,RETURN=MSGSP5 22510000 MSGSP5 MSGEXIT SPMSG=SPMG5WTO,RETURN=MSGSP6 22520000 MSGSP6 MSGEXIT SPMSG=SPMG6WTO,RETURN=CLOSEX 22530000 MSGSP8 MSGEXIT SPMSG=SPMG8WTO,RETURN=CLOSEND,RC= 22540000 MSGSP9 MSGEXIT SPMSG=SPMG9WTO,RETURN=WVIRERR,RC= 22550000 SPACE 1 22560000 * NORMAL EXECUTION MESSAGES 22570000 MESSAG28 MSGEXIT MSG=28,RETURN=CLOSEX,RC=0 22580000 MESSAG32 MSGEXIT MSG=32,RETURN=FUNCMSG2,RC=0 22590000 MESSAG33 MSGEXIT MSG=33,RETURN=LOOP1,RC=0 22600000 MESSAG35 MSGEXIT MSG=35,RETURN=NAME2,RC=0 22610000 ERROR28 EQU MESSAG28 22620000 ERROR32 EQU MESSAG32 22630000 ERROR33 EQU MESSAG33 22640000 ERROR35 EQU MESSAG35 22650000 SPACE 1 22660000 * ERROR AND EXCEPTION MESSAGES 22670000 ERROR1 MSGEXIT MSG=1,ABEND=991 22680000 ERROR2 MSGEXIT MSG=2,RETURN=CLOSEX DSN NOT FOUND 22690000 ERROR3 MSGEXIT MSG=3,ABEND=998 CVAF READ 22700000 ERROR4 MSGEXIT MSG=4,ABEND=999 CVAF WRITE 22710000 ERROR5 MSGEXIT MSG=5,RETURN=CLOSEX 22720000 ERROR6 MSGEXIT MSG=6,RETURN=CLOSEX 22730000 ERROR7 MSGEXIT MSG=7,RETURN=CLOSEX 22740000 ERROR8 MSGEXIT MSG=8,RETURN=CLOSEX 22750000 ERROR9 MSGEXIT MSG=9,RETURN=NAME 22760000 ERROR10 MSGEXIT MSG=10,RETURN=CLOSEX 22770000 ERROR11 MSGEXIT MSG=11,RETURN=CLOSEX 22780000 ERROR12 MSGEXIT MSG=12,RETURN=MSGSP3,RC= 22790000 ERROR13 MSGEXIT MSG=13,RETURN=CLOSEX 22800000 ERROR14 MSGEXIT MSG=14,RETURN=CLOSEX 22810000 ERROR15 MSGEXIT MSG=15,RETURN=CLOSEX 22820000 ERROR16 MSGEXIT MSG=16,RETURN=CLOSEX 22830000 ERROR17 MSGEXIT MSG=17,RETURN=CLOSEX 22840000 ERROR18 MSGEXIT MSG=18,RETURN=CLOSEX 22850000 ERROR19 MSGEXIT MSG=19,RETURN=CLOSEX 22860000 ERROR20 MSGEXIT MSG=20,RETURN=CLOSEX 22870000 ERROR21 MSGEXIT MSG=21,RETURN=CLOSEX 22880000 ERROR22 MSGEXIT MSG=22,RETURN=CLOSEX 22890000 ERROR23 MSGEXIT MSG=23,RETURN=CLOSEX 22900000 ERROR24 MSGEXIT MSG=24,RETURN=CLOSEX 22910000 ERROR25 MSGEXIT MSG=25,RETURN=ERROR26 22920000 ERROR26 MSGEXIT MSG=26,RETURN=CLOSE2 22930000 ERROR27 MSGEXIT MSG=27,RETURN=CLOSE,RC=12 22940000 *MSG28 USED ABOVE 22950000 ERROR29 MSGEXIT MSG=29,RETURN=CLOSEX 22960000 ERROR30 MSGEXIT MSG=30,RETURN=CLOSEX,RC=4 22970000 ERROR31 MSGEXIT MSG=31,ABEND=992 22980000 *MSG32 USED ABOVE 22990000 *MSG33 USED ABOVE 23000000 ERROR34 MSGEXIT MSG=34,RETURN=CLOSEX 23010000 *MSG35 USED ABOVE 23020000 ERROR36 MSGEXIT MSG=36,ABEND=997 23030000 ERROR37 MSGEXIT MSG=37,RETURN=CLOSE,RC=12 23040000 ERROR38 MSGEXIT MSG=38,RETURN=CLOSEX 23050000 ERROR39 MSGEXIT MSG=39,RETURN=MSGSP4,RC= 23060000 ERROR40 MSGEXIT MSG=40,RETURN=MSGSP4,RC= 23070000 ERROR41 MSGEXIT MSG=41,RETURN=CLOSEX CVAF VIER DSN NOT FOUND 23080000 ERROR42 MSGEXIT MSG=42,ABEND=998 CVAF VIER READ FAILURE 23090000 ERROR43 MSGEXIT MSG=43,ABEND=999 CVAF VIER WRITE FAILURE 23100000 ERROR44 MSGEXIT MSG=44,ABEND=944 RESERVE FAILED 23110000 EJECT 23120000 *--------------------------------------------------------------------* 23130000 * * 23140000 * MESSAGES * 23150000 * * 23160000 *--------------------------------------------------------------------* 23170000 * * 23180000 * SPECIAL MESSAGES (REQUIRE RETURN CODES OR MODIFICATION) * 23190000 * * 23200000 * SPECIAL MESSAGES ARE CONSTRUCTED AS A VALID WTO * 23210000 * REMOTE PARAMETER LIST (MF=L). SPECIAL MESSAGES * 23220000 * ARE PRINTED VIA THE 'SPMG' PARAMETER OF THE * 23230000 * MSGEXIT MACRO. * 23240000 * * 23250000 *--------------------------------------------------------------------* 23260000 SPACE 3 23270000 PRINT GEN 23280000 SPACE 1 23290000 SPMG0WTO DS 0F MESSAGE 0 WTO FORMAT 23300000 DC AL2(SPMG0L) 23310000 DC X'4000' 23320000 SPMG0 DC C' FDB9998I **** FUNCTION PROCESSING COMPLETE. RETURN CX23330000 ODE IS ' 23340000 SPMG0R DC CL4'0000' 23350000 DC C'.' 23360000 SPMG0L EQU *-SPMG0WTO 23370000 SPACE 2 23380000 SPMG1WTO DS 0F MESSAGE 1 WTO FORMAT 23390000 DC AL2(SPMG1L) 23400000 DC X'4000' 23410000 SPMG1 DC C' FDB9999I **** ALL PROCESSABLE FUNCTIONS COMPLETE. HIX23420000 GHEST RETURN ENCOUNTERED WAS ' 23430000 SPMG1R DC CL4'0000' 23440000 DC C'.' 23450000 SPMG1L EQU *-SPMG1WTO 23460000 SPACE 2 23470000 SPMG2WTO DS 0F MESSAGE 2 WTO FORMAT 23480000 DC AL2(SPMG2L) 23490000 DC X'4000' 23500000 SPMG2 DC C' FDB9997D **** DISASTER - SCRATCH FAILED AFTER DUMMY RX23510000 ENAME. SCRATCH RETURN CODE = ' 23520000 SPMG2R1 DC CL4'0000' 23530000 DC C'. REASON CODE = ' 23540000 SPMG2R2 DC CL4'0000' 23550000 DC C'.' 23560000 SPMG2L EQU *-SPMG2WTO 23570000 SPACE 2 23580000 SPMG3WTO DS 0F MESSAGE 3 WTO FORMAT 23590000 DC AL2(SPMG3L) 23600000 DC X'4000' 23610000 SPMG3 DC C' FDB9996D **** ERROR - RETURN CODE = ' 23620000 SPMG3R1 DC CL4'0000' 23630000 DC C', ERROR CODE = ' 23640000 SPMG3R2 DC CL4'0000' 23650000 DC C', INFORMATION CODE= ' 23660000 SPMG3R3 DC CL4'0000' 23670000 DC C'.' 23680000 SPMG3L EQU *-SPMG3WTO 23690000 SPACE 2 23700000 SPMG4WTO DS 0F MESSAGE 4 WTO FORMAT 23710000 DC AL2(SPMG4L) 23720000 DC X'4000' 23730000 SPMG4 DC C' FDB9995D **** ERROR - RETURN CODE = ' 23740000 SPMG4R1 DC CL4'0000' 23750000 DC C', ERROR CODE = ' 23760000 SPMG4R2 DC CL4'0000' 23770000 DC C', CATALOG CODE= ' 23780000 SPMG4R3 DC CL4'0000' 23790000 DC C'.' 23800000 SPMG4L EQU *-SPMG4WTO 23810000 SPACE 2 23820000 SPMG8WTO DS 0F MESSAGE 4 WTO FORMAT 23830000 DC AL2(SPMG8L),X'4000' 23840000 SPMG8 DC C' FDB9995D **** ERROR - CVAFTST FAILED, RETURN CODE=X23850000 ' 23860000 SPMG8R1 DC CL4'0000' 23870000 SPMG8L EQU *-SPMG8WTO 23880000 SPACE 2 23890000 SPMG9WTO DS 0F MESSAGE 4 WTO FORMAT 23900000 DC AL2(SPMG9L),X'4000' 23910000 SPMG9 DC C' FDB9994D **** ERROR - WRITE VIER FAILED, RETURN CODE=X23920000 ' 23930000 SPMG9R1 DC CL4'0000' 23940000 SPMG9L EQU *-SPMG9WTO 23950000 SPACE 2 23960000 EJECT 23970000 *--------------------------------------------------------------------* 23980000 * SPECIAL WTOR MESSAGE BUFFERS * 23990000 *--------------------------------------------------------------------* 24000000 SPACE 3 24010000 CARDMSGW DS 0F CARD MESSAGE WTOR FORMAT HEADDER 24020000 DC AL1(80) REPLY LENGTH 24030000 DC AL3(CARD) ADDRESS IF REPLY BUFFER 24040000 DC A(WTORECB) ADDRESS OF EVENT CONTROL BLOCK 24050000 DC AL2(CARDMSGL) LENGTH OF MESSAGE 24060000 DC X'4000' MCS FLAGS 24070000 CARDMSG DC C' FDB9990R **** ENTER FIXDSCB CONTROL CARD' 24080000 CARDMSGL EQU *-CARDMSG 24090000 CONTMSGW DS 0F CONT MESSAGE WTOR FORMAT HEADDER 24100000 DC AL1(80) REPLY LENGTH 24110000 DC AL3(CARD) ADDRESS IF REPLY BUFFER 24120000 DC A(WTORECB) ADDRESS OF EVENT CONTROL BLOCK 24130000 DC AL2(CONTMSGL) LENGTH OF MESSAGE 24140000 DC X'4000' MCS FLAGS 24150000 CONTMSG DC C' FDB9991R **** CONTINUE FIXDSCB CONTROL CARD' 24160000 CONTMSGL EQU *-CONTMSG 24170000 EJECT 24180000 *--------------------------------------------------------------------* 24190000 * REMOTELY EXECUTED INSTRUCTIONS 24200000 *--------------------------------------------------------------------* 24210000 SPACE 3 24220000 COMMOVE MVC COMMAND(0),0(R5) MOVE IN COMMAND NAME (EXECUTED) 24230000 COM2MOVE MVC COMMAND2(0),0(R5) MOVE IN COMMAND NAME (EXECUTED) 24240000 DSNMOVE MVC DSCBNAME(0),0(R5) MOVE IN DSNAME (EXECUTED) 24250000 NEWNMOVE MVC NEWNAME(0),0(R5) MOVE IN NEW DSNAME (EXECUTED) 24260000 VOLMOVE MVC VOLUME(0),0(R5) MOVE IN VOLSER (EXECUTED) 24270000 RECMOVE MVC RECFMH(0),0(R5) MOVE IN RECORD FORMAT(EXECUTED) 24280000 LRECLPCK PACK DOUBLE,0(0,R5) PACK IN LRECL VALUE (EXECUTED) 24290000 BLKSZPCK EQU LRECLPCK PACK IN BLKSIZE VALUE(EXECUTED) 24300000 RKPPCK EQU LRECLPCK PACK IN RKP VALUE (EXECUTED) 24310000 KEYLPCK EQU LRECLPCK PACK IN KEYL VALUE (EXECUTED) 24320000 SUBCTEST CLC 0(0,R2),0(R5) TEST FOR SUBCOMMAND (EXECUTED) 24330000 KEYWTEST CLC 1(0,R3),0(R5) TEST FOR KEYWORD (EXECUTED) 24340000 SPACE 3 24350000 *--------------------------------------------------------------------* 24360000 * CONSTANTS * 24370000 *--------------------------------------------------------------------* 24380000 SPACE 3 24390000 ZERO DC F'0' 24400000 ONE DC F'1' 24410000 FOUR DC F'4' 24420000 SIX DC F'6' 24430000 FOURFOUR DC F'44' 24440000 BIGLRECL DC F'32768' 24450000 BIGKEYL DC F'255' 24460000 PREFIXL DC F'256' 24470000 BIGRKP DC F'32767' 24480000 VMSG DC V(FIXDMSGR) 24490000 UPMASK DC CL80' ' MASK FOR UPPERCASE CONVERSION 24500000 TESTPARM DC CL4'TEST' 24510000 BLANKS DC CL8' ' 24520000 PACK8ZRO DC PL8'0' 24530000 SCRTCH DC CL8'SCRATCH' 24540000 COMNAME DC CL8'NAME' 24550000 MVSCODE DC C'03' 24560000 MAXDATE DC X'63016D' DATE = 99:365 (IN HEX) 24570000 ZERODATE DC X'000000' DATE = 00:000 (IN HEX) 24580000 MASKC0 DC X'C0' 24590000 *--------------------------------------------------------------------* 24600000 * TRANSLATION TABLE FOR MAKING RETURN CODES PRINTABLE HEX. * 24610000 *--------------------------------------------------------------------* 24620000 SPACE 1 24630000 FIXTABLE DS 0F 24640000 DC C'0123456789ABCEF' 05/08/92 24650000 EJECT 24660000 *--------------------------------------------------------------------* 24670000 * * 24680000 * DYNAMIC DATA AREAS * 24690000 * * 24700000 *--------------------------------------------------------------------* 24710000 SPACE 2 24720000 SAVEAREA DC (6*9)D'0' BLOCK OF SAVE AREAS 24730000 SAVEREGS DC 9D'0' 24740000 MPL DS 0F 24750000 MPLMTT DC A(MSGTABLE) ADDRESS OF MESSAGE TABLE 24760000 MPLDCB DC A(SYSPRINT) ADDRESS OF DCB 24770000 MPLSPADR DC A(0) ADDRESS OF SPECIAL MESSAGE 24780000 MPLNUM DC H'0' MESSAGE NUMBER TO BE PRINTED 24790000 MPLIOF DC X'0' MPL I/O FLAG 24800000 MPLCON DC X'0' MPL CONSOLE ID 24810000 CARD DC CL80' ' INPUT CARD IMAGE 24820000 HIGHRC DC F'0' HIGHEST RETURN CODE ENCOUNTERED 24830000 FUNCRC DC F'0' CURRENT FUNCTION RETURN CODE 24840000 TSOWORD DS A ADDRESS OF EXTRACTED TSO INDICATOR 24850000 TIOTADRS DS A EXTRACTED TIOT ADDRESS 24860000 CPPLHOLD DS A TSO CPPL ADDRESS 24870000 THYMEOYR DC D'0' YEAR COMPUTATION HOLDER 24880000 DAYTHYME DC D'0' DAY COMPUTATION HOLDER 24890000 DOUBLE DC D'0' PACKING WORD 24900000 CURRENTF DC F'0' ADDRESS OF CURRENT FUNCTION T/ENTRY 24910000 COMLEN DC F'0' LENGTH OF COMMAND 24920000 COMMAND DC CL8' ' CURRENT COMMAND 24930000 COMMAND2 DC CL8' ' POSSIBLE NEW COMMAND DURING NAME 24940000 RECFMH DC CL5' ' RECORD FORMAT HOLDER 24950000 OPTCODEH DC C' ' OPT CODE HOLDER 24960000 DSORGH DC CL3' ' DATASET ORGANIZATION HOLDER 24970000 NEWNAME DC CL44' ' NEW DATASET NAME HOLDER 24980000 DSCBNAME DS CL44 24990000 TEMPNAME DC CL44'FIXDSCB.SCRATCH.DATASET' 25000000 SYSVTOC DC CL8'SYSVTOC' 25010000 SPACE 1 25020000 * MASTER FLAG FOR ENTIRE RUN 25030000 MASTFLAG DC X'00' 25040000 TESTONLY EQU X'80' THIS RUN IS A TEST ONLY (NO REWRITE OF DSCB'S) 25050000 CARD2TRY EQU X'40' THIS GET FOR A CONTINUATION OR SUBCOMMAND CARD 25060000 GETSUBC EQU X'20' THIS GET FOR A SUBCOMMAND CARD 25070000 PRIMEND EQU X'10' PRIMARY ENCOUNTERED DURING SUBCOMMAND PROCESSING 25080000 PARTSCAN EQU X'08' SCAN CARD FOR COMMAND ONLY 25090000 COMBADF EQU X'04' SCANNED COMMAND CONTAINED AN = SIGN 25100000 MVSSYS EQU X'02' SYSTEM IS AN MVS RELEASE (SVC 99 AVAILABLE) 25110000 SPACE 1 25120000 * FUNCTION FLAG FOR ONE FUNCTION REQUEST 25130000 COMFLAG DC X'00' 25140000 DSNKEY EQU X'80' THE DSN KEYWORD HAS BEEN ENCOUNTERED IN SCAN 25150000 VOLKEY EQU X'40' THE VOLUME KEYWORD HAS BEEN ENCOUNTERED IN SCAN 25160000 NEWNKEY EQU X'20' THE NEWNAME KEYWORD HAS BEEN ENCOUNTERED IN SCAN 25170000 REWRITE EQU X'01' THE DSCB HAS BEEN MODIFIED AND MUST BE WRITTEN 25180000 SPACE 1 25190000 * I/O TYPE INDICATOR FLAG 25200000 IOFLAG DC X'00' 25210000 CONSOLE EQU X'80' ALL I/O MUST BE WTO/WTOR TO STARTING CONSOLE 25220000 CONTINUE EQU X'40' CONTINUE CARD REQUIRED 25230000 TSOSESS EQU X'20' ALL I/O MUST BE TPUT/TGET TO TSO 25240000 SPACE 1 25250000 FLAG2 DC X'00' 06/29/84 25260000 $INDEX EQU X'80' INDEX VTOC IN USE 06/29/84 25270000 $CVAFDIR EQU X'40' CVAFDIR ISSUES 25280000 $ALTER EQU X'20' ALTERING DATASET NAME 25290000 $RESERVE EQU X'10' RESERVE DONE 08/13/90 25300000 DS 0F 25310000 EXITLIST DC X'87',AL3(JFCBAREA) READ JFCB EXIT 25320000 * 25330000 JFCBAREA DS 0D,CL176 INTERNAL JFCB AREA 25340000 DSCBAREA DS 0D,148C OBTAIN WORK AREA 25350000 VIERAREA DS 0D,CL(VXHRLEN) 25360000 * 25370000 ESTAE ESTAE ,CT,PARAM=0, SJB X25380000 TERM=YES,MF=L SJB 25390000 ESTAEL EQU *-ESTAE SJB 25400000 * 25410000 VOLIST DC H'1' ----+ 14 BYTES 05/08/92 25420000 VOLUNIT DC X'00000000' | VOLUME UNIT TYPE FROM UCB 05/08/92 25430000 VOLUME DC CL6' ' | VOLSER (BLANKS FOR DDNAME STUFF 25440000 VOLSTAT DC H'0' <<--+ SCRATCH STATUS CODE 05/08/92 25450000 * 25460000 VVOL DC C'V',CL6' ' 25470000 VOL EQU VVOL+1,6 25480000 * 25490000 RCSAVE DC F'0' SAVE AREA FOR REG 15 DURING MSG RTNS 25500000 RCWORD DC F'0' WORK WORD FOR R12 FIXING FOR PRINT 25510000 CVAFFUNC DC CL20' ' 05/08/92 25520000 MSGBUFFR DS 0CL133 25530000 MSGCC DC C' ' 25540000 MSGLINE DC CL132' ' 25550000 CONID DC X'00' CONSOLE ID FOR STARTED TASK I/O VIA WTO 25560000 WTORECB DC F'0' ECB FOR WTOR REPLY WAIT 25570000 DECB DC F'0' ECB FOR DAIR 25580000 VTOCDDN DC CL8' ' 25590000 UCBADDR DC F'0' 25600000 DAIRDSNB DC H'9' 25610000 DC X'5050' 25620000 DAIRDSNV DC CL42' ' 25630000 EJECT , 25640000 *--------------------------------------------------------------------* 25650000 * * 25660000 * MACRO EXPANSIONS * 25670000 * * 25680000 *--------------------------------------------------------------------* 25690000 SPACE 3 25700000 *--------------------------------------------------------------------* 25710000 * REMOTE CAMLIST MACRO EXPANSION * 25720000 *--------------------------------------------------------------------* 25730000 SPACE 1 25740000 DS 0D 25750000 DSCBADDR CAMLST SEARCH,DSCBNAME,VOLUME,DSCBAREA 25760000 SPACE 1 25770000 DC 5D'0' 25780000 SCRLIST CAMLST SCRATCH,TEMPNAME,,VOLIST 25790000 DC 5D'0' 25800000 SPACE 3 25810000 *--------------------------------------------------------------------* 25820000 * CVAF AREAS * 25830000 *--------------------------------------------------------------------* 25840000 SPACE 3 25850000 WBUFDSCB DC 0CL(BUFLEN)' ',(BUFLEN)X'00' 25860000 SPACE 3 25870000 CVAF CVAFDIR MF=L, CVAFDIR VIR XXXXXXXX25880000 MAPRCDS=YES, XXXXXXXX25890000 IOAREA=KEEP, XXXXXXXX25900000 IXRCDS=KEEP 25910000 CVAFL EQU *-CVAF LENGTH 25920000 WCVAF DC 0CL(CVAFL)' ',(CVAFL)X'00' 25930000 SPACE 3 25940000 *--------------------------------------------------------------------* 25950000 * DATA CONTROL BLOCKS (DCB'S) * 25960000 *--------------------------------------------------------------------* 25970000 SPACE 1 25980000 PRINT NOGEN 25990000 VTOCDCB DCB MACRF=(E),DSORG=DA,DDNAME=DDNAME,EXLST=EXITLIST 26000000 SYSPRINT DCB MACRF=(PM),DDNAME=SYSPRINT,RECFM=FBA,LRECL=133, X26010000 BLKSIZE=1330,DSORG=PS 26020000 SYSIN DCB MACRF=(GM),DDNAME=SYSIN,DSORG=PS,EODAD=CLOSE 26030000 PRINT GEN 26040000 *--------------------------------------------------------------------* 26050000 * LITERALS (IF ANY) * 26060000 *--------------------------------------------------------------------* 26070000 SPACE 3 26080000 LTORG 26090000 EJECT 26100000 *--------------------------------------------------------------------* 26110000 * DYNAMIC ALLOCATION (DAIR08) CONTROL BLOCK 26120000 *--------------------------------------------------------------------* 26130000 SPACE 3 26140000 DAPLIST DS 0F 26150000 DC A(0,0) 26160000 DC A(DECB) 26170000 DC A(0) 26180000 DC A(DAIR08) 26190000 SPACE 3 26200000 DAIR08 DS 0F 26210000 DA08CD DC X'0008' 26220000 DA08FLG DC X'0000' 26230000 DA08DARC DC X'0000' 26240000 DA08CTRC DC X'0000' 26250000 DA08PDSN DC A(DAIRDSNB) 26260000 DA08DDN DC CL8' ' 26270000 DA08UNIT DC CL8'SYSALLDA' 26280000 DA08SER DC CL6' ' 26290000 DC CL2' ' 26300000 DA08BLK DC A(80) 26310000 DA08PQTY DC A(1) 26320000 DA08SQTY DC A(0) 26330000 DA08DQTY DC A(0) 26340000 DA08MNM DC CL8' ' 26350000 DA08PSWD DC CL8' ' 26360000 DA08DSP1 DC X'04' 26370000 DA08DSP2 DC X'04' 26380000 DA08DSP3 DC X'04' 26390000 DA08CTL DC X'40' 26400000 DA08RSV DC AL3(0) 26410000 DA08DSO DC X'00' 26420000 DA08ALN DC CL8' ' 26430000 EJECT 26440000 *--------------------------------------------------------------------* 26450000 * DYNAMIC ALLOCATION (SVC 99) CONTROL BLOCKS * 26460000 *--------------------------------------------------------------------* 26470000 SPACE 3 26480000 DS 0F MOVE TO FULL WORD BOUNDARY 26490000 S99RBPTR DC X'80',AL3(S99RB) SVC 99 REQUEST BLOCK POINTER 26500000 SPACE 1 26510000 S99RB DS 0F SVC 99 REQUEST BLOCK 26520000 DC AL1(20) R11 LENGTH 26530000 DC AL1(01) VERB 01 = DSNAME ALLOCATION (TEMP) 26540000 S99F1 DC AL2(0) FLAGS1 26550000 S99ERROR DC AL2(0) ERROR CODES 26560000 S99INFO DC AL2(0) INFORMATION CODES 26570000 DC A(S99TUPL) TEXT UNIT POINTER LIST 26580000 DC A(0) RESERVED 26590000 S99F2 DC A(0) FLAGS2 26600000 SPACE 1 26610000 S99TUPL DS 0F SVC 99 TEXT UNIT POINTER LIST 26620000 DC A(S99DSN) DSNAME TEXT UNIT 26630000 DC A(S99DDN) DDNAME TEXT UNIT 26640000 DC A(S99VOL) VOLUME TEXT UNIT 26650000 DC A(S99DSTAT) DATASET STATUS TEXT UNIT 26660000 DC A(S99DISP) DATASET DISPOSITION 26670000 DC A(S99UNIT) UNIT NAME TEXT UNIT 26680000 DC A(S99TRACK) DATASET TRACK TEXT UNIT 26690000 DC A(S99SPACE) DATASET SPACE TEXT UNIT 26700000 DC X'80',AL3(0) END OF LIST 26710000 SPACE 1 26720000 S99DSN DS 0F VOLUME TEXT UNIT 26730000 S99DSKEY DC X'0002' 26740000 S99DS# DC X'0001' 26750000 S99DSLEN DC X'0009' 26760000 S99DSTXT DC X'5050' TEMPORARY DSN=&&VVOLSER 26770000 S99DSNAM DC CL7' ' 26780000 SPACE 1 26790000 S99DDN DS 0F DDNAME TEXT UNIT 26800000 S99DDKEY DC X'0001' 26810000 S99DD# DC X'0001' 26820000 S99DDLEN DC X'0008' 26830000 S99DDTXT DC CL8' ' 26840000 SPACE 1 26850000 S99VOL DS 0F VOLUME TEXT UNIT 26860000 S99VKEY DC X'0010' 26870000 S99V# DC X'0001' 26880000 S99VLEN DC X'0006' 26890000 S99VTEXT DC CL6' ' 26900000 SPACE 1 26910000 S99DSTAT DS 0F DS STATUS TEXT UNIT 26920000 S99DKEY DC X'0004' 26930000 S99D# DC X'0001' 26940000 S99DLEN DC X'0001' 26950000 S99DTEXT DC X'01' DISP = (OLD,...) 26960000 SPACE 1 26970000 S99DISP DS 0F DISP= (...,DELETE) 26980000 S99DIKEY DC X'0005' 26990000 S99DI# DC X'0001' 27000000 S99DILEN DC X'0001' 27010000 S99DITXT DC X'04' 27020000 SPACE 1 27030000 S99UNIT DS 0F UNIT NAME TEXT UNIT 27040000 S99UKEY DC X'0015' 27050000 S99U# DC X'0001' 27060000 S99ULEN DC X'0008' 27070000 S99UTEXT DC CL8'SYSALLDA' 27080000 SPACE 1 27090000 S99TRACK DS 0F SPACE TYPE TEXT UNIT 27100000 S99TKEY DC X'0007' 27110000 S99T# DC X'0000' 27120000 SPACE 1 27130000 S99SPACE DS 0F SPACE AMOUNT TEXT UNIT 27140000 S99SPKEY DC X'000A' 27150000 S99SP# DC X'0001' 27160000 S99SPLEN DC X'0003' 27170000 S99SPTXT DC X'000000' 1 UNIT (TRACK) 27180000 EJECT 27190000 * 27200000 * DAIRFAIL PARAMETER BLOCKS 27210000 * 27220000 SPACE 3 27230000 DFS99RB DC A(0) 27240000 DFDAPLP EQU DFS99RB 27250000 DFRCP DC A(DYNRETC) 27260000 DFJEFF02 DC A(ZERO) 27270000 DFIDP DC A(DFFLAGS) 27280000 DFCPPLP DC A(0) 27290000 DFBUFFP DC A(DFBUFS) 27300000 DYNRETC DC A(0) 27310000 DFFLAGS DC X'4000' 27320000 DFBUFS DS 0F 27330000 DFFLMSG EQU * 27340000 DFBUFL1 DC AL2(0) 27350000 DFBUF01 DC AL2(0) 27360000 DFBUFT1 DC CL251' ' 27370000 DFSLMSG DS 0F 27380000 DFBUFL2 DC AL2(0) 27390000 DFBUF02 DC AL2(0) 27400000 DFBUFT2 DC CL251' ' 27410000 SPMG5WTO EQU DFFLMSG USE DF BUFFER FOR MESSAGE 5 27420000 SPMG6WTO EQU DFSLMSG USE DF BUFFER FOR MESSAGE 6 27430000 EJECT 27440000 SPACE 3 27450000 *--------------------------------------------------------------------* 27460000 * COMMAND TABLE * 27470000 *--------------------------------------------------------------------* 27480000 SPACE 3 27490000 COMTABLE DS 0F 27500000 DC CL8'RENEW' RENEW COMMAND 27510000 COMTADR EQU *-COMTABLE ADDRESS OF COMMAND ROUTINE 27520000 DC A(RENEW) 27530000 COMTRKWL EQU *-COMTABLE 27540000 DC A(RKWLIST1) ADDRESS OF REQUIRED KWT LIST 27550000 COMTOKWL EQU *-COMTABLE 27560000 DC A(0) ADDRESS OF OPTIONAL KWT LIST 27570000 COMTLEN EQU *-COMTABLE LENGTH OF A TABLE ENTRY 27580000 DC CL8'RACFON ',A(RACFON),A(RKWLIST1),A(0) 27590000 DC CL8'RACFOFF',A(RACFOFF),A(RKWLIST1),A(0) 27600000 DC CL8'PROTECT',A(PROTECT),A(RKWLIST1),A(0) 27610000 DC CL8'SETNOPWR',A(SETNOPWR),A(RKWLIST1),A(0) 27620000 DC CL8'UNLOCK',A(UNLOCK),A(RKWLIST1),A(0) 27630000 DC CL8'EXPIRE',A(EXPIRE),A(RKWLIST1),A(0) 27640000 DC CL8'EXTEND',A(EXTEND),A(RKWLIST1),A(0) 27650000 DC CL8'ZEROEXPD',A(ZEROEXPD),A(RKWLIST1),A(0) 27660000 DC CL8'RENAME',A(RENAME),A(RKWLIST2),A(0) 27670000 DC CL8'NAME',A(NAME),A(RKWLIST1),A(0) 27680000 DC CL8'SCRATCH',A(SCRATCH),A(RKWLIST1),A(0) 27690000 DC CL8'END',A(END),A(0),A(0) 27700000 DC C' ' END OF TABLE 27710000 EJECT 27720000 *--------------------------------------------------------------------* 27730000 * KEYWORD TABLES * 27740000 * * 27750000 * A KWT IS A TABLE THAT DESCRIBES A KEYWORD AND ALL ACCEPTABLE * 27760000 * ABREVIATIONS OF IT. * 27770000 * * 27780000 *--------------------------------------------------------------------* 27790000 SPACE 3 27800000 KWTDSN DC A(COMDSN) ADRS OF ROUTINE TO HANDLE KEYWORD 27810000 DC AL1(DSNKEY) FLAG THAT INDICATES KW SUPPLIED 27820000 DC AL3(ERROR6) ADRS OF ERROR RTN IF KW OMITTED 27830000 DC AL1(7) LENGTH 27840000 DC C'DSNAME=' KEYWORD 27850000 DC AL1(4) LENGTH 27860000 DC C'DSN=' ABREVIATION 27870000 DC AL1(2) LENGTH 27880000 DC C'D=' ABREVIATION 27890000 DC AL1(0) END OF KWT 27900000 SPACE 3 27910000 KWTVOL DC A(COMVOL) ADRS OF ROUTINE TO HANDLE KEYWORD 27920000 DC AL1(VOLKEY) FLAG THAT INDICATES KW SUPPLIED 27930000 DC AL3(ERROR7) ADRS OF ERROR RTN IF KW OMITTED 27940000 DC AL1(7) LENGTH 27950000 DC C'VOLUME=' KEYWORD 27960000 DC AL1(4) LENGTH 27970000 DC C'VOL=' ABREVIATION 27980000 DC AL1(2) LENGTH 27990000 DC C'V=' ABREVIATION 28000000 DC AL1(0) END OF KWT 28010000 SPACE 3 28020000 KWTNEWN DC A(COMNEWN) ADRS OF ROUTINE TO HANDLE KEYWORD 28030000 DC AL1(NEWNKEY) FLAG THAT INDICATES KW SUPPLIED 28040000 DC AL3(ERROR8) ADRS OF ERROR RTN IF KW OMITTED 28050000 DC AL1(8) LENGTH 28060000 DC C'NEWNAME=' KEYWORD 28070000 DC AL1(5) LENGTH 28080000 DC C'NEWN=' ABREVIATION 28090000 DC AL1(3) LENGTH 28100000 DC C'NN=' ABREVIATION 28110000 DC AL1(2) LENGTH 28120000 DC C'N=' ABREVIATION 28130000 DC AL1(0) END OF KWT 28140000 SPACE 3 28150000 *--------------------------------------------------------------------* 28160000 * RKWLIST'S ARE LIST OF REQUIRED KWT FOR A FUNCTION * 28170000 *--------------------------------------------------------------------* 28180000 SPACE 3 28190000 RKWLIST1 DS 0H 28200000 DC A(KWTDSN) 28210000 DC A(KWTVOL) 28220000 DC A(0) 28230000 SPACE 3 28240000 RKWLIST2 DS 0H 28250000 DC A(KWTDSN) 28260000 DC A(KWTVOL) 28270000 DC A(KWTNEWN) 28280000 DC A(0) 28290000 SPACE 3 28300000 *--------------------------------------------------------------------* 28310000 * SUBCOMMAND TABLE * 28320000 *--------------------------------------------------------------------* 28330000 SPACE 3 28340000 SUBTABLE DS 0F 28350000 DC CL8'LRECL' LRECL CHANGE 28360000 SUBTADR EQU *-SUBTABLE ADDRESS OF PROCESSING ROUTINE 28370000 DC A(LRECL) 28380000 SUBTSCL EQU *-SUBTABLE LENGTH OF THE SUBCOMMAND NAME 28390000 DC A(5) 28400000 SUBTLEN EQU *-SUBTABLE LENGTH OF A SUBC TABLE ENTRY 28410000 DC CL8'BLKSIZE',A(BLKSIZE,7) CHANGE BLKSIZE 28420000 DC CL8'DSORG',A(DSORG,5) RESET DSORG 28430000 DC CL8'RECFM',A(RECFM,5) RESET RECORD FORMAT 28440000 DC CL8'KEYL',A(KEYL,4) RESET KEY LENGTH 28450000 DC CL8'RKP',A(RKP,3) RESET REL KEY POSITION 28460000 DC CL8'OPTCODE',A(OPTCODE,7) RESET OPTCODE 28470000 DC CL8'ENDNAME',A(ENDNAME,7) END NAME SUBCOMMAND LIST 28480000 DC C' ' END OF TABLE 28490000 SPACE 3 28500000 *--------------------------------------------------------------------* 28510000 * OPTCODE TABLE * 28520000 *--------------------------------------------------------------------* 28530000 SPACE 3 28540000 OPTCODET DS 0H 28550000 OPTW EQU X'80' 28560000 OPTU EQU X'40' 28570000 OPTC EQU X'20' 28580000 OPTH EQU X'10' 28590000 OPTO EQU X'10' 28600000 OPTQ EQU X'08' 28610000 OPTZ EQU X'04' 28620000 OPTT EQU X'02' 28630000 OPTJ EQU X'01' 28640000 DC C'W' 28650000 OPTCMASK EQU *-OPTCODET OFFSET TO MASK BYTE IN ENTRY 28660000 DC AL1(OPTW) WRITE VALIDITY CHECK (DASD) 28670000 OPTCLEN EQU *-OPTCODET 28680000 DC C'U',AL1(OPTU) ALLOW DATA CHECK (INVALID CHAR) 28690000 DC C'C',AL1(OPTC) CHAINED SCHEDULING 28700000 DC C'H',AL1(OPTH) OCR HOPPER ENPTY EXIT? 28710000 DC C'O',AL1(OPTO) OCR ON-LINE CORRECTION 28720000 DC C'Q',AL1(OPTQ) ASCII TRANSLATION REQUIRED 28730000 DC C'Z',AL1(OPTZ) REDUCED ERROR RECOVERY 28740000 DC C'T',AL1(OPTT) USER TOTALING 28750000 DC C'J',AL1(OPTJ) DYNAMIC SELECT OF TRANSLATE TAB 28760000 DC C' ' END OF TABLE 28770000 SPACE 3 28780000 *--------------------------------------------------------------------* 28790000 * DATASET ORGANIZATION TABLE * 28800000 *--------------------------------------------------------------------* 28810000 SPACE 3 28820000 DSORGTAB DS 0H 28830000 ISAM EQU X'8000' 28840000 PHYSEQ EQU X'4000' 28850000 DIRECT EQU X'2000' 28860000 PDS EQU X'0200' 28870000 UNMOVE EQU X'0100' 28880000 VSAM EQU X'0008' 28890000 DC CL3'PS ',AL2(PHYSEQ) 28900000 DSORGLEN EQU *-DSORGTAB 28910000 DC CL3'PSU',AL2(PHYSEQ+UNMOVE) 28920000 DC CL3'DA ',AL2(DIRECT) 28930000 DC CL3'DAU',AL2(DIRECT+UNMOVE) 28940000 DC CL3'IS ',AL2(ISAM) 28950000 DC CL3'ISU',AL2(ISAM+UNMOVE) 28960000 DC CL3'PO ',AL2(PDS) 28970000 DC CL3'POU',AL2(PDS+UNMOVE) 28980000 DC CL3'VS ',AL2(VSAM) 28990000 DC C' ' 29000000 EJECT 29010000 *--------------------------------------------------------------------* 29020000 * RECORD FORMAT TABLE * 29030000 *--------------------------------------------------------------------* 29040000 SPACE 3 29050000 RECFMTAB DS 0H 29060000 FIXED EQU X'80' 29070000 VARIABLE EQU X'40' 29080000 UNDEFINE EQU X'C0' 29090000 TOVRFLOW EQU X'20' 29100000 BLOCKED EQU X'10' 29110000 FSTANDRD EQU X'08' 29120000 VSPANNED EQU X'08' 29130000 ASACC EQU X'04' 29140000 MCHCC EQU X'02' 29150000 DC CL5'U ' 29160000 RECFMASK EQU *-RECFMTAB OFFSET TO MASK BYTE IN ENTRY 29170000 DC AL1(UNDEFINE) 29180000 RECFMLEN EQU *-RECFMTAB 29190000 DC CL5'UT ',AL1(UNDEFINE+TOVRFLOW) 29200000 DC CL5'UA ',AL1(UNDEFINE+ASACC) 29210000 DC CL5'UM ',AL1(UNDEFINE+MCHCC) 29220000 DC CL5'UTA ',AL1(UNDEFINE+TOVRFLOW+ASACC) 29230000 DC CL5'UTM ',AL1(UNDEFINE+TOVRFLOW+MCHCC) 29240000 DC CL5'F ',AL1(FIXED) 29250000 DC CL5'FB ',AL1(FIXED+BLOCKED) 29260000 DC CL5'FS ',AL1(FIXED+FSTANDRD) 29270000 DC CL5'FT ',AL1(FIXED+TOVRFLOW) 29280000 DC CL5'FBS ',AL1(FIXED+BLOCKED+FSTANDRD) 29290000 DC CL5'FBT ',AL1(FIXED+BLOCKED+TOVRFLOW) 29300000 DC CL5'FBST ',AL1(FIXED+BLOCKED+FSTANDRD+TOVRFLOW) 29310000 DC CL5'FA ',AL1(FIXED+ASACC) 29320000 DC CL5'FBA ',AL1(FIXED+BLOCKED+ASACC) 29330000 DC CL5'FSA ',AL1(FIXED+FSTANDRD+ASACC) 29340000 DC CL5'FTA ',AL1(FIXED+TOVRFLOW+ASACC) 29350000 DC CL5'FBSA ',AL1(FIXED+BLOCKED+FSTANDRD+ASACC) 29360000 DC CL5'FBTA ',AL1(FIXED+BLOCKED+TOVRFLOW+ASACC) 29370000 DC CL5'FBSTA',AL1(FIXED+BLOCKED+FSTANDRD+TOVRFLOW+ASACC) 29380000 DC CL5'FM ',AL1(FIXED+MCHCC) 29390000 DC CL5'FBM ',AL1(FIXED+BLOCKED+MCHCC) 29400000 DC CL5'FSM ',AL1(FIXED+FSTANDRD+MCHCC) 29410000 DC CL5'FTM ',AL1(FIXED+TOVRFLOW+MCHCC) 29420000 DC CL5'FBSM ',AL1(FIXED+BLOCKED+FSTANDRD+MCHCC) 29430000 DC CL5'FBTM ',AL1(FIXED+BLOCKED+TOVRFLOW+MCHCC) 29440000 DC CL5'FBSTM',AL1(FIXED+BLOCKED+FSTANDRD+TOVRFLOW+MCHCC) 29450000 DC CL5'V ',AL1(VARIABLE) 29460000 DC CL5'VB ',AL1(VARIABLE+BLOCKED) 29470000 DC CL5'VS ',AL1(VARIABLE+VSPANNED) 29480000 DC CL5'VT ',AL1(VARIABLE+TOVRFLOW) 29490000 DC CL5'VBS ',AL1(VARIABLE+BLOCKED+VSPANNED) 29500000 DC CL5'VBT ',AL1(VARIABLE+BLOCKED+TOVRFLOW) 29510000 DC CL5'VBST ',AL1(VARIABLE+BLOCKED+VSPANNED+TOVRFLOW) 29520000 DC CL5'VA ',AL1(VARIABLE+ASACC) 29530000 DC CL5'VBA ',AL1(VARIABLE+BLOCKED+ASACC) 29540000 DC CL5'VSA ',AL1(VARIABLE+VSPANNED+ASACC) 29550000 DC CL5'VTA ',AL1(VARIABLE+TOVRFLOW+ASACC) 29560000 DC CL5'VBSA ',AL1(VARIABLE+BLOCKED+VSPANNED+ASACC) 29570000 DC CL5'VBTA ',AL1(VARIABLE+BLOCKED+TOVRFLOW+ASACC) 29580000 DC CL5'VBSTA',AL1(VARIABLE+BLOCKED+VSPANNED+TOVRFLOW+ASACC) 29590000 DC CL5'VM ',AL1(VARIABLE+MCHCC) 29600000 DC CL5'VBM ',AL1(VARIABLE+BLOCKED+MCHCC) 29610000 DC CL5'VSM ',AL1(VARIABLE+VSPANNED+MCHCC) 29620000 DC CL5'VTM ',AL1(VARIABLE+TOVRFLOW+MCHCC) 29630000 DC CL5'VBSM ',AL1(VARIABLE+BLOCKED+VSPANNED+MCHCC) 29640000 DC CL5'VBTM ',AL1(VARIABLE+BLOCKED+TOVRFLOW+MCHCC) 29650000 DC CL5'VBSTM',AL1(VARIABLE+BLOCKED+VSPANNED+TOVRFLOW+MCHCC) 29660000 DC C' ' 29670000 EJECT 29680000 *--------------------------------------------------------------------* 29690000 * ERROR MESSAGE TABLE CSECTS 29700000 *--------------------------------------------------------------------* 29710000 SPACE 3 29720000 PRINT NOGEN 29730000 ERRMSG1 MSGSETUP ' FDB0001D **** DISASTER - READ OF JFCB FAILED.' 29740000 ERRMSG2 MSGSETUP ' FDB0002E **** ERROR - CVAF FAILURE. DATA SET NX29750000 OT FOUND ON VOLUME SPECIFIED. CHECK FOR SPELLING ERRORSX29760000 .' 29770000 ERRMSG3 MSGSETUP ' FDB0003D **** DISASTER - CVAF READ FAILED. RUN AX29780000 BORTED.' 29790000 ERRMSG4 MSGSETUP ' FDB0004D **** DISASTER - CVAF WRITE FAILED. RUN X29800000 ABORTED.' 29810000 ERRMSG5 MSGSETUP ' FDB0005E **** ERROR - UNKNOWN COMMAND SPECIFIED. X29820000 THIS CONTROL CARD IGNORED.' 29830000 ERRMSG6 MSGSETUP ' FDB0006E **** ERROR - DATASET NAME NOT SPECIFIED.X29840000 COMMAND NOT EXECUTED.' 29850000 ERRMSG7 MSGSETUP ' FDB0007E **** ERROR - VOLUME SERIAL NUMBER NOT SPX29860000 ECIFIED. COMMAND NOT EXECUTED.' 29870000 ERRMSG8 MSGSETUP ' FDB0008E **** ERROR - NEW DATASET NAME NOT SPECIFX29880000 ED ON RENAME REQUEST. COMMAND NOT EXECUTED.' 29890000 ERRMSG9 MSGSETUP ' FDB0009E **** ERROR - UNKNOWN SUBCOMMAND FOR NAMEX29900000 . ENTIRE NAME SUBCOMMAND SET IGNORED.' 29910000 ERRMSG10 MSGSETUP ' FDB0010E **** ERROR - INVALID LOGICAL RECORD LENGX29920000 TH SPECIFIED. ENTIRE NAME SUBCOMMAND SET IGNORED.' 29930000 ERRMSG11 MSGSETUP ' FDB0011E **** ERROR - INVALID BLOCK SIZE SPECIFIEX29940000 D. ENTIRE NAME SUBCOMMAND SET IGNORED.' 29950000 ERRMSG12 MSGSETUP ' FDB0012E **** ERROR - VOLUME SPECIFIED NOT REFEREX29960000 NCED IN A DD CARD AND DYNAMIC ALLOCATION ATTEMPT FAILED.X29970000 COMMAND NOT EXECUTED.' 29980000 ERRMSG13 MSGSETUP ' FDB0013E **** ERROR - DATASET NAME SPECIFIED MULTX29990000 PLE TIMES. COMMAND NOT EXECUTED.' 30000000 ERRMSG14 MSGSETUP ' FDB0014E **** ERROR - INVALID DATA SET NAME SPECIX30010000 FIED. COMMAND NOT EXECUTED.' 30020000 ERRMSG15 MSGSETUP ' FDB0015E **** ERROR - VOLUME SERIAL SPECIFIED MULX30030000 TIPLE TIMES. COMMAND NOT EXECUTED.' 30040000 ERRMSG16 MSGSETUP ' FDB0016E **** ERROR - INVALID VOLUME SERIAL NUMBEX30050000 R SPECIFIED. COMMAND NOT EXECUTED.' 30060000 ERRMSG17 MSGSETUP ' FDB0017E **** ERROR - NEW DATASET NAME KEYWORD SPX30070000 ECIFIED MULTIPLE TIMES. COMMAND NOT EXECUTED.' 30080000 * 30090000 ERRMSG18 MSGSETUP ' FDB0018E **** ERROR - ' AVAILIABLE MESSAGE 30100000 * 30110000 ERRMSG19 MSGSETUP ' FDB0019E **** ERROR - INVALID NEW DATASET NAME SPX30120000 ECIFIED FOR RENAME COMMAND. COMMAND NOT EXECUTED.' 30130000 ERRMSG20 MSGSETUP ' FDB0020E **** ERROR - UNKNOWN KEYWORD DETECTED ONX30140000 COMMAND CARD. COMMAND NOT EXECUTED.' 30150000 ERRMSG21 MSGSETUP ' FDB0021E **** ERROR - INVALID RECORD FORMAT SPECIX30160000 FIED. ENTIRE NAME SUBCOMMAND SET IGNORED.' 30170000 ERRMSG22 MSGSETUP ' FDB0022E **** ERROR - INVALID DATA SET ORGANIZATIX30180000 ON SPECIFIED. ENTIRE NAME SUBCOMMAND SET IGNORED.' 30190000 ERRMSG23 MSGSETUP ' FDB0023E **** ERROR - INVALID KEY LENGTH SPECIFIEX30200000 D. ENTIRE NAME SUBCOMMAND SET IGNORED.' 30210000 ERRMSG24 MSGSETUP ' FDB0024E **** ERROR - INVALID RELATIVE KEY POSITIX30220000 ON SPECIFIED. ENTIRE NAME SUBCOMMAND SET IGNORED.' 30230000 ERRMSG25 MSGSETUP ' FDB0025E **** ERROR - UNEXPECTED END-OF-FILE OCCUX30240000 RRED DURING CONTINUATION CARD PROCESSING.' 30250000 ERRMSG26 MSGSETUP ' FDB0026E LAST COMMAND WAS NOT EXECUTED.' 30260000 ERRMSG27 MSGSETUP '0FDB0027E **** ERROR - INVALID EXECUTION PARAMETERX30270000 SPECIFIED. "TEST" IS THE ONLY VALID PARM. RUN ABORTEDX30280000 .' 30290000 MSG28 MSGSETUP ' FDB0028I **** NOTE: TEST RUN ONLY. DSCB WILL NOX30300000 T BE REWRITTEN TO VTOC ON VOLUME.' 30310000 ERRMSG29 MSGSETUP ' FDB0029E **** ERROR - VOLUME SERIAL REQUESTED NOTX30320000 REFERENCED IN A JCL STATEMENT. COMMAND NOT EXECUTED.' 30330000 ERRMSG30 MSGSETUP ' FDB0030I **** NOTE: NO MODIFICATIONS WERE MADE TX30340000 O THE DSCB FOR THIS DATASET. DSCB NOT REWRITTEN.' 30350000 ERRMSG31 MSGSETUP ' FDB0031D **** DISASTER - OPEN FAILED FOR VTOC OF X30360000 VOLUME SPECIFIED. POSSIBLE DISASTEROUS ERROR. RUN ABORX30370000 ED.' 30380000 MSG32 MSGSETUP ' FDB0032I **** COMMAND EXECUTED SUCCESSFULLY.' 30390000 MSG33 MSGSETUP ' FDB0033I **** REPLY END TO TERMINATE FIXDSCB.' 30400000 ERRMSG34 MSGSETUP ' FDB0034E **** ERROR - INVALID OPTCODE SPECIFIED. X30410000 ENTIRE NAME SUBCOMMAND SET IGNORED.' 30420000 MSG35 MSGSETUP ' FDB0035W **** VTOC IS RESERVED, EXIT AS SOON AS PX30430000 OSSIBLE. ****' 30440000 ERRMSG36 MSGSETUP ' FDB0036D **** DATASET SPECIFIED HAS BEEN LEFT RENX30450000 AMED TO "FIXDSCB.SCRATCH.DATASET". RUN ABORTED.' 30460000 ERRMSG37 MSGSETUP ' FDB0037E **** ERROR - OPER STATUS REQUIRED TO USEX30470000 FIXDSCB UNDER TSO. RUN TERMINATED.' 30480000 ERRMSG38 MSGSETUP ' FDB0038E **** ERROR - AT LEAST ONE KEYWORD MUST OX30490000 CCUR ON THE COMMAND CARD. COMMAND IGNORED.' 30500000 ERRMSG39 MSGSETUP ' FDB0039E **** ERROR - VOLUME SPECIFIED NOT REFEREX30510000 NCED IN A DD CARD AND TSO DAIR FAILED. COMMAND NOT EXECX30520000 UTED.' 30530000 ERRMSG40 MSGSETUP ' FDB0040E **** ERROR - VOLUME IS INDEXED, SCRATCH X30540000 OR RENAME NOT ALLOWED.' 30550000 ERRMSG41 MSGSETUP ' FDB0041E **** ERROR - CVAF VIER FAILURE. DATASET X30560000 NOT FOUND ON VOLUME SPECIFIED. CHECK FOR SPELLING ERRORSX30570000 .' 30580000 ERRMSG42 MSGSETUP ' FDB0042D **** DISASTER - CVAF VIER FAILED. RUN AX30590000 BORTED.' 30600000 ERRMSG43 MSGSETUP ' FDB0043D **** DISASTER - CVAF VIER WRITE FAILED. X30610000 RUN ABORTED.' 30620000 ERRMSG44 MSGSETUP ' FDB0044D RESERVE OF VOLUME FAILED, RUN ABORTED.' 30630000 ERRMSG45 MSGSETUP ' ' DUMMY MESSAGE 30640000 ERRMSG46 MSGSETUP ' ' DUMMY MESSAGE 30650000 ERRMSG47 MSGSETUP ' ' DUMMY MESSAGE 30660000 ERRMSG48 MSGSETUP ' ' DUMMY MESSAGE 30670000 ERRMSG49 MSGSETUP ' ' DUMMY MESSAGE 30680000 ERRMSG50 MSGSETUP ' ' DUMMY MESSAGE 30690000 PRINT GEN 30700000 SPACE 3 30710000 DROP R10,R11,R12 30720000 DROP R9 30730000 SPACE 5 30740000 *--------------------------------------------------------------------* 30750000 * ESTAE ROUTINE TO CATCH ABENDS * 30760000 *--------------------------------------------------------------------* 30770000 ESTAEX DS 0H 30780000 USING ESTAEX,R15 30790000 C R0,=F'12' IS SDWA AVAILABLE? 30800000 BE ESTAEXI3 NO, GO PROCESS 30810000 STM R14,R12,12(R13) SAVE REGISTERS 30820000 LR R12,R15 30830000 DROP R15 30840000 USING ESTAEX,R12 30850000 USING SDWA,R1 30860000 *--------------------------------------------------------------------* 30870000 * SDWA WITHOUT RETRY * 30880000 *--------------------------------------------------------------------* 30890000 ESTAEXI2 DS 0H 30900000 $AUTHOFF 30910000 L R1,X'18'(,R13) 30920000 SETRP REGS=(14,12), PERCOLATE ABEND ..30930000 DUMP=YES 30940000 DROP , 30950000 SPACE 3 30960000 *--------------------------------------------------------------------* 30970000 * NO SDWA * 30980000 *--------------------------------------------------------------------* 30990000 ESTAEXI3 DS 0H ESTAE EXIT ROUTINE 31000000 USING ESTAEX,R15 31010000 $AUTHOFF 31020000 L R1,X'18'(,R13) 31030000 SLR R15,R15 SET ABEND CODE 31040000 BR R14 RETURN 31050000 DROP , 31060000 LTORG , 31070000 TITLE 'FIXDMSGR - SYSPRINT/WTO/TPUT MESSAGE INTERFACE' 31080000 FIXDMSGR CSECT 31090000 *--------------------------------------------------------------------* 31100000 * 31110000 * FUNCTION: TO BUILD THE PROPER CONTROL BLOCKS AND TO USE 31120000 * THE PUT OR WTO I/O ROUTINES TO PRINT A MESSAGE. 31130000 * 31140000 * INPUT : REG. 1 CONTAINS THE ADDRESS OF THE MESSAGE 31150000 * PARAMETER LIST 31160000 * OFFSET LENGTH DESCRIPTION 31170000 * +0 4 MESSAGE TABLE ADDRESS 31180000 * +4 4 DCB ADDRESS 31190000 * +8 4 ADDRESS OF ANY SPECIAL MESSAGE 31200000 * +12 2 MESSAGE NUMBER 31210000 * +14 1 I/O FLAG (SYSPRINT, WTO, OR TSO) 31220000 * +15 1 CONSOLE ID (FOR WTO) 31230000 * 31240000 * MESSAGE TABLE FORMAT: 31250000 * A LIST OF FULL-WORDS CONTAINING THE ADDRESS OF 31260000 * THE MESSAGE BUFFERS. 31270000 * 31280000 * SPECIAL MESSAGES: 31290000 * SPECIAL MESSAGES ARE MESSAGES WHICH HAVE BEEN 31300000 * MODIFIED AND DO NOT EXIST IN THE NORMAL MESSAGE 31310000 * TABLE. IF THE SPECIAL MESSAGE POINTER IS NON- 31320000 * ZERO THEN THAT MESSAGE IS USED INSTEAD OF LOOKING 31330000 * UP A MESSAGE IN THE TABLE. SPECIAL MESSAGES MUST 31340000 * BE CONSTRUCTED IN THE FORM OF A VALID WTO BUFFER. 31350000 * EXAMPLE: 31360000 * SPMG DC AL2(LENGTH OF TEXT + 4) 31370000 * DC X'4000' WTO FLAGS 31380000 * DC C'TEXT' 31390000 * 31400000 *--------------------------------------------------------------------* 31410000 EJECT 31420000 *--------------------------------------------------------------------* 31430000 * INITIALIZATION 31440000 *--------------------------------------------------------------------* 31450000 SAVE (14,12) SAVE CALLER'S REGS. 31460000 LR R12,R15 31470000 USING FIXDMSGR,R12 ADDRESS CSECT 31480000 LR R2,R1 PICK UP MESSAGE PARAM. LIST ADDR. 31490000 USING MPLDSECT,R2 ADDRESS PARM LIST 31500000 GETMAIN R,LV=LWASIZE,SP=LWASP OBTAIN LOCAL WORK AREA 31510000 XC 0(LWASIZE,R1),0(R1) 31520000 ST R13,4(,R1) CHAIN 31530000 ST R1,8(,R13) SAVE 31540000 LR R13,R1 AREAS 31550000 USING LWAMAP,R13 ADDRESS WORK AREA 31560000 *--------------------------------------------------------------------* 31570000 * INITIALIZE LOCAL WORK AREA 31580000 *--------------------------------------------------------------------* 31590000 SPACE 1 31600000 LA R11,0 PRESET R12 TO ZERO 31610000 L R3,MPLSPADD PICK UP ADDRESS OF POSSIBLE SP MSG 31620000 LTR R3,R3 ANY SPECIFIED? 31630000 BNZ DOSPMG BRANCH IF SO 31640000 L R5,MPLMTTD PICK UP MESSAGE TABLE ADDR. 31650000 LH R4,MPLNUMD PICK UP MESSAGE NUMBER 31660000 LTR R4,R4 MESSAGE NUM SPECIFIED? 31670000 BZ ERRORXIT BRANCH IF NOT 31680000 BCTR R4,0 31690000 SLL R4,2 COMPUTE TABLE INDEX 31700000 L R3,0(R4,R5) PICK UP MESSAGE BUFFER ADDR. 31710000 DOSPMG DS 0H 31720000 LH R1,0(R3) PICK UP LINE LENGTH 31730000 LTR R1,R1 LENGTH 0? 31740000 BE NOCLOSE THEN GET OUT. NO MESSAGE TO PRINT 31750000 XC MPLSPADD,MPLSPADD ZERO OUT SPECIAL MESSAGE POINTER 31760000 TM MPLIOFD,CONSOLE ARE WE A STARTED TASK 31770000 BO DOWTOIO USE WTO TYPE I/O IF SO 31780000 TM MPLIOFD,TSOSESS ARE WE A TSO SESSION 31790000 BO DOTSOIO USE TPUT TYPE I/O IF SO 31800000 L R6,MPLDCBD PICK UP DCB ADDRESS 31810000 USING IHADCB,R6 ADDRESS DCB 31820000 TM DCBOFLGS,DCBOFOPN IS DCB OPEN 31830000 BO DCBOPEN BRANCH IF SO 31840000 OI LWAFLAG,OPENHERE FLAG AS OPENED HERE 31850000 OPEN ((6),OUTPUT) OPEN IT UP 31860000 TM DCBOFLGS,DCBOFOPN DID IT WORK 31870000 BZ ERROROPN BRANCH IF NOT 31880000 DCBOPEN DS 0H 31890000 DROP R6 31900000 SPACE 1 31910000 PUTOUT DS 0H 31920000 MVI LWALINE,BLANK BLANK OUT LINE BUFFER 31930000 MVC LWALINE+1(132),LWALINE 31940000 LH R1,0(R3) PICK UP LINE LENGTH 31950000 S R1,FIVE DROP FOR EXECUTED INST AND FOR 31960000 * WTO HEADDER OMISSION 31970000 EX R1,LINEMOVE MOVE TO BUFFER 31980000 PUT (6),LWALINE 31990000 SPACE 1 32000000 EXITROUT DS 0H 32010000 TM LWAFLAG,OPENHERE 32020000 BNO NOCLOSE 32030000 CLOSE ((6)) WE OPENED IT SO WE CLOSE IT 32040000 B NOCLOSE 32050000 EJECT , 32060000 *--------------------------------------------------------------------* 32070000 * DO WTO TO STARTING CONSOLE 32080000 *--------------------------------------------------------------------* 32090000 SPACE 3 32100000 DOWTOIO DS 0H 32110000 IC R0,MPLCOND PICK UP CONSOLE ID 32120000 LR R1,R3 POINTER TO WTO MESSAGE AREA IN LIST 32130000 WTO MF=(E,(1)) EXECUTE 32140000 B NOCLOSE 32150000 SPACE 3 32160000 *--------------------------------------------------------------------* 32170000 * DO TPUT TO TSO SESSION 32180000 *--------------------------------------------------------------------* 32190000 SPACE 3 32200000 DOTSOIO DS 0H 32210000 LH R0,0(R3) PICK UP MESSAGE LENGTH 32220000 S R0,MPLFOUR DROP BY FOUR (COMPENSATE FOR HEADER) 32230000 LA R1,4(R3) PICK UP MESSAGE TEXT ADDRESS 32240000 O R1,TPUTFLAG SET IN FLAGS 32250000 LA R15,0 SET UID POINTER TO ZERO 32260000 TPUT (1),(0),R EXECUTE TPUT 32270000 B NOCLOSE 32280000 SPACE 3 32290000 *--------------------------------------------------------------------* 32300000 * DI-INITIALIZE AND EXIT 32310000 *--------------------------------------------------------------------* 32320000 SPACE 3 32330000 NOCLOSE DS 0H 32340000 XC LWAFLAG,LWAFLAG ZERO OUT THE FLAGS 32350000 XC MPLNUMD,MPLNUMD ZERO MSG NUMBER 32360000 LR R1,R13 LOAD PARAMETER REG. 1 32370000 L R13,4(,R13) RESTORE CALLER'S SAVE REG. 32380000 FREEMAIN R,LV=LWASIZE,SP=LWASP,A=(1) FREE LOCAL WORK AREA 32390000 LR R15,R11 LOAD RETURN CODE 32400000 RETURN (14,12),RC=(15) RETURN TO CALLER 32410000 ERRORXIT DS 0H 32420000 LA R11,20 INDICATE INVALID PARAMETER LIST 32430000 B NOCLOSE 32440000 ERROROPN DS 0H 32450000 LA R11,24 INDICATE OPEN FAILURE 32460000 B NOCLOSE 32470000 SPACE 3 32480000 *--------------------------------------------------------------------* 32490000 * LOCAL CONSTANTS AND EXECUTED INSTRUCTIONS * 32500000 *--------------------------------------------------------------------* 32510000 SPACE 1 32520000 TPUTFLAG DC F'0' TPUT FLAGS 32530000 MPLFOUR DC F'4' 32540000 FIVE DC F'5' 32550000 LINEMOVE MVC LWALINE(0),4(R3) 32560000 LTORG , 32570000 SPACE 3 32580000 TITLE 'FIXDSCB - DSECTS' 32590000 *--------------------------------------------------------------------* 32600000 * LOCAL WORK AREA MAPPING 32610000 *--------------------------------------------------------------------* 32620000 SPACE 1 32630000 LWAMAP DSECT 32640000 DS 18F REG. SAVE AREA 32650000 LWALINE DS CL133 32660000 LWAFLAG DS X 32670000 OPENHERE EQU X'80' DCB SUPPLIED OPENED LOCALLY 32680000 LWASIZE EQU *-LWAMAP 32690000 LWASP EQU 1 32700000 SPACE 3 32710000 *--------------------------------------------------------------------* 32720000 * TSO COMMAND BUFFER MAPPING DSECT (CBUFF) 32730000 *--------------------------------------------------------------------* 32740000 SPACE 1 32750000 CMDBUFR DSECT 32760000 CMDBLEN DS H 32770000 CMDBOFF DS H 32780000 CMDBTEXT DS C 32790000 SPACE 3 32800000 *--------------------------------------------------------------------* 32810000 * MESSAGE PARAMETER LIST MAPPING DSECT (MPL) 32820000 *--------------------------------------------------------------------* 32830000 SPACE 1 32840000 MPLDSECT DSECT 32850000 MPLMTTD DS A 32860000 MPLDCBD DS A 32870000 MPLSPADD DS A 32880000 MPLNUMD DS H 32890000 MPLIOFD DS C 32900000 MPLCOND DS C 32910000 SPACE 3 32920000 *--------------------------------------------------------------------* 32930000 * FORMAT 1 DSCB MAPPING DSECT 32940000 *--------------------------------------------------------------------* 32950000 SPACE 3 32960000 DSCB DSECT 32970000 IECSDSL1 1 32980000 DS 0F 32990000 DSCBLTH EQU *-DSCB FULL DSCB LENGTH 33000000 DSCBLTH2 EQU *-DS1FMTID MINUS DSNAME LENGTH 33010000 SPACE 3 33020000 *--------------------------------------------------------------------* 33030000 * CVAF MAPPINGS 33040000 *--------------------------------------------------------------------* 33050000 ICVVIER ICVVIER 33060000 SPACE 3 33070000 CVPL ICVAFPL , 33080000 SPACE 3 33090000 BUFLIST DSECT , 33100000 ICVAFBFL DSECT=NO GEN 2 AREAS TOGETHER 33110000 BUFLEN EQU *-BUFLIST 33120000 *--------------------------------------------------------------------* 33130000 * EXTERNAL DATA AREA MAPPING DSECTS 33140000 *--------------------------------------------------------------------* 33150000 SPACE 3 33160000 PRINT NOGEN 33170000 JFCBDSCT DSECT 33180000 IEFJFCBN 33190000 JFCBMOD EQU X'80' 33200000 SPACE 1 33210000 DCBD DSORG=XE,DEVD=DA 33220000 SPACE 1 33230000 PRINT GEN 33240000 TIOT DSECT , 33250000 IEFTIOT1 33260000 PRINT GEN 33270000 SPACE 1 33280000 IEFUCBOB 33290000 SPACE 1 33300000 IHAPSA 33310000 SPACE 1 33320000 IEECHAIN 33330000 SPACE 1 33340000 IKJDAPL 33350000 SPACE 1 33360000 IKJPSCB 33370000 SPACE 1 33380000 IKJCPPL 33390000 SPACE 1 33400000 IHAASCB 33410000 SPACE 1 33420000 IEZDEB 33430000 SPACE 1 33440000 IHASDWA , 33450000 SPACE 1 33460000 CVT DSECT=YES,PREFIX=YES 33470000 END 33480000