DLB TITLE 'DMSDLB (CMS) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME: 00003000 * 00004000 * DMSDLB (DLBL) 00005000 * 00006000 * FUNCTION: 00007000 * 00008000 * TO ALLOW THE USER TO SPECIFY, IN A MANNER SIMILAR TO 00009000 * THE DOS DLBL CARD, I/O DEVICES, EXTENTS, AND CERTAIN 00010000 * FILE ATTRIBUTES WHICH WILL BE USED BY A PROGRAM AT 00011000 * EXECUTION TIME. CAN ALSO BE USED TO MODIFY OR DELETE 00012000 * PREVIOUSLY DEFINED DISK FILE DESCRIPTIONS. 00013000 * 00014000 * ATTRIBUTES: TRANSIENT, MUST BE GENMOD'ED WITH 'SYSTEM' OPTION 00015000 * I.E., LOAD DMSDLB (ORIGIN TRANS 00016000 * GENMOD DLBL (SYSTEM 00017000 * 00018000 * ENTRY POINTS: 00019000 * DMSDLB 00020000 * 00021000 * ENTRY CONDITIONS: 00022000 * R1 MUST POINT TO A DLBL PARAMETER LIST. 00023000 * THE GENERAL FORMAT IS AS FOLLOWS: 00024000 * DS 0D 00025000 * PLIST DC CL8'DLBL' 00026000 * DC CL8'DDNAME' OR '*' 00027000 * DC CL8'CLEAR', 'DUMMY', OR MODE 00028000 * DC CL8'CMS', CL8'FILENAME', CL8'FILETYPE' 00029000 * OR 00030000 * DC CL8'DSN' , CL8'QUAL1' , CL8'QUALN' ( OR CL8'?' ) 00031000 * DC CL8'(' START OF OPTIONS 00032000 * DC CL8'OPTIONS' 00033000 * DC 8X'FF' FENCE 00034000 * 00035000 * 00036000 * EXIT CONDITIONS: 00037000 * NORMAL RETURN 00038000 * R15 = 0 00039000 * R0 = ADDRESS OF DOSCB 00040000 * POSITIVE IF ALREADY EXISTS 00041000 * NEGATIVE IF OBTAINED OR MODIFIED BY THIS CALL 00042000 * 00043000 * ERROR RETURN: 00044000 * R15 NON-ZERO : 00045000 * = 24 USER INPUT ERRORS 00046000 * 36 TARGET DISK NOT ACCESSED @VA12416 00046500 * 104 VIRTUAL STORAGE CAPACITY EXCEEDED 00047000 * 00048000 * CALLS TO OTHER ROUTINES: 00049000 * DMSFREB, DMSERR, DMSCRD 00050000 * 00051000 * EXTERNAL REFERENCE: 00052000 * SVCSAVE 00053000 * DOSCB 00054000 * NUCON 00055000 * BGCOM 00056000 * 00057000 * CALLED BY: 00058000 * 00059000 * LANGUAGE PROCESSORS, ROUTINES USING DOS SIMULATION, 00060000 * CMS DOS OPEN ROUTINES, AMSERV INTERFACE, ETC. 00061000 * 00062000 * TABLES AND WORK AREAS: 00063000 * 00064000 * OPTAB - VALID OPTION TABLE 00065000 * UNITAB - UNIT ADDRESS TABLE FOR 'SYSXXX' OPTION 00066000 * OLDENTRY - SAVE AREA FOR EXISTING DOSCB BEING CHANGED 00067000 * DOSCB - DOS SIMULATION CONTROL BLOCK, INCLUDING: 00068000 * DOSOSDSN - BLOCK TO HOLD DOS DATA SET NAME 00069000 * DOSVOLTB - BLOCK CONTAINING MULTI-VOLUME DESCRIPTIONS 00070000 * DOSEXTTB - BLOCK CONTAINING EXTENT INFORMATION 00071000 * 00072000 * REGISTER USAGE: 00073000 * 00074000 * R0 - ADDRESS RETURN 00075000 * R1 - PLIST ON ENTRY 00076000 * R2 - WORKING REGISTER 00077000 * R3 - WORKING REGISTER 00078000 * R4 - DOSSECT 00079000 * R5 - WORKING REGISTER 00080000 * R6 - FENCE 00081000 * R7 - WORKING REGISTER 00082000 * R8 - WORKING REGISTER 00083000 * R9 - WORKING REGISTER 00084000 * R10 - INTERNAL LINKAGE 00085000 * R11 - BASE2 00086000 * R12 - BASE 00087000 * R13 - SAVE AREA 00088000 * R14 - EXTERNAL LINKAGE 00089000 * R15 - EXTERNAL LINKAGE 00090000 * 00091000 * NOTES: 00092000 * NONE. 00093000 * 00094000 * 00095000 * OPERATION: 00096000 * 00097000 * NO OPERAND. DLBL WITH NO OPERAND 00098000 * REQUESTS A LIST OF CURRENT FILE DEFINITIONS. DOSNUM 00099000 * CONTAINS THE NUMBER OF ENTRIES IN THE CHAIN OF DOSCB'S. 00100000 * THE DOSFIRST FIELD ANCHORS THE DOSCB CHAIN. 00101000 * IF NO OPERANDS ARE ENTERED BUT THE 'EXTENT' OR 'MULT' @VA05247 00102000 * OPTIONS ARE, THE CONTENTS OF THE EXTENT OR MULTIPLE- @VA05247 00103000 * VOLUMES BLOCK FOR EACH DOSCB IS LISTED. THESE OPTIONS @VA05247 00104000 * WHEN USED ALONE FOR LIST PURPOSES ARE STILL MUTUALLY @VA05247 00105000 * EXCLUSIVE. ANY LEGIT OPTIONS INCLUDED ARE IGNORED. @VA05247 00106000 * 00107000 * CLEAR. IF '*', ALL DOSCB'S ON THE CHAIN ARE RELEASED EXCEPT 00108000 * THOSE FLAGGED PERMANENT. THESE ARE RELEASED ONLY WHEN 00109000 * SPECIFICALLY CLEARED, USING DDNAME RATHER THAN '*'. 00110000 * ANY DOSCB MAY BE CLEARED INDIVIDUALLY USING ITS DDNAME. 00111000 EJECT 00112000 * IF THE DDNAME 'IJSYSUC' IS ENTERED WITH CLEAR, 00113000 * DMSDLB CLEARS THE ACTIVE JOB CATALOG DOSCB AND SEARCHES 00114000 * THE DOSCB CHAIN TURNING OFF THE DOSJCAT AND DOSUCAT BITS 00115000 * IN ANY DOSCB THAT WAS USING THE JOB CATALOG. IT ALSO 00116000 * RESETS THE VSJOBCAT BIT AND VSAMJCAT FIELD IN NUCON. 00117000 * AN APPROPRIATE INFO MSG IS TYPED AT TERMINAL. 00118000 * 00119000 * DDNAME. IS USED TO LOOP THROUGH THE DOSCB CHAIN IN 00120000 * FREE STORAGE LOOKING FOR THE SPECIFIED DOSCB. IF NO 00121000 * MATCH IS FOUND, THE NEW DOSCB FLAG IS SET, FREE STORAGE 00122000 * IS OBTAINED, AND THE ADDRESS OF THIS DOSCB IS PLACED IN 00123000 * THE FIRST WORD OF THE LAST DOSCB ON THE CHAIN. THE 00124000 * ADDRESS OF THE NEW DOSCB IS PUT IN REGISTER 0 AS A 00125000 * NEGATIVE QUANTITY AND SAVED TO BE PASSED BACK TO THE 00126000 * USER WHEN PARAMETER PROCESSING IS COMPLETE. IF THE 00127000 * PERM FLAG IS SET, THE HIGH ORDER BYTE OF THE NEW DOSCB 00128000 * IS FLAGGED PERMANENT. 00129000 * 00130000 * IF A MATCHING DOSCB IS FOUND, AND THE XNOCHNGE FLAG IS 00131000 * SET, DLBL RETURNS TO THE USER WITH THE ADDRESS OF THE 00132000 * DOSCB IN REGISTER 0. 00133000 * 00134000 * IF A MATCHING DOSCB IS FOUND AND THE XNOCHNGE FLAG IS NOT 00135000 * SET, THE OLD DOSCB IS SAVED IN CASE OF AN ERROR, THE 00136000 * OLD ENTRY FLAG IS SET, AND THE ADDRESS OF THE DOSCB IS 00137000 * NEGATIVELY STORED IN REGISTER 0. IF THE PERM FLAG IS 00138000 * SET, THE DOSCB IS FLAGGED PERMANENT. 00139000 * 00140000 * IF THE DDNAME IS 'IJSYSUC' (VSAM JOB CATALOG), DMSDLB 00141000 * ASSOCIATES ALL THE DOSCBS WITH THE IJSYSUC DOSCB WHICH 00142000 * IS USED AS A VSAM JOB CATALOG. DMSDLB FIRST BUILDS THE 00143000 * IJSYSUC DOSCB AND SETS ITS DOSDDCAT AND DOSJCAT BITS 00144000 * ON TO MARK IT AS THE JCAT DOSCB. THE DOSCB 00145000 * CHAIN IS SEARCHED AGAIN AND ALL DOSCBS NOT USING ANY 00146000 * OTHER USER CATALOG ARE MARKED AS USING THE JCAT BY 00147000 * SETTING THEIR DOSJCAT AND DOSUCAT BITS ON. I.E., THE JOB 00148000 * CATALOG INCLUDES ALL DOSCBS (CURRENT AND SUBSEQUENT) 00149000 * WHICH DO NOT USE ANY OTHER USER CATALOG. 00150000 * THE VSJOBCAT FLAG IS SET AND THE VSAMJCAT FIELD CON- 00151000 * TAINING THE DDNAME OF THE JCAT ARE BOTH UPDATED IN 00152000 * NUCON. 00153000 * IF IJSYSUC DOSCB (JOB CATALOG) IS ALREADY ACTIVE AND 00154000 * THE NOCHANGE OPTION IS NOT USED, AN ERROR MESSAGED IS 00155000 * TYPED STATING THE JCAT IS ALREADY ACTIVE. 00156000 * 00157000 * PROCESSING IS THEN DEPENDENT ON THE PARAMETERS SPECIFIED. 00158000 EJECT 00159000 * DUMMY. A DOSCB IS CREATED WITH A DEVICE TYPE OF X'00'. 00160000 * OPTIONS ARE PROCESSED AS IF A MODE HAD BEEN ENTERED. 00161000 * 00162000 * CMS. CMS DISK FILE; FILENAME AND FILETYPE MUST BE 00163000 * SPECIFIED. IF 'CMS' IS NOT ENTERED, A DEFAULT 00164000 * FILEID OF 'FILE DDNAME' WILL BE USED. 00165000 * 00166000 * DSN. IF THE PARAMETER DSN ? IS SPECIFIED, DLBL 00167000 * WILL TYPE OUT MSG DMSDLB220R TO REQUEST THE USER 00168000 * TO TYPE IN A DOS DATA SET NAME IN THE FORMAT OF 00169000 * Q1.Q2.QN WHERE THE Q'S ARE THE QUALIFIERS OF A 00170000 * DOS OR OS DATA SET NAME. 00171000 * IF THE PARAMETER DSN Q1 Q2 QN IS SPECIFIED, DLBL 00172000 * WILL ASSUME THAT Q1 Q2 AND QN ARE THE QUALIFIERS 00173000 * OF A DOS DATA SET NAME, AND THE QUALIFIERS ARE 00174000 * STORED IN THE FORMAT Q1.Q2.QN IN A FREE STORAGE 00175000 * BLOCK (DOSOSDSN) THAT IS CHAINED TO THE DOSCB. 00176000 * THE DEFAULT CMS FILENAME 'FILE DDNAME' IS ASSIGNED. 00177000 * 00178000 * CHANGE NOCHANGE. DETERMINES IF AN EXISTING DOSCB 00179000 * IS TO BE CHANGED OR SHOULD REMAIN 00180000 * UNMODIFIED. CHANGE IS THE DEFAULT. 00181000 * 00182000 * PERM. THE DOSCB CREATED FOR THIS DDNAME IS 00183000 * RETAINED UNTIL SPECIFICALLY CLEARED; 00184000 * IT IS NOT REMOVED AFTER A GENERAL '*CLEAR' REQUEST. 00185000 * THE DOSPERM BIT (X'04') IS SET IN THE DOSINIT BYTE. 00186000 * 00187000 * SYSXXX. USED BY DOS SIMULATION ROUTINES TO ASSOCIATE 00188000 * THE DDNAME DESCRIBED IN DLBL WITH A DOS LOGICAL UNIT 00189000 * NAME DEFINED BY A PRIOR 'ASSGN' COMMAND. 00190000 * DMSDLB SIMPLY VALIDATES THE PRIOR ASSIGNMENT AND STORES 00191000 * THE 2-BYTE LOGICAL UNIT CODE IN THE DOSCB (DOSYSXXX). 00192000 * 00193000 * BUFSP. USED TO ALLOCATE BUFFER SPACE FOR VSAM I/O ACTIVITY. 00194000 * DMSDLB VALIDATES THE OPERAND VALUE AND STORES IT IN THE 00195000 * DOSCB (DOSBUFSP). MAXIMUM VALUE ACCEPTED IS 999999. 00196000 * 00197000 * VSAM. DEFINES VSAM DATASET BY STORING AN 'A' IN DOSTYPE 00198000 * FIELD OF DOSCB. IMPLIED BY OPTIONS CAT, BUFSP, EXTENT 00199000 * AND MULT AND BY DDNAMES IJSYSCT AND IJSYSUC. 00200000 * 00201000 * CAT. ASSOCIATES THE DOSCB WITH ANOTHER DOSCB USED AS VSAM 00202000 * USER CATALOG. DMSDLB INSURES THAT THE UCAT DOSCB HAS 00203000 * BEEN DEFINED BY SEARCHING THE DOSCB CHAIN. WHEN THE 00204000 * UCAT DOSCB IS FOUND, DMSDLB SETS THE DOSDDCAT FLAG 00205000 * IN THE UCAT DOSCB TO MARK IT AS A CATALOG DATASET. 00206000 * THEN DMSDLB SETS THE DOSUCAT BIT AND STORES THE 00207000 * DDNAME OF THE UCAT DOSCB IN THE DOSUCNAM FIELD IN 00208000 * THE DOSCB BEING DEFINED. 00209000 * 00210000 * 00211000 EJECT 00212000 * MULT. USED FOR VSAM MULTIVOLUME DATASET DESCRIPTION. 00213000 * DMSDLB FREES A BLOCK OF CMS STORAGE TO BUILD A LIST 00214000 * OF VOLUMES (DISKS) USED BY THE DATASET DESCRIBED BY 00215000 * NEW DOSCB. THE FORMAT OF EACH DOSVOLTB BLOCK ENTRY IS: 00216000 * 00217000 * ------------------------------------------------------ 00218000 * | | | 00219000 * | DISK MODE | DOS LOGICAL UNIT CODE | 00220000 * | | | 00221000 * | E.G. 'A' | E.G. 'SYS001' | 00222000 * | | | 00223000 * |-------------------|--------------------------------| 00224000 * | | SYS/PROG | UNIT | 00225000 * | | | | 00226000 * | X'C1' | X'01' | X'01' | 00227000 * | | | | 00228000 * ------------------------------------------------------ 00229000 * 1 2 3 00230000 * 00231000 * THE DOS LOGICAL UNIT CODE BYTES ARE '0' IF OS USER. 00232000 * 00233000 * MULTIPLE VOLUME ENTRIES MAY BE ENTERED ON ONE LINE AND 00234000 * AND MULTIPLE LINES MAY BE ENTERED. A NULL LINE INDICATES 00235000 * THERE ARE NO MORE ENTRIES. A MAXIMUM OF 9 VOLUMES 00236000 * (POSSIBLE CMS DISKS ACCESSED NOT INCLUDING SYSTEM DISK) 00237000 * MAY BE DESCRIBED. IF THE MAXIMUM IS REACHED, A MSG IS 00238000 * TYPED AND THE MULT BLOK IS STORED AS SUCH. BOTH THE 00239000 * CMS MODE AND THE DOS LOGICAL UNIT ARE VALIDATED BEFORE 00240000 * THEY ARE STORED IN THE MULTBLOK. 00241000 * 00242000 * EXTENT. USED TO DESCRIBE EACH DISK EXTENT FOR THE DATASET. 00243000 * DMSDLB PROCESSES THIS OPTION IN SAME MANNER AS DESCRIBED 00244000 * FOR 'MULT' OPTION EXCEPT EXTENT ACCEPTS TWO ADDITIONAL 00245000 * OPERANDS, RELATIVE STARTING TRACK NO. AND NUMBER OF 00246000 * TRACKS. THE FORMAT OF EACH DOSEXTTB BLOK ENTRY IS: 00247000 * 00248000 * ------------------------------------------------------------ 00249000 * | | | | 00250000 * | SAME AS | RELATIVE STARTING | NO. TRACKS | 00251000 * | MULTIVOLUME| TRACK NO. OF EXTENT | IN EXTENT | 00252000 * | BLOCK ENTRY| | | 00253000 * | | E.G. '257' | E.G. '200' | 00254000 * | | | | 00255000 * | |----------------------|----------------------| 00256000 * | | | | 00257000 * | | X'00000101' | X'000000C8' | 00258000 * | | | | 00259000 * ------------------------------------------------------------ 00260000 * 3 7 11 00261000 * 00262000 * MAXIMUM NUMBER FOR EXTENT VALUES IS 2**31-1, OR 00263000 * 2,147,483,647. 00264000 *. 00265000 EJECT 00266000 DMSDLB CSECT @V305006 00267000 * 00268000 * SET UP ADDRESSIBILITY AND RESET FIELDS FOR SERIAL REUSE 00269000 * 00270000 LR R12,R15 SET UP BASE REGISTER @V305006 00271000 USING DMSDLB,R12 ... @V305006 00272000 LA R11,4095 USE R11 AS 2ND BASE (SICK JOKE)@V305006 00273000 LA R11,1(R12,R11) @V305006 00274000 USING DMSDLB+4096,R11 @V305006 00275000 USING NUCON,R0 ... @V305006 00276000 ST R14,SAVE14 SAVE RETURN REGISTER @V305006 00277000 L R13,CURRSAVE POINT TO SYS SAVE AREA @V305006 00278000 USING SSAVE,R13 @V305006 00279000 XC EGPR0(4),EGPR0 ZERO R0 FOR NOCHANGE @V305006 00280000 LR R5,R1 SAVE INPUT PARAMETER POINTER@V305006 00281000 XC PARMFLAG(CLEAREND-CLEARBEG),PARMFLAG RESET FLDS@V305006 00282000 LA R7,OPTAB+9 GET OPTION TABLE BEGIN @V305006 00283000 LA R8,14 AND LENGTH OF EACH ENTRY @V305006 00284000 LA R9,TABEND-5 GET END OF TABLE @V305006 00285000 RESET NI 0(R7),255-FOUND RESET OPTION 'FOUND' FLAGS @V305006 00286000 BXLE R7,R8,RESET IN ALL ENTRIES IN TABLE @V305006 00287000 CLM R5,8,=X'0C' HI BYTE OF R1 < X'0C' ? @V305006 00288000 BL CHEKLST YES - INTERNAL CALL @V305006 00289000 CLM R5,8,=X'0E' TEST FURTHER (0C/0D/0E) @V305006 00290000 BH CHEKLST IF > X'0E' IT'S INTERNL CALL@V305006 00291000 OI MISCFLAG,PRINT AS A CMD, ALLOW ERROR MSGS @V305006 00292000 * 00293000 * THE PLIST PTR IS UPDATED TO POINT TO OPERAND ONE AND 00294000 * THE PLIST END INDICATOR IS PUT IN GR 6. 00295000 * 00296000 USING DOSSECT,R4 TABLE ADDRESSABILITY @V305006 00297000 CHEKLST LA R5,8(,R5) SKIP TO FIRST PARAMETER @V305006 00298000 SR R15,R15 ZERO RETURN CODE REGISTER @V305006 00299000 L R6,PLISTEND SET REG 6 = X'FFFFFFFF' @V305006 00300000 C R6,0(,R5) ? NULL ENTRIES ? @V305006 00301000 BE LIST YES. GO LIST CURRENT DOSCB'S @V305006 00302000 EJECT 00303000 *********************************************************************** 00304000 * CHECK FOR ALL OPTIONS. 00305000 *********************************************************************** 00306000 SPACE 1 00307000 * FIRST CHECK FOR OPTION DELIMITERS '(', ')' 00308000 C R6,8(R5) ONLY ONE PARM ENTERED? @V305006 00309000 BE ERR50E ERROR IF SO @V305006 00310000 SR R13,R13 USE AS 'OPTIONS FOUND' FLAG @V305006 00311000 LR R2,R5 SAVE CURRENT PLIST POINTER @V305006 00312000 LR R9,R6 TEMP SWITCH @V305006 00313000 OPT1A C R6,0(,R2) ? END OF PARAMETER ? @V305006 00314000 BE OPTSCAN YES - GO PROC OPTIONS, IF ANY@V305006 00315000 CLI 0(R2),LFTPAREN ? START OF OPTIONS ? @V305066 00316000 BNE ADDTO NO, TRY SOME MORE @V305006 00317000 XR R9,R9 CLEAR SWITCH @V305006 00318000 LR R13,R2 SAVE START OF OPTION @V305006 00319000 ADDTO LA R2,8(,R2) INCREMENT @V305006 00320000 CLI 0(R2),RTPAREN CHECK END OF PLIST @V305066 00321000 BNE OPT1A NO - SCAN NEXT 8 BYTES @V305006 00322000 LTR R9,R9 TEST FOR '(' ENTERED @V305006 00323000 BNM REPFF @V305006 00324000 LR R5,R2 ERROR IF NO '(' @V305006 00325000 B ERR70E @V305006 00326000 REPFF EQU * @V305006 00327000 ST R6,0(,R2) REPL W/X'FF'S FOR LATER USE @V305006 00328000 SPACE 1 00329000 * NOW SCAN THE PLIST FOR THE ACTUAL OPTIONS 00330000 OPTSCAN EQU * MTCH PLIST ENTRYS W/OPT TABL@V305006 00331000 LTR R13,R13 ANY OPTIONS FOUND ABOVE? @V305006 00332000 BZ OP1 NO--GO PROC REMAINING PARMS @V305006 00333000 LA R8,8(,R13) POINT AT FIRST OPTION AND @V305006 00334000 ST R8,OPSTART SAVE START OF OPTIONS @V305006 00335000 LA R9,TABEND END OF OPTION TABLE 'OPTAB' @V305006 00336000 LA R8,14 LENGTH OF SAME @V305006 00337000 XR R3,R3 USE AS PLIST OFFSET CTR FOR PARMS@V305006 00338000 TABLOOP EQU * START HERE FOR EACH PLIST ENTRY @V305006 00339000 LA R7,OPTAB POINT START OF TABLE @V305006 00340000 LA R3,1(,R3) INCR PLIST OFFSET COUNTR @V305006 00341000 LA R13,8(,R13) POINT TO NEXT PLIST ENTRY @V305006 00342000 CLC 0(3,R13),SYSXXX IS IT 'SYSXXX' OPTION? @V305006 00343000 BNE CHKCAT NO, CONTINUE @VM03126 00344000 TM DOSFLAGS,DOSMODE BETTER CHEK FOR DOS USER @V305006 00345000 BZ ERR3EA IF NOT, IT'S INVALID @V305006 00346000 LA R7,SYSXXX PT TO OPTAB FOR GOOD RETURN @V305006 00347000 LA R10,MATCH RETN ADDR IF SUCCESSFUL SCAN@V305006 00348000 B SYSCODE NOW GOTO SPEC CASE OPT SCAN @V305006 00349000 CHKCAT CLC 0(8,R13),UCAT IS IT CAT OPTION ? @VM03130 00350000 BNE ENDCHEK NO - CONTINUE @VM03126 00351000 C R6,8(R13) END OF PLIST? @VM03126 00352000 BNE CHK7 CHK FOR 7 CHAR CAT DDNAME @VM03126 00353000 LA R13,8(R13) EXPECT PARM WITH CAT OPTION @VM03126 00354000 B NULL BR TO PRINT NO PARM MESSAGE @VM03126 00355000 CHK7 CLI 15(R13),BLANK ONLY 7 CHAR CAT DDNAME? @VM03126 00356000 BE ENDCHEK YES, OK, CONTINUE @VM03126 00357000 LA R5,8(R13) POINT TO INVALID CAT DDNAME @VM03126 00358000 B ERR086E BR TO PRINT MESSAGE @VM03126 00359000 ENDCHEK C R6,0(R13) END OF PLIST? @V305006 00360000 BNE OPTCOMP NO - CONTINUE SCAN @V305006 00361000 TM PARMFLAG,PARM THIS OPTN EXPECTING A PARM? @V305006 00362000 BZ OP1 NO - END OF OPTIONS @V305006 00363000 NULL LR R7,R13 YES - POINT TO NULL PARM ENTRY @VM03126 00364000 B ERR29E AND TELL THE USER... @V305006 00365000 EJECT 00366000 OPTCOMP EQU * BXLE LOOP FOR OPTION TABLE @V305006 00367000 CLC 0(8,R13),0(R7) PLIST ENTRY = TABLE OPTION @V305006 00368000 BE MATCH BINGO @V305006 00369000 BXLE R7,R8,OPTCOMP IF NOT, CONTINUE SCAN @V305006 00370000 TM PARMFLAG,PARM THIS A PARM FOR LAST OPTION?@V305006 00371000 BZ ERR3EA IF NOT, IT'S MISTAKE @V305006 00372000 NI PARMFLAG,255-PARM IF SO, RESET FOR NEXT OPTION@V305006 00373000 B TABLOOP IF PARM, CONT W/NEXT ENTRY @V305006 00374000 MATCH EQU * IT'S A LEGIT OPTION (SO FAR)@V305006 00375000 TM PARMFLAG,PARM SHOULD IT BE PARM FOR LAST OPT? @V305006 00376000 BO ERR29E YES - TELL THE USER... @V305006 00377000 TM 9(R7),FOUND THIS OPTION ALREADY 'FOUND'?@V305006 00378000 BO ERR65E THAT'S A NO-NO...DUP OPTION @V305006 00379000 L R2,10(,R7) NOW CHECK FOR CONFLICTS @V305006 00380000 LA R2,0(,R2) CLEAR OFFSET BYTE FROM ADDR @V305006 00381000 LTR R2,R2 ANY POSSIBLE FOR THIS OPTN? @V305006 00382000 BZ CLEAN NO @V305006 00383000 TM 9(R2),FOUND HAS CONFLICT BEEN ENTERED? @V305006 00384000 BO ERR66E YES - TELL THE USER ABOUT IT@V305006 00385000 SPACE 1 00386000 CLEAN EQU * IT'S A CLEAN MACHINE! @V305006 00387000 OI 9(R7),FOUND MARK THIS OPTION 'FOUND' @V305006 00388000 OC OPTNFLAG,8(R7) SET OPTN FLAG FOR PROCESSING@V305006 00389000 OC PARMFLAG,9(R7) REMEMBER IF IT HAS PARAMETER@V305006 00390000 STC R3,10(R7) SAVE PARM PLIST OFFSET @V305006 00391000 B TABLOOP AND CHECK NEXT PLIST ENTRY @V305006 00392000 SPACE 2 00393000 EJECT 00394000 *********************************************************************** 00395000 * 00396000 * PROCESSING OF OPERAND ONE 00397000 * 00398000 * 1. TWO OPTIONS ARE POSSIBLE: 00399000 * A. A DDNAME, OR 00400000 * B. AN ASTERISK *, (CLEAR ALL). 00401000 * 00402000 * 2. TYPE AND VALIDITY ARE CHECKED. 00403000 * A. WITH THE DDNAME, THE DOSCB TABLE IS SEARCHED FOR A 00404000 * MATCH, AND DMSFREE CALLED IF NECESSARY. 00405000 * B. FOR *, THE CLEAR OPTION IS PROCESSED. 00406000 * 00407000 *********************************************************************** 00408000 * 00409000 * PLIST POINTS TO PARAMETER 1. 00410000 * THE FIRST PARAMETER IS CHECKED FOR TYPE AND VALIDITY. 00411000 * 00412000 OP1 EQU * @V305006 00413000 CLI 0(R5),LFTPAREN '(' ENTERED AFTER 'DLBL'? @VA05247 00414000 BE LIST2 IF SO, COULD WANT EXTENTS @VA05247 00415000 CLI 7(R5),BLANK MORE THAN 7 CHARS ENTERED? @V305006 00416000 BNE ERR086E IF SO, INVALID DOS DDNAME...@V305006 00417000 CLC 0(2,R5),=CL2'*' ? CLEAR REQUEST ? @V305006 00418000 BE CLEARALL YES-CLR ALL NON-PERM DOSCB'S@V305006 00419000 * 00420000 * VALID DDNAME EXISTS. THE NEXT CHECK IS TO SEE IF THERE IS 00421000 * ALREADY AN ENTRY IN THE DOSCB TABLE. 00422000 * 00423000 SRCHDOS LH R2,DOSNUM GET COUNT OF DOSCB ENTRIES @V305006 00424000 LTR R2,R2 ? ANY ENTRIES ? @V305006 00425000 BZ NEWBLOK NO, SKIP UPDATING POINTERS @V305006 00426000 * 00427000 * PREVENT WILL CONTAIN THE ADDRESS OF THE LAST DOSCB ENTRY OR 00428000 * THE LAST ONE BEFORE A MATCH WAS FOUND. 00429000 * 00430000 L R4,DOSFIRST PTR TO 1ST ENTRY. @V305006 00431000 SRCHDOS1 CLC DOSDD(8),0(R5) ? FIND A MATCH ? @V305006 00432000 BE OLDBLOK YES - REPLACE OLD ONE @V305006 00433000 SRCHDOS5 ST R4,PREVENT SAVE PREVIOUS ENTRY POINT @V305006 00434000 L R4,0(,R4) UPDATE PTR TO NEXT ENTRY @V305006 00435000 BCT R2,SRCHDOS1 CONTINUE TIL NO MORE ENTRIES @V305006 00436000 EJECT 00437000 * 00438000 * NO MATCH FOUND, SO A NEW ENTRY MUST BE OBTAINED. 00439000 * 00440000 NEWBLOK EQU * @V305006 00441000 CLC 8(8,R5),CLEAR CLEAR REQUEST? @V305006 00442000 BE ERR322I YES, TELL USER 'NO EXIST' @V305006 00443000 NI MISCFLAG,255-(OLD+NEW) CLEAR FLAGBITS @V305106 00444000 LA R0,DOSENSIZ GET N'DBLE WORDS FOR DOSSECT @V305006 00445000 DMSFREE DWORDS=(0),TYPCALL=BALR,ERR=ERR109S @V305006 00446000 OI MISCFLAG,NEW OK - SET BLK INDICATOR TO NEW@V305106 00447000 LR R4,R1 GET V(DOSSECT) @V305006 00448000 LR R0,R4 ADDR INTO R0 (SIC) FOR MVCL, @V305106 00449000 LA R1,DOSENSIZ*8 AND SIZE (IN BYTES) INTO R1; @V305106 00450000 * R14 IMMATERIAL; R15 IS STILL = 0; 00451000 MVCL R0,R14 NOW CLEAR STORAGE OBTAINED. @V305106 00452000 MVC DOSDD(8),0(R5) PUT DDNAME INTO NEW ENTRY @V305006 00453000 MVC DOSCBID,=CL4'DLBL' DISTINGUISH DOSCB FROM CMSCB@V305006 00454000 MVC DOSYSXXX(2),PLISTEND INITIALIZE LUB TO 'UA' @V305106 00455000 MVI DOSTYPE,SAMDS DEFAULT TO SEQUENTIAL DATASET @V305106 00456000 LNR R0,R4 @V305006 00457000 L R13,CURRSAVE @V305006 00458000 ST R0,EGPR0 @V305006 00459000 CLC 0(8,R5),MCAT 'IJSYSCT' (MSTR CATLG) ENTERED? @V305106 00460000 BNE CHKJCAT IF NOT, CONTINUE @V305106 00461000 OI DOSINIT,DOSDDCAT IF SO, SIGNAL AS CATALOG @V305106 00462000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 00463000 B CHKDOS AND CONTINUE... @V305106 00464000 CHKJCAT CLC 0(8,R5),JCAT 'IJSYSUC' (JOBCAT) ENTERED? @V305106 00465000 BE JCATSUB GIVE IT SPECIAL TREATMENT @V305106 00466000 TM OPTNFLAG,XUCAT IF 'CAT' ENTERED, DROP THRU @V305106 00467000 BO CHKDOS @V305106 00468000 TM VSAMFLG1,VSJOBCAT IS JOB CATALOG ACTIVE? @V305106 00469000 BZ CHKDOS IF NOT, CONTINUE... @V305106 00470000 OI DOSINIT,DOSJCAT+DOSUCAT IF SO, MARK THIS ALSO @V305106 00471000 MVC DOSUCNAM,JCAT AND STORE THE JCAT NAME @V305106 00472000 CHKDOS EQU * @V305106 00473000 TM DOSFLAGS,DOSMODE+DOSSVC DOS USER? @VA11810 00474000 BO CHKSYS YES, CHECK FOR SYSXXX @VA05247 00475000 OI DOSINIT,DOSOS NO, MARK DOSCB AS 'OS' @VA05247 00476000 B CHKPERM AND CONTINUE... @VA05247 00477000 CHKSYS NI DOSINIT,255-DOSOS DOS USER...TURN OFF 'OS' @VA05247 00478000 TM OPTNFLAG,XSYSXXX WAS 'SYSXXX' OPTION ENTERED?@V305106 00479000 BO CHKPERM YES, WE'LL CHEK IT LATER... @V305106 00480000 CLC DOSYSXXX(2),PLISTEND IF OLD BLOK CHEK FOR ENTRY@V305106 00481000 BE ERR302E ERROR IF NO SYSXXX ENTRY @V305106 00482000 CHKPERM EQU * @V305006 00483000 TM OPTNFLAG,XPERM PERMANENT DOSCB @V305006 00484000 BNO DUM NO @V305006 00485000 OI DOSSECT,DOSPERM YES, FLAG IT @V305006 00486000 B DUM GO PROCESS OPERAND TWO. @V305006 00487000 EJECT 00488000 * 00489000 * AN EXISTING ENTRY WAS FOUND. 00490000 * 00491000 * A COPY OF IT WILL BE SAVED IN THE EVENT THAT ERRORS ARE DETECTED 00492000 * BEFORE COMPLETION OF PROCESSING SO THAT A CANCELLED DLBL IMPLIES 00493000 * THAT NO CHANGE HAS BEEN MADE TO EXISTING ENTRIES. 00494000 * 00495000 OLDBLOK EQU * @V305006 00496000 CLC 8(8,R5),CLEAR CLEAR REQUEST? @V305006 00497000 BE CLR YES, GET RID OF IT @V305006 00498000 SRCHDOS6 TM OPTNFLAG,XNOCHNGE NOCHANGE ON EXISTING DOSCB @V305006 00499000 BZ SRCHDOS3 NOPE. REVISE CURRENT DOSCB @V305006 00500000 LR R0,R4 OTHERWISE, RET A(SPEC DOSCB) @V305006 00501000 L R13,CURRSAVE RESTORE USER SAVE AREA @V305006 00502000 ST R0,EGPR0 SAVE DOSCB ADDRESS @V305006 00503000 B RETURN @V305006 00504000 SRCHDOS3 OI MISCFLAG,OLD INDIC MATCH FOUND (OLD BLOCK)@V305006 00505000 NI MISCFLAG,255-NEW SET BLOCK INDICATOR TO OLD @V305006 00506000 LNR R0,R4 @V305006 00507000 L R13,CURRSAVE @V305006 00508000 ST R0,EGPR0 @V305006 00509000 MVC OLDENTRY(DOSENSIZ*8),0(R4) SAVE OLDER COPY @V305006 00510000 XC DOSOSFST(8),DOSOSFST CLEAR FST & DSN PTR @V305006 00511000 B CHKDOS CHECK FOR DOS USER @V305006 00512000 SPACE 2 00513000 * 00514000 * COME HERE FROM 'NEWBLOK' TO POINT ALL 00515000 * CURRENT DOSCBS TO THE 'IJSYSUC' (JOB CATALOG) DOSCB 00516000 * 00517000 JCATSUB EQU * @V305106 00518000 TM OPTNFLAG,XUCAT WAS 'UCAT' OPTION USED? @V305106 00519000 BZ MARKJCAT IF NOT, CONTINUE @V305106 00520000 LA R5,UCAT OTHERWISE, ERROR... @V305106 00521000 B ERR3E @V305106 00522000 MARKJCAT OI DOSINIT,DOSDDCAT+DOSJCAT MARK IJSYSUC AS JOBCAT @V305106 00523000 OI VSAMFLG1,VSJOBCAT SIGNAL JOB CATALOG ACTIVE @V305106 00524000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 00525000 LH R1,DOSNUM GET NO. DOSCBS IN CHAIN @V305106 00526000 LTR R1,R1 ANY DOSCBS ACTIVE? @V305106 00527000 BZ CHKDOS IF NOT, WALK ON BY... @V305106 00528000 L R3,DOSFIRST START WITH CHAIN ANCHOR @V305106 00529000 DROP R4 @V305106 00530000 USING DOSSECT,R3 @V305106 00531000 JCLOOP TM DOSINIT,DOSDDCAT+DOSUCAT IF CATLG OR USING CATLG@V305106 00532000 BNZ NXTDOS LEAVE IT ALONE @V305106 00533000 OI DOSINIT,DOSJCAT+DOSUCAT IF NOT, MARK USING JCAT @V305106 00534000 MVC DOSUCNAM,0(R5) AND STORE THE JCAT DDNAME @V305106 00535000 NXTDOS L R3,DOSNEXT CONTINUE TO WORK THRU CHAIN @V305106 00536000 BCT R1,JCLOOP UNTIL THERE ARE NO MORE... @V305106 00537000 DROP R3 @V305106 00538000 USING DOSSECT,R4 @V305106 00539000 B CHKDOS RETURN AND HANDLE AS USUAL @V305106 00540000 EJECT 00541000 *********************************************************************** 00542000 * 00543000 * PROCESS THE 'CLEAR' OPERAND 00544000 * 00545000 *********************************************************************** 00546000 CLEARALL EQU * ENTER HERE FOR 'CLEAR ALL' @V305006 00547000 CLC CLEAR(8),8(R5) ? 2ND OPERAND CLEAR ? @V305006 00548000 BNE ERR70E NO, ERROR EXIT. @V305006 00549000 L R4,DOSFIRST START W/1ST DOSCB IN CHAIN @V305006 00550000 CLR EQU * ENTER HERE FOR SINGLE CLEAR @V305006 00551000 C R6,16(,R5) ONLY 2 PARAMETERS @V305006 00552000 BE CLRLOOP YES CONTINUE @V305006 00553000 LA R5,16(,R5) UPDATE PLIST FOR ERROR MSG @V305006 00554000 B ERR70E PRINT ERROR MSG. @V305006 00555000 CLRLOOP LA R4,0(,R4) CLEAR HIGH ORDER BYTE @V305006 00556000 LTR R4,R4 END OF CHAIN @V305006 00557000 BZ RETURN YES, RETURN @V305006 00558000 CLC DOSDD(8),0(R5) IS THIS RIGHT DDNAM @V305006 00559000 BE CLR2 YES, NOW CLEAR IT... @V305006 00560000 CLI 0(R5),CHARAST IS THIS 'CLEAR ALL' ? @V305066 00561000 BNE NXTCB IF NOT, TRY NEXT DOSCB @V305006 00562000 TM 0(R4),DOSPERM IF SO, TEST FOR PERM DOSCB @V305006 00563000 BZ CLR2 IF NOT PERM, CLEAR IT... @V305006 00564000 NXTCB ST R4,PREVENT SAVE DOSCB ADDRESS @V305006 00565000 L R4,0(,R4) GET NEXT DOSCB POINTER @V305006 00566000 B CLRLOOP CHECK NEXT DOSCB @V305006 00567000 CLR2 LR R3,R4 USE 'EXIT' CODE TO CLR BLKS @V305006 00568000 BAL R9,OLDDSUB FREE DSN BLOCK @V305006 00569000 BAL R9,OLDMSUB FREE MULTIVOL BLOCK @V305006 00570000 BAL R9,OLDESUB FREE EXTENTS BLOCK @V305006 00571000 L R1,PREVENT GET LAST BLOCK IN CHAIN @V305006 00572000 LTR R1,R1 IS THIS FIRST OR ONLY BLOCK?@V305006 00573000 BNZ DELINK IF NOT, TAKE BLK OUTOF CHAIN@V305006 00574000 LA R1,DOSFIRST IF SO, WE NEED NEW ANCHOR @V305006 00575000 DELINK MVC 1(3,R1),1(R4) MOVE FWD PTR BACK 1 IN CHAIN@V305006 00576000 LH R2,DOSNUM GET NO. BLOKS IN CHAIN @V305006 00577000 BCTR R2,0 DECREMENT BY 1 @V305006 00578000 STH R2,DOSNUM AND STORE NEW NO. @V305006 00579000 CLC DOSDD(8),MCAT MSTR CATALOG BEING CLEARED? @V305106 00580000 BNE JCATCHEK IF NOT, CHEK FOR JOB CATALOG@V305106 00581000 LA R8,MASTER IF SO, SET UP MESSAGE @V305106 00582000 LA R10,FRETIT GO RIGHT TO FRET UPON RETURN@V305106 00583000 B CLEARMSG AND TELL THE USER WHAT HE'S D@V305106 00584000 JCATCHEK EQU * @V305106 00585000 TM DOSINIT,DOSDDCAT+DOSJCAT CLEARING JCAT DDNAME? @V305106 00586000 BNO FRETIT IF NOT, CONTINUE AS USUAL.. @V305106 00587000 LR R9,R4 IF SO,SAVE PTR TO JCAT DOSCB@V305106 00588000 BAL R10,JCLRSUB MAKE SURE WE CLEAN UP... @V305106 00589000 LR R4,R9 RESTORE JCAT DOSCB PTR @V305106 00590000 FRETIT LA R0,DOSENSIZ GET SIZE OF DOSCB @V305006 00591000 LR R1,R4 AND ADDRESS OF CLEARED BLOCK@V305006 00592000 L R4,0(,R4) GET NXT BLK IN CHAIN(FOR'*')@V305006 00593000 BAL R10,FRET FREE THE BLOCK @V305006 00594000 CLI 0(R5),CHARAST 'CLEAR ALL' ? @V305066 00595000 BE CLRLOOP YES, CLR ALL DOSCB'S UNLESS PERM @V305006 00596000 B RETURN IF NOT, RETURN IMMEDIATELY @V305006 00597000 SPACE 2 00598000 *********************************************************************** 00599000 * 00600000 * SUBROUTINE TO PROCESS 'IJSYSUC CLEAR' 00601000 * 00602000 *********************************************************************** 00603000 JCLRSUB SR R2,R2 CLEAR OUT A COUPLE FOR LATER@V305106 00604000 SR R3,R3 @V305106 00605000 LH R1,DOSNUM GET NO. DOSCBS IN CHAIN @V305106 00606000 LTR R1,R1 ANY ENTRIES? @V305106 00607000 BZ CLRNUC IF NOT, JUST CLR NUCON FLDS @V305106 00608000 L R4,DOSFIRST AND START WITH ANCHOR @V305106 00609000 JCLRLOOP TM DOSINIT,DOSJCAT THIS DOSCB USING JOBCAT? @V305106 00610000 BZ NXTONE IF NOT, TRY NEXT GUY @V305106 00611000 NI DOSINIT,255-DOSJCAT-DOSUCAT JCAT INACTV FOR USER@V305106 00612000 STM R2,R3,DOSUCNAM AND ERASE THE JOBCAT DDNAME @V305106 00613000 NXTONE L R4,DOSNEXT LOAD UP NEXT DOSCB @V305106 00614000 BCT R1,JCLRLOOP AND KEEP GOING... @V305106 00615000 CLRNUC NI VSAMFLG1,255-VSJOBCAT REALLY MAKE JOBCAT INACTV @V305106 00616000 LA R8,JOB SET UP JCAT CLEARED MSG @V305106 00617000 SPACE 1 00618000 CLEARMSG EQU * @V305106 00619000 DMSERR NUM=323,LET=I,SUB=(CHARA,(R8)), @V305106*00620000 TEXT='........ CATALOG DLBL CLEARED' @V305106 00621000 SPACE 1 00622000 BR R10 ALL DONE... RETURN TO CALLER@V305106 00623000 EJECT 00624000 *********************************************************************** 00625000 * 00626000 * PROCESS THE 'DUMMY', 'MODE', 'MODE DSN', 'MODE CMS' OPERANDS 00627000 * 00628000 *********************************************************************** 00629000 * 00630000 * PLIST (R5) STILL POINTS TO THE DDNAME (1ST OPERAND). 00631000 * 00632000 DUM EQU * @V305006 00633000 CLC DUMMY(8),8(R5) ? DUMMY OPTION ? @V305006 00634000 BNE MODE NO, GO CHECK FOR DSK. @V305006 00635000 MVI DOSDEV,DOSDUM ENSURE DEVICE CODE = '00' @V305006 00636000 B MODE2 AND CONTINUE @V305006 00637000 MODE EQU * @V305006 00638000 MVC DOSDSMD(2),8(R5) MOVE USER'S MODE TO DOSCB @VA11758 00639000 CLI DOSDSMD,CHARAST IS FILE MODE ASTERISK? @VA11758 00639800 BE SETDEVTP DON'T CHECK NUMBER @VA11758 00640600 CLI DOSDSMD+1,BLANK IF NUMBER ENTERED--- @VA11758 00641400 BNE SETDEVTP USE IT @VA11758 00642200 MVI DOSDSMD+1,MODE1 ELSE SET DEFAULT TO 1 @VA11758 00643000 SETDEVTP EQU * @VA11758 00643800 MVI DOSDEV,DOSDSK SET DISK DEVICE TYPE @V305006 00645000 MODE2 LA R9,16(,R5) POINT AT 'DSN' OR 'CMS' @V305006 00646000 CLC 0(8,R9),=CL8'DSN' 'DSN' SPECIFIED? @V305006 00647000 BNE CHEKCMS NO, CHEK FOR CMS DATASET @V305006 00648000 OI MISCFLAG,DSNOP YES, REMEMBER DSN ENTERED @V305006 00649000 B DEFAULT AND USE DEFAULT CMS FILEID @V305006 00650000 CHEKCMS CLC 0(8,R9),CMS 'CMS' SPECIFIED? @V305006 00651000 BNE DEFAULT NO, USE DEFAULT FILEID @V305006 00652000 * YES, CHEK CMS FILEID... 00653000 LA R9,8(,R9) POSITION R9 AFTER 'CMS' @V305006 00654000 CLI 0(R9),LFTPAREN END OF OPERANDS? @V305066 00655000 BE ERR001E FILEID MISSING... @V305006 00656000 C R6,0(R9) CHEK END OF LINE @V305006 00657000 BE ERR001E FILEID MISSING @V305006 00658000 LA R9,8(,R9) BUMP R9 TO NEXT PLIST POS @V305006 00659000 C R6,0(R9) IF END OF LINE, ERROR=NO FILETYPE@V305006 00660000 BE ERR23E @V305006 00661000 CLI 0(R9),LFTPAREN CHECK OPTION START @V305066 00662000 BE ERR23E ALSO ERROR @V305006 00663000 MVC DOSDSNAM(16),24(R5) USE USER NAME & TYPE @V305006 00664000 MVC STATFN(18),DOSDSNAM INFO FOR STATE CALL @V305006 00665000 LA R9,8(,R9) BUMP R9 TO NEXT PLIST POS @V305006 00666000 OI MISCFLAG,CMSOP SIGNAL 'CMS' ENTERED @V305006 00667000 B STATCALL @V305006 00668000 SPACE 1 00669000 DEFAULT MVC DOSDSNAM(8),FILE PUT IN DEFAULT NAME 'FILE' @V305006 00670000 MVC DOSDSNAM+8(8),0(R5) AND USE DDNAME AS FILETYPE @V305006 00671000 MVC STATFN(18),DOSDSNAM INFO FOR STATE CALL @V305006 00672000 EJECT 00673000 DSNCHEK EQU * @V305006 00674000 TM MISCFLAG,DSNOP 'DSN' ENTERED? @V305006 00675000 BZ STATCALL NO, DEFAULT ON DISK TYPE @V305006 00676000 SPACE 1 00677000 DMSFREE DWORDS=17,TYPCALL=BALR,ERR=ERR109S GET WK AREA@V305006 00678000 SPACE 1 00679000 ST R1,DSNSAVE SAVE DSN BLOCK ADDR @V305006 00680000 LR R3,R1 ADDR. TO R3 @V305006 00681000 CLC 8(8,R9),=CL8'?' PROMPT WANTED ? @V305006 00682000 BNE NOPROMPT NO @V305006 00683000 LA R9,16(0,R9) GET PAST '?' @V305006 00684000 SPACE 1 00685000 DMSERR TEXT='ENTER DATA SET NAME:',NUM=220,LET=R,DOT=NO 00686000 SPACE 1 00687000 STCM R3,BIN0111,DSNBUF SET TERMINAL READ PLIST @V305066 00688000 LA R1,CONREAD PLIST TO R1 @V305006 00689000 SVC 202 READ DOS DSNAME @V305006 00690000 ICM R7,BIN0111,DSNBYTE GET LENGTH READ @V305066 00691000 LTR R7,R7 ZERO BYTES @V305006 00692000 BZ BADDSN YES, ERROR @V305006 00693000 SH R7,=H'44' CHECK FOR > 44 CHARACTERS @V305006 00694000 BNP OSDSNSET LESS THAN 44, CONTINUE @V305006 00695000 EJECT 00696000 CKOVR44 LA R1,43(R7,R3) GET ADDR OF NEXT BYTE CHECK @V305006 00697000 CLI 0(R1),BLANK ANY NON BLANKS SPECIFIED? @V305006 00698000 BNE BADDSN YES, THEN ERROR @V305006 00699000 BCT R7,CKOVR44 CHECK NEXT CHARACTER @V305006 00700000 B OSDSNSET GO COMPLETE DOSCB @V305006 00701000 NOPROMPT LR R7,R3 USE R7 FOR WORK @V305006 00702000 MVI 0(R3),BLANK BLANK DSNAME BLOCK @V305006 00703000 MVC 1(44,R3),0(R3) PLUS ONE @V305006 00704000 LA R1,45(0,R3) SET END OF DSNAME BLOCK - 3 @V305006 00705000 NXTPARM LA R9,8(0,R9) NEXT PARAMETER @V305006 00706000 CLI 0(R9),LFTPAREN END OF PARAM @V305066 00707000 BE QUALEND YES, RELEASE WORK AREA @V305006 00708000 C R6,0(R9) END OF PARAM @V305006 00709000 BE QUALEND YES, RELEASE WORK AREA @V305006 00710000 CR R8,R9 END OF PARAM @V305006 00711000 BE QUALEND YES @V305006 00712000 MVC 0(8,R7),0(R9) 1ST DOS QUALIFIER (OR NEXT) @V305006 00713000 NXTQUAL LA R7,1(0,R7) NEXT CHAR. THIS QUALIFIER @V305006 00714000 CR R7,R1 CHECK AGAINST 44 BYTE LIMIT @V305006 00715000 BH BADDSN IF HIGH ERROR @V305006 00716000 CLI 0(R7),BLANK BLANK @V305006 00717000 BE PERIOD YES, SET PERIOD @V305006 00718000 CLI 0(R7),DECPT IS PERIOD SPECIFIED? @V305066 00719000 BE BADDSN YES, THEN BAD DATA SET NAME @V305006 00720000 B NXTQUAL LOOK AT NEXT CHAR @V305006 00721000 SPACE 1 00722000 PERIOD MVI 0(R7),DECPT SET QUALIFIER END @V305066 00723000 LA R7,1(0,R7) GET PAST PERIOD @V305006 00724000 B NXTPARM CHECK FOR ANOTHER QUALIFIER @V305006 00725000 QUALEND SH R7,=H'1' BACK OFF LAST PERIOD @V305006 00726000 CR R7,R3 WERE ANY QUALIFIERS ENTERED @V305006 00727000 BNH BADDSN NO, ERROR @V305006 00728000 MVI 0(R7),BLANK RESET LAST PERIOD TO BLANK @V305006 00729000 OSDSNSET LR R2,R3 SET TO SCAN FOR INVLD NAME @V305006 00730000 CLI 0(R2),DECPT 1ST CHAR = '.' @V305066 00731000 BE BADDSN YES, ERROR @V305006 00732000 DSNLP LA R7,43(,R3) POINT TO END OF DSNAME @V305006 00733000 SR R7,R2 LENGTH TO TRT @V305006 00734000 BM BADDSN LONGER THAN 44 CHAR @V305006 00735000 EX R7,OSTRT SCAN FOR INVLD CHAR @V305006 00736000 BZ GOODDSN NO INVLD CHAR @V305006 00737000 LR R2,R1 SET R2 TO INVLD CHAR @V305006 00738000 CLI 0(R2),DECPT IS CHAR '.' @V305066 00739000 BNE BADDSN NO, ERROR @V305006 00740000 LA R2,1(,R2) NEXT CHAR @V305006 00741000 CLI 0(R2),DECPT IS THIS '.' ALSO @V305066 00742000 BNE DSNLP NO, OK @V305006 00743000 EJECT 00744000 BADDSN OI MISCFLAG,DSNERRS SIGNAL FOR FRET OF ALL 17 DWRDS@V305006 00745000 B ERR221E @V305006 00746000 OSTRT TRT 0(*-*,R2),OSTBL EXECUTED SCAN OF DSNAME @V305006 00747000 SPACE 1 00748000 GOODDSN LA R1,48(,R3) RELEASE ALL BUT DSNAME @V305006 00749000 LA R0,FRETWDS DOUBLEWORDS TO DMSFRET @V305066 00750000 BAL R10,FRET CALL FRET @V305006 00751000 SPACE 1 00752000 STATCALL EQU * @V305006 00753000 LA R10,DCONT COMING IN FROM ABOVE.. @V305006 00754000 STATSUB EQU * MAY BE CALLED FROM ELSEWHERE@V305006 00755000 LA R1,STATLST PURELY SYNTACTICAL 'STATE' @V305006 00756000 IC R2,DOSFLAGS SAVE CURRENT DOS STATUS @V305006 00757000 OI DOSFLAGS,DOSSVC TELL DMSROS IN CASE OF OS USER@V305006 00758000 SVC 202 @V305006 00759000 DC AL4(*+4) @V305006 00760000 STC R2,DOSFLAGS RESTORE DOS STATUS @V305006 00761000 LTR R15,R15 @V305006 00762000 BZ DISKCHEK IGNORE IF FOUND @V305006 00763000 CH R15,=H'28' @V305006 00764000 BE DISKCHEK IGNORE 'NOT FOUND' @V305006 00765000 CH R15,=H'36' DISK NOT ACCESSED @VA12416 00765500 BE ERRMSG36 YES, ISSUE MSG69E @VA12416 00765600 CH R15,=H'80' DOS DATA SET NOT FOUND @V305006 00766000 BL EXIT SYNTAX OR DISK NOT ACCESSED PROB @V305006 00767000 DISKCHEK SR R15,R15 CLEAR R15; @V305106 00768000 CLI DOSDEV,DOSDUM PERCHANCE 'DUMMY' SPEC'FD? @V305106 00769000 BER R10 YES-RETN TO CALLER (W/R15=0)@V305106 00770000 L R15,VCADTLKP OTHERWISE, CHECK @VM03093 00771000 BALR R14,R15 THE DISK FORMAT @V305106 00772000 XR R15,R15 CLEAR R15 IN CASE NO ERRS @V305006 00773000 USING ADTSECT,R1 ADT OF DISK RETURNED IN R1 @V305006 00774000 TM ADTFLG2,ADTFROS+ADTFDOS IS DISK OS OR DOS? @V305006 00775000 BZ CMSDISK NO, MUST BE CMS DISK @V305006 00776000 TM MISCFLAG,CMSOP WAS 'CMS' ENTERED? @V305006 00777000 BZR R10 IF NOT, NO SWEAT. @V305006 00778000 LA R3,CMS IF SO, TELL USER TYPE OF DATASET @V305006 00779000 LA R2,NONCMS AND TYPE OF DISK FORMAT. @V305006 00780000 B ERR308E @V305006 00781000 CMSDISK TM MISCFLAG,DSNOP WAS 'DSN' SPECIFIED? @V305006 00782000 BZR R10 IF NOT, CMS DATASET AND DISK@V305006 00783000 LA R3,NONCMS IF SO, NONCMS DATASET @V305006 00784000 LA R2,CMS ON CMS DISK? ...ERROR @V305006 00785000 B ERR308E @V305006 00786000 DCONT EQU * DROP THRU IN CASE OF MASTER MODE @V305106 00787000 CLI DOSDEV,DOSDUM PERCHANE 'DUMMY' ? @VM03114 00788000 BE DCONT2 YES, CONTINUE BELOW. @VM03114 00789000 TM ADTFLG2,ADTFROS+ADTFDOS IS MASTER DISK OS/DOS ? @V305106 00790000 DROP R1 @V305106 00791000 BZ CMSFLG NO, MUST BE CMS DISK @V305106 00792000 OI MISCFLAG,DSNOP MARK AS DOS/OS DISK @V305106 00793000 OI DOSINIT,DOSDOS MARK AS DEFINED FOR DOS DISK@VA05247 00794000 NI DOSINIT,255-DOSCMS CLEAN UP OLD SETTINGS @VA05247 00795000 B DCONT2 AND CONTINUE BELOW @VM03114 00796000 CMSFLG OI MISCFLAG,CMSOP MARK AS CMS DISK @V305106 00797000 OI DOSINIT,DOSCMS MARK AS DEFINED FOR CMS DISK@VA05247 00798000 NI DOSINIT,255-DOSDOS CLEAN UP OLD SETTINGS @VA05247 00799000 DCONT2 C R6,0(R9) IF END OF LINE, GET OUT @VM03114 00800000 BE EXIT @V305006 00801000 CLI 0(R9),LFTPAREN START OF OPTIONS?? @V305066 00802000 BNE ERR70EB IF NOT, TOO MANY PARMS.. @V305006 00803000 EJECT 00804000 *********************************************************************** 00805000 * 00806000 * OPTION PROCESSING 00807000 * 00808000 * TEST EACH OPTION'S FLAG IN 'OPTNFLAG;' 00809000 * IF THE OPTION HAS BEEN ENTERED, PROCESS IT ACCORDINGLY. 00810000 * IF THE 'PARM' FLAG IN 'OPTAB' IS ON FOR THE OPTION, ITS 00811000 * PARAMETER MAY BE FOUND IN THE PLIST BY THE OFFSET FIELD 00812000 * SET PREVIOUSLY IN ITS 'OPTAB' ENTRY. 00813000 * 00814000 *********************************************************************** 00815000 SPACE 2 00816000 *********************************************************************** 00817000 * 00818000 * PROCESS THE 'BUFSP' OPTION 00819000 * 00820000 *********************************************************************** 00821000 BUFSPCHK EQU * @V305106 00822000 TM OPTNFLAG,XBUFSP 'BUFSP' OPTION ENTERED? @V305106 00823000 BZ SYSCHK IF NOT, TRY NEXT OPTION... @V305106 00824000 SPACE 1 00825000 TM MISCFLAG,CMSOP WAS 'CMS' ENTERED? @V305106 00826000 BO ERR308EA SORRY, THIS IS VSAM OPTION..@V305106 00827000 XR R8,R8 @V305106 00828000 IC R8,BUFSP+10 GET PLIST DISPL FOR BUFSP VALUE @V305106 00829000 SLL R8,3 MULT X 8 (SIZE OF CMS TOKEN)@V305106 00830000 A R8,OPSTART ADD OPTN START, PT AT BUFSP VALUE@V305106 00831000 BAL R10,CONVERT MAKE SURE IT'S VALID @V305106 00832000 C R3,=F'999999' CHEK UPPER VSAM BUFSP LIMIT @V305106 00833000 BH ERR304E ERROR IF MORE @V305106 00834000 ST R3,DOSBUFSP GOOD VALUE, STOR IT IN DOSCB@V305106 00835000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 00836000 EJECT 00837000 *********************************************************************** 00838000 * 00839000 * PROCESS THE 'SYSXXX' OPTION 00840000 * 00841000 *********************************************************************** 00842000 SYSCHK EQU * @V305006 00843000 TM OPTNFLAG,XSYSXXX WAS 'SYSXXX' ENTERED? @V305006 00844000 BZ MULTCHK NO - TRY NEXT OPTION @V305006 00845000 SPACE 1 00846000 IC R1,DOSDSMD LOAD CURRENT MODE FOR VER'FN@V305006 00847000 BAL R10,UNITEST INSURE ASSGN DONE FOR UNIT @V305006 00848000 MVC DOSYSXXX,SAVEUNIT ASSGN DONE,STOR UNIT IN DOSCB@V305006 00849000 TM OPTNFLAG,XMULT 'MULT' ENTERED? @V305106 00850000 BO SYSEXT YES, DON'T BOTHER WITH FOLLOWING @V305106 00851000 L R1,DOSVOLTB NO, CK FOR EXSTNG MULT BLK @V305106 00852000 LTR R1,R1 ... @V305106 00853000 BZ SYSEXT NONE, CHEK FOR EXTENT BLOK..@V305106 00854000 LA R2,MULTLEN BINGO, LOAD ENTRY LENGTH @V305066 00855000 XR R3,R3 @V305106 00856000 ICM R3,1,DOSVOLNO AND NOUMBER ENTRIES @V305106 00857000 BAL R10,MODESRCH SRCH MULT BLK FOR MSTR MODE @V305106 00858000 SPACE 00859000 SYSEXT TM OPTNFLAG,XEXTENT 'EXTENT' ENTERED? @V305106 00860000 BO MULTCHK YES, DON'T BOTHER WITH FOLLOWING @V305106 00861000 L R1,DOSEXTTB EXISTING EXTENT BLOK? @V305106 00862000 LTR R1,R1 ... @V305106 00863000 BZ MULTCHK NO, CONTINUE... @V305106 00864000 LA R2,EXTLEN GET EXTENT ENTRY LENGTH @V305066 00865000 XR R3,R3 .. @V305106 00866000 ICM R3,1,DOSEXTNO AND NUMBER OF ENTRIES @V305106 00867000 BAL R10,MODESRCH LK FOR MSTR MODE IN EXT BLK @V305106 00868000 B MULTCHK CONTINUE OPTION CHEKING... @V305106 00869000 SPACE 00870000 MODESRCH EQU * SCAN A BLK FOR 'MASTER' MODE@V305106 00871000 BLOOP CLC 0(1,R1),DOSDSMD MODE MATCH? @V305106 00872000 BNE GETNEXT NO, KEEP LOOKING... @V305106 00873000 MVC 1(2,R1),DOSYSXXX YES, STOR NEW LOG UNIT CODE @V305106 00874000 GETNEXT LA R1,0(R2,R1) POINT TO NEXT ENTRY @V305106 00875000 BCT R3,BLOOP LOOP THRU BLOK @V305106 00876000 BR R10 RETN->CALLER WHEN END OF BLK@V305106 00877000 EJECT 00878000 SPACE 2 00879000 *********************************************************************** 00880000 * 00881000 * 'SYSCODE' SUBROUTINE VALIDATES THE XXX OF THE 'SYSXXX' 00882000 * OPTION AS A LEGITIMATE DOS LOGICAL UNIT. 00883000 * 00884000 * ENTRY - R13 POINTS TO USER SYSXXX ENTRY 00885000 * - R10 CONTAINS RETURN ADDR FOR SUCCESSFUL TEST 00886000 * 00887000 * EXIT - 'SAVEUNIT' CONTAINS 2-BYTE UNIT CODE 00888000 * 00889000 * REGISTER USAGE - 1,2 00890000 * 00891000 * CALLED BY - 'OPTSCAN' ROUTINE FOR 'SYSXXX' OPTION, 00892000 * AND BY 'MULT' AND 'EXTENT' OPTION PROCESSING 00893000 * 00894000 *********************************************************************** 00895000 SYSCODE EQU * SPEC CASE VALID'N FOR 'SYSXXX' @V305006 00896000 MVC SAVESYS,0(R13) SAVE THE 'XXX' IN CASE ERROR@V305006 00897000 CLC 3(3,R13),=CL3'000' PROG/SYSTEM UNIT @V305006 00898000 BL SYSTEM SYSTEM UNIT @V305006 00899000 MVI SAVEUNIT,PROG PROGRAMMER LUB UNIT @V305006 00900000 CLC 3(3,R13),=CL3'241' EXCEEDS MAX PROG LUB UNIT ? @V305006 00901000 BH ERR3EA YES, INVALID OPTION @V305006 00902000 PACK PACKFLD(8),3(3,R13) PACK XXX VALUE @V305006 00903000 CVB R1,PACKFLD CONVERT IT TO BINARY @V305006 00904000 STC R1,SAVEUNIT+1 SAVE CONVERTED XXX @V305006 00905000 BR R10 ALL DONE FOR NOW @V305006 00906000 SYSTEM MVI SAVEUNIT,SYSLOG SYSTEM LUB UNIT @V305006 00907000 LA R1,UNITTAB GET SYSTEM TABLE BEGIN @V305006 00908000 LA R2,UNITEND GET SYSTEM TABLE ENTRIES @V305006 00909000 REPEAT CLC 3(3,R13),0(R1) MATCH ? @V305006 00910000 BE MOVE1 YES, BRANCH @V305006 00911000 LA R1,4(,R1) BUMP TO NEXT ENTRY @V305006 00912000 BCT R2,REPEAT KEEP LOOKING @V305006 00913000 B ERR3EA NOT FOUND @V305006 00914000 MOVE1 MVC SAVEUNIT+1(1),3(R1) MOVE SYS LUB UNIT TO SAVE @V305006 00915000 BR R10 ALL DONE @V305006 00916000 EJECT 00917000 *********************************************************************** 00918000 * 00919000 * 'UNITEST' SUBROUTINE SEARCHES THE DOS LUB AND 00920000 * PUB TO INSURE THAT THE USER HAS PREVIOUSLY ISSUED 00921000 * AN ASSGN COMMAND TO ASSOCIATE A DOS LOGICAL UNIT 00922000 * WITH A CMS DISK MODE. 00923000 * 00924000 * ENTRY - R1 CONTAINS CMS DISK MODE LETTER IN LOW ORDER BYTE 00925000 * - R10 CONTAINS RETURN ADDRESS FOR SUCCESSFUL TEST 00926000 * - 'SAVEUNIT' CONTAINS LOGICAL UNIT CODE OBTAINED 00927000 * FROM SUCCESSFUL 'SYSCODE' CALL 00928000 * 00929000 * REGISTER USAGE - 2,3,5,7 00930000 * 00931000 * CALLED BY - 'SYSXXX', 'MULT' AND 'EXTENT' OPTION PROCESSING 00932000 * 00933000 *********************************************************************** 00934000 UNITEST EQU * @V305006 00935000 USING BGCOM,R7 ESTABLISH COMREG ADDRESSABILITY @V305006 00936000 GETLUB L R7,ASYSREF GET ADDRESS OF BGCOM @V305006 00937000 LH R3,NICLPT NICL ADDRESS @V305006 00938000 SR R2,R2 CLEAR REGISTER R2 @V305006 00939000 IC R2,0(R3) NO. SYS LOGICAL UNITS FROM NICL @V305006 00940000 SR R3,R3 CLEAR REGISTER @V305006 00941000 IC R3,SAVEUNIT+1 LOG UNIT CLASS @V305006 00942000 TM SAVEUNIT,PROG PROGRAMMER LOGICAL UNIT ? @V305006 00943000 BNO DOUBLE NO, MUST BE SYSTEM UNIT @V305006 00944000 AR R3,R2 INCREM BY NO SYSTEM LUBS @V305006 00945000 DOUBLE AR R3,R3 DOUBLE VALUE IN R3 @V305006 00946000 AH R3,LUBPT ADD LUB TABLE ADDRESS @V305006 00947000 CLI DOSDEV,DOSDUM 'DUMMY' MODE USED? @V305006 00948000 BNE GETPUB IF NOT, CHEK FOR MODE IN PUB @V305006 00949000 TM VSAMFLG1,VSAMSERV IS THIS AMS 'TLBL' CALL? @V305106 00950000 BOR R10 YES, RETURN FOR AMSERV DUMMY @VM03008 00951000 CLI 0(R3),IGNORE IF 'DUMMY', ASSIGNED AS 'IGN'? @V305006 00952000 BNE ERR306E ERROR IF NOT... @V305006 00953000 BR R10 RETURN 'CAUSE IT'S OK @V305006 00954000 * AT THIS TIME R3 POINTS TO LUB BYTE 00955000 GETPUB LH R2,PUBPT PUB ADDRESS @V305006 00956000 SR R5,R5 CLEAR REGISTER @V305006 00957000 IC R5,0(R3) CONTAINS PUB INDEX CODE @V305006 00958000 SLL R5,3 MULTIPLY BY LENGTH OF PUB @V305006 00959000 AR R5,R2 ADD PUB ADDRESS @V305006 00960000 DROP R7 @V305006 00961000 * AT THIS TIME R5 POINTS TO CORRECT PUB ENTRY 00962000 CLM R1,BIN0001,3(R5) USER'S MODE MATCH PUB ENTRY?@V305006 00963000 BCR 8,R10 IF SO, IT'S O.K. TO RETURN @V305006 00964000 STC R1,PARMFLAG SAVE THE MODE FOR ERRMSG @V305006 00965000 B ERR301E IF NOT, STOP THE SHOW @V305006 00966000 EJECT 00967000 *********************************************************************** 00968000 * 00969000 * PROCESS THE 'MULT' OPTION 00970000 * 00971000 *********************************************************************** 00972000 MULTCHK EQU * @V305106 00973000 TM OPTNFLAG,XMULT WAS 'MULT' OPTION ENTERED? @V305106 00974000 BZ EXTENCHK IF NOT, TRY NEXT OTPION @V305106 00975000 SPACE 1 00976000 TM MISCFLAG,CMSOP 'CMS' ENTERED? @V305106 00977000 BO ERR308EA SORRY, THIS IS VSAM OPTION..@V305106 00978000 MVI DOSVOLNO,ZEROVOL @V305066 00979000 LA R0,MULTSIZE SIZE OF MULTBLOK IN DWORDS @V305106 00980000 DMSFREE DWORDS=(0),ERR=ERR109S,TYPCALL=BALR @V305106 00981000 LR R9,R1 KEEP MULTIVOL BLOK ADDR @V305106 00982000 ST R9,MULTSAVE AND SAVE IT FOR POSTERITY @V305106 00983000 XC 0(32,R9),0(R9) CLR BLK FOR STORING VOL INFO@V305106 00984000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 00985000 SPACE 1 00986000 DMSERR LET=R,NUM=330,TEXT='ENTER VOLUME SPECIFICATIONS: ',DOT=*00987000 NO @V305106 00988000 SPACE 1 00989000 RDLINE EQU * LOOP TO READ LINES FROM CONS@V305106 00990000 BAL R10,RDTERM READ A LINE FROM CONSOLE @V305106 00991000 LTR R0,R0 NULL LINE ENTERED? @V305106 00992000 BNZ LINECHEK NO, VALIDATE AND STORE DATA @V305106 00993000 L R9,MULTSAVE YES, LOAD THE BLOK ADDR @V305106 00994000 CLI 0(R9),FIRST0 IS FIRST POSITION '0' @V305066 00995000 BNE UCATCHK NO, JUST END OF INPUT..CONT @V305106 00996000 LR R8,R9 YES, NO DATA ENTRD(1ST LINE NULL)@V305106 00997000 B ERR48E ERROR... @V305106 00998000 EJECT 00999000 LINECHEK EQU * CHEK LINE FOR VALID DATA ENTRIES @V305106 01000000 * R9 -> MULTIVOL BLOK 01001000 LR R8,R2 R8 -> CONSOLE DATA LINE @V305106 01002000 LR R6,R0 R6 = CONSOLE LINE LENGTH @V305106 01003000 CLI DOSVOLNO,0 FIRST TIME THRU (ENTRIES=0)?@V305106 01004000 BNE SCAN1 NO, MSTR MODE ALREDY ACC'TD FOR @V305106 01005000 MVC 0(1,R9),DOSDSMD INCL 'MASTER'MODE IN MULTBLK@V305106 01006000 MVC 1(2,R9),DOSYSXXX DITTO FOR LOG UNIT CODE @V305106 01007000 LA R7,ONE @V305106 01008000 STCM R7,1,DOSVOLNO INIT ENTRY COUNT TO ONE @V305106 01009000 LA R9,3(,R9) POINT TO NEXT ENTRY SLOT @V305106 01010000 SCAN1 CLI 0(R8),BLANK CURRENT CHAR BLANK? @V305106 01011000 BNE MODECHK IF NOT, IT'S MODE LETTER @V305106 01012000 NEXTSPEC EQU * @V305106 01013000 LA R8,1(,R8) IF SO, LOOK AT NEXT CHAR @V305106 01014000 BCT R6,SCAN1 CHEK FOR END OF LINE @V305106 01015000 B RDLINE IF END, READ ANOTHER LINE...@V305106 01016000 MODECHK EQU * VALIDATE MODE LETTER @V305106 01017000 CLI 0(R8),MODEA CHECK LOW RANGE @V305066 01018000 BL ERR48E ERROR IF LESS @V305106 01019000 CLI 0(R8),MODEZ ... @V305066 01020000 BE MODEOK O.K. IF 'Z' @V305106 01021000 CLI 0(R8),MODEY ... @V305066 01022000 BE MODEOK O.K. IF 'Y' @V305106 01023000 CLI 0(R8),MODEG CHECK HIGH RANGE @V305066 01024000 BH ERR48E ERROR IF HIGH @V305106 01025000 MODEOK EQU * VALID CMS DISK MODE @V305106 01026000 MVC STATMD(1),0(R8) N7 @V305106 01027000 BAL R10,STATSUB BY USING 'STATE' @V305106 01028000 MVC 0(1,R9),0(R8) STOR MODE IN MULTIVOL BLK ENTRY @V305106 01029000 TM DOSFLAGS,DOSMODE+DOSSVC DOS USER? @VA11810 01030000 BNO NXTENTRY NO, GET NEXT DISK ENTRY @VA11810 01031000 DOSUSER EQU * YES, CHEK FOR 'SYSXXX' ENTRY@V305106 01032000 LA R8,1(,R8) LOOK AT NEXT CHAR @V305106 01033000 BCT R6,SCAN2 CHEK FOR END OF LINE @V305106 01034000 B ERR302E ERROR IF NO 'SYSXXX' ENTERED@V305106 01035000 SCAN2 CLI 0(R8),BLANK CURRENT CHAR BLANK? @V305066 01036000 BE DOSUSER GET NEXT CHAR IF SO @V305106 01037000 CLC 0(3,R8),SYSXXX IF NOT, MUST BE 'SYS' @V305106 01038000 BNE ERR302E ERROR IF NO 'SYSXXX' @V305106 01039000 LR R13,R8 POINT AT ENTRY AND @V305106 01040000 BAL R10,SYSCODE VALIDATE 'XXX' AS LOG UNIT @V305106 01041000 IC R1,0(R9) MAKE SURE THE DISK WAS 'ASSGN'D @V305106 01042000 BAL R10,UNITEST DO IT @V305106 01043000 MVC 1(2,R9),SAVEUNIT COMPLETE THE MULTIVOL ENTRY @V305106 01044000 LA R8,6(,R8) POINT PAST 'SYSXXX' ENTRY @V305106 01045000 SH R6,=H'5' AND CHEK FOR END OF LINE @V305106 01046000 BM ERR302E JUST IN CASE... @V305106 01047000 BCT R6,SCAN3 @V305106 01048000 B MFINISH CLEANUP AND GET NEW LINE @V305106 01049000 SCAN3 CLI 0(R8),C',' END OF ENTRY? @V305106 01050000 BE MFINISH IF SO, GET NXT ENTRY ON LINE@V305106 01051000 CLI 0(R8),BLANK CURRENT CHAR BLANK? @V305106 01052000 BE NXTENTRY YES, CONTINUE @V305106 01053000 LR R5,R8 POINT TO JUNK @V305106 01054000 B ERR70E STRANGE DATA @V305106 01055000 NXTENTRY EQU * @V305106 01056000 LA R8,1(,R8) GET NEXT CHAR IN LINE @V305106 01057000 BCT R6,SCAN3 CHEK FOR END OF LINE @V305106 01058000 SPACE 2 01059000 MFINISH EQU * COME HERE AFTER EACH VALID ENTRY @V305106 01060000 LA R9,3(,R9) SKIP TO NEXT BLOK ENTRY @V305106 01061000 SR R7,R7 CLEAR FOR COUNT CALC. @V305106 01062000 ICM R7,1,DOSVOLNO LOAD PRESENT COUNT AND @V305106 01063000 LA R7,1(,R7) INCR COUNT BY 1 @V305106 01064000 STCM R7,1,DOSVOLNO OK, NOW STORE NEW COUNT @V305106 01065000 CLM R7,1,DISKLIM MAKE SURE NOT OUT OF ENTRIES @V305106 01066000 BL LTLIM WARN IF = 9 (POSSIBLE MODES)@V305106 01067000 SPACE 1 01068000 TM MISCFLAG,PRINT SUPPRESS ERRMSG? @V305106 01069000 BZ UCATCHK YES @V305106 01070000 DMSERR NUM=320,LET=I,TEXT='MAXIMUM NUMBER OF DISK ENTRIES RECO*01071000 RDED' @V305106 01072000 B UCATCHK CONTINUE WITH NEXT OPTION @V305106 01073000 SPACE 1 01074000 LTLIM C R6,ZERO END OF LINE? @V305106 01075000 BE RDLINE IF SO, READ ANOTHER LINE @V305106 01076000 B NEXTSPEC IF NOT, GET NEXT GROUP @V305106 01077000 EJECT 01078000 *********************************************************************** 01079000 * 01080000 * 'RDTERM' SUBROUTINE READS A LINE FROM THE CONSOLE. 01081000 * IF IT IS BEING CALLED FOR THE FIRST TIME, IT GETS 01082000 * FREE STORAGE FOR THE LINE BUFFER. WHEN A NULL LINE 01083000 * IS READ, RDTERM RETURNS THE FREE STORAGE USED FOR THE BUFFER. 01084000 * 01085000 * EXIT - R0 CONTAINS THE LENGTH OF THE LINE READ 01086000 * R2 CONTAINS THE ADDRESS OF THE LINE 01087000 * 01088000 * REGISTER USAGE - 1,2 01089000 * 01090000 * CALLED BY - 'MULT' AND 'EXTENT' OPTION PROCESSING 01091000 * 01092000 *********************************************************************** 01093000 RDTERM EQU * @V305106 01094000 XR R2,R2 @V305106 01095000 C R2,ATERMBUF IS THIS FIRST READ? @V305106 01096000 BE GETBUF IF SO, GET A CONSOLE BUFFER @V305106 01097000 L R2,ATERMBUF IF NOT, POINT TO THE BUFFER @V305106 01098000 B READ AND READ ANOTHER LINE @V305106 01099000 GETBUF DMSFREE DWORDS=17,ERR=ERR109S,TYPCALL=BALR @V305106 01100000 ST R1,ATERMBUF SAVE THE BUFFER ADDR @V305106 01101000 LR R2,R1 @V305106 01102000 READ RDTERM (R2),EDIT=UPCASE @V305106 01103000 LTR R0,R0 NULL LINE ENTERED? @V305106 01104000 BCR 7,R10 IF NOT, RETN TO CALLER IMMED@V305106 01105000 LR R1,R2 IF SO, FREE THE BUFFER @V305106 01106000 DMSFRET DWORDS=17,LOC=(1),TYPCALL=BALR @V305106 01107000 XR R0,R0 GIVE 'NULL LINE' INDICATION @V305106 01108000 BR R10 NOW RETURN TO USER @V305106 01109000 EJECT 01110000 *********************************************************************** 01111000 * 01112000 * PROCESS THE 'EXTENT' OPTION 01113000 * 01114000 *********************************************************************** 01115000 EXTENCHK EQU * @V305106 01116000 TM OPTNFLAG,XEXTENT 'EXTENT' OPTION ENTERED? @V305106 01117000 BZ UCATCHK IF NOT, TRY NEXT OPTION... @V305106 01118000 SPACE 1 01119000 TM MISCFLAG,CMSOP 'CMS' ENTERED? @V305106 01120000 BO ERR308EA SORRY, THIS IS VSAM OPTION..@V305106 01121000 MVI DOSEXTNO,ZEROEXT ZERO NO. EXTS IN NEW BLOK @V305066 01122000 LA R0,EXTNSIZE SIZE OF EXTENTS BLK IN DWRDS@V305106 01123000 DMSFREE DWORDS=(0),ERR=ERR109S,TYPCALL=BALR @V305106 01124000 LR R9,R1 KEEP EXTENTS BLOK ADDR @V305106 01125000 ST R9,EXTNSAVE AND SAVE IT FOR POSTERITY @V305106 01126000 XC 0(176,R9),0(R9) CLR BLK FOR STORING EXTENTS @V305106 01127000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 01128000 SPACE 1 01129000 DMSERR LET=R,NUM=331,TEXT='ENTER EXTENT SPECIFICATIONS: ',DOT=*01130000 NO @V305106 01131000 SPACE 1 01132000 RDLINE2 EQU * LOOP TO READ LINES FROM CONS@V305106 01133000 BAL R10,RDTERM READ A LINE FROM CONSOLE @V305106 01134000 LTR R0,R0 NULL LINE ENTERED? @V305106 01135000 BNZ LINECHK2 NO, VALIDATE AND STORE DATA @V305106 01136000 L R9,EXTNSAVE YES, LOAD THE BLOK ADDR @V305106 01137000 CLI 0(R9),FIRST0 IS FIRST POSITION '0' @V305066 01138000 BNE UCATCHK NO, JUST END OF INPUT..CONT @V305106 01139000 SR R5,R5 YES, NO DATA ENTRD(1ST LINE NULL)@V305106 01140000 B ERR304E ERROR... @V305106 01141000 EJECT 01142000 LINECHK2 EQU * CHEK LINE FOR VALID DATA ENTRIES @V305106 01143000 * R9 -> EXTENTS BLOK 01144000 LR R8,R2 R8 -> CONSOLE DATA LINE @V305106 01145000 LR R6,R0 R6 = CONSOLE LINE LENGTH @V305106 01146000 MVI BRSWITCH+1,ALTSW INIT ALTERNATING SWITCH @V305106 01147000 SCANA CLI 0(R8),BLANK CURRENT CHAR BLANK? @V305106 01148000 BNE TRKCHEK IF NOT, IT'S STARTING TRACK @V305106 01149000 EXSTART EQU * @V305106 01150000 LA R8,1(,R8) IF SO, LOOK AT NEXT CHAR @V305106 01151000 BCT R6,SCANA CHEK FOR END OF LINE @V305106 01152000 B RDLINE2 IF END, READ ANOTHER LINE...@V305106 01153000 TRKCHEK EQU * START CHEK FOR TRACK INFO @V305106 01154000 BAL R10,CONVERT CNVRT CHARS TO BINARY VALUE @V305106 01155000 LA R8,0(R5,R8) BUMP LINE PTR NO.CHARS(R5) @V305106 01156000 SR R6,R5 AND DON'T FORGET LINE COUNT @V305106 01157000 XI BRSWITCH+1,ALTSW ALTERNATING SWITCH... @V305066 01158000 BRSWITCH BC 15,NUMTRKS BRANCH ON EVEN TURNS @V305106 01159000 C R6,ZERO FIRST NUMBER, END OF LINE? @V305106 01160000 BE ERR305E ERROR 2ND NUMBER MISSING @V305106 01161000 ST R3,3(R9) IF NOT, STOR STARTNG TRK NO.@V305106 01162000 SCANB CLI 0(R8),BLANK NEXT CHAR BLANK? @V305106 01163000 BNE TRKCHEK IF NOT, GO CONVERT NO.TRACKS@V305106 01164000 LA R8,1(,R8) IF SO, NEXT CHAR, PLEASE @V305106 01165000 BCT R6,SCANB CHEK END OF LINE ALSO @V305106 01166000 B ERR305E ERROR IF NO 2ND NUMBER @V305106 01167000 NUMTRKS ST R3,7(R9) STORE NO.TRACKS IN BLOK @V305106 01168000 C R6,ZERO WAS IT LAST ENTRY ON LINE? @V305106 01169000 BE DEFSET IF SO, DEFAULT MODE SETTING @V305106 01170000 SCANC CLI 0(R8),BLANK IF NOT, CHEK FOR NEXT CHAR @V305106 01171000 BNE COMCHK HIT, COULD BE COMMA @V305106 01172000 LA R8,1(,R8) NEXT CHAR, PLEASE @V305106 01173000 BCT R6,SCANC AND LINE COUNT @V305106 01174000 B DEFSET USE DEFAULT MODE, ETC. @V305106 01175000 COMCHK CLI 0(R8),COMMA IS IT A COMMA? @V305066 01176000 BNE MODECHK2 IF NOT COMMA, MUST BE MODE..@V305106 01177000 DEFSET EQU * DEFAULT THE MODE AND SYSXXX @V305106 01178000 MVC 0(1,R9),DOSDSMD USE MODE FROM DOSCB @V305106 01179000 TM DOSFLAGS,DOSMODE DOS USER? @V305106 01180000 BZ EFINISH NO, DON'T WORRY ABOUT SYSXXX@V305106 01181000 MVC 1(2,R9),DOSYSXXX IF DOS, USE SYSXXX FRM DOSCB@V305106 01182000 B EFINISH GO CLEANUP A BIT... @V305106 01183000 MODECHK2 EQU * VALIDATE MODE LETTER @V305106 01184000 CLI 0(R8),MODEA CHECK LOW RANGE @V305066 01185000 BL ERR48E ERROR IF LESS @V305106 01186000 CLI 0(R8),MODEZ ... @V305066 01187000 BE MODEOK2 O.K. IF 'Z' @V305106 01188000 CLI 0(R8),MODEY ... @V305066 01189000 BE MODEOK2 O.K. IF 'Y' @V305106 01190000 CLI 0(R8),MODEG CHECK HIGH RANGE @V305066 01191000 BH ERR48E ERROR IF HIGH @V305106 01192000 MODEOK2 EQU * VALID CMS DISK MODE @V305106 01193000 MVC STATMD(1),0(R8) MAKE SURE DISK IS ACCESSED @V305106 01194000 BAL R10,STATSUB BY USING 'STATE' @V305106 01195000 MVC 0(1,R9),0(R8) STOR MODE IN EXTS BLK ENTRY @V305106 01196000 TM DOSFLAGS,DOSMODE+DOSSVC DOS USER? @VA11810 01197000 BNO NXENTRY2 NO, GET NEXT DISK ENTRY @VA11810 01198000 DOSUSER2 EQU * YES, CHEK FOR 'SYSXXX' ENTRY@V305106 01199000 LA R8,1(,R8) LOOK AT NEXT CHAR @V305106 01200000 BCT R6,SCAND CHEK FOR END OF LINE @V305106 01201000 B ERR302E ERROR IF NO 'SYSXXX' ENTERED@V305106 01202000 SCAND CLI 0(R8),BLANK CURRENT CHAR BLANK @V305066 01203000 BE DOSUSER2 GET NEXT CHAR IF SO @V305106 01204000 CLC 0(3,R8),SYSXXX IF NOT, MUST BE 'SYS' @V305106 01205000 BNE ERR302E ERROR IF NO 'SYSXXX' @V305106 01206000 LR R13,R8 POINT AT ENTRY AND @V305106 01207000 BAL R10,SYSCODE VALIDATE 'XXX' AS LOGL UNIT @V305106 01208000 IC R1,0(R9) MAKE SURE DISK WAS 'ASSGN'D @V305106 01209000 BAL R10,UNITEST DO IT @V305106 01210000 MVC 1(2,R9),SAVEUNIT COMPLETE THE EXTENTS ENTRY @V305106 01211000 LA R8,6(,R8) POINT PAST 'SYSXXX' ENTRY @V305106 01212000 SH R6,=H'5' AND CHEK FOR END OF LINE @V305106 01213000 BM ERR302E JUST IN CASE... @V305106 01214000 BCT R6,SCANE @V305106 01215000 B EFINISH CLEANUP AND GET NEW LINE @V305106 01216000 SCANE CLI 0(R8),COMMA END OF ENTRY ? @V305066 01217000 BE EFINISH IF SO, GET NXT ENTRY ON LINE@V305106 01218000 CLI 0(R8),BLANK CURRENT CHAR BLANK? @V305106 01219000 BE NXENTRY2 YES, CONTINUE @V305106 01220000 LR R5,R8 POINT TO JUNK @V305106 01221000 B ERR70E STRANGE DATA @V305106 01222000 NXENTRY2 EQU * @V305106 01223000 LA R8,1(,R8) GET NEXT CHAR IN LINE @V305106 01224000 BCT R6,SCANE CHEK FOR END OF LINE @V305106 01225000 EFINISH EQU * COME HERE AFTER EACH VALID ENTRY @V305106 01226000 LA R9,11(,R9) SKIP TO NEXT ENTRY IN BLOK @V305106 01227000 SR R7,R7 CLEAR FOR COUNT CALC. @V305106 01228000 ICM R7,1,DOSEXTNO LOAD THE PRESENT COUNT AND @V305106 01229000 LA R7,1(,R7) INCR COUNT BY 1 @V305106 01230000 STCM R7,1,DOSEXTNO OK, NOW STORE NEW COUNT @V305106 01231000 CLM R7,1,EXTNLIM MAKE SURE NOT OUT OF ENTRIES@V305106 01232000 BL LTLIM2 WARN IF=16 (POSS. EXTENTS) @V305106 01233000 SPACE 1 01234000 TM MISCFLAG,PRINT SUPPRESS ERRMSG? @V305106 01235000 BZ UCATCHK YES @V305106 01236000 DMSERR NUM=321,LET=I,TEXT='MAXIMUM NUMBER OF EXTENTS RECORDED' 01237000 B UCATCHK CONTINUE WITH NEXT OPTION @V305106 01238000 SPACE 1 01239000 LTLIM2 C R6,ZERO END OF LINE? @V305106 01240000 BE RDLINE2 IF SO, READ ANOTHER LINE @V305106 01241000 B EXSTART IF NOT, GET NEXT GROUP @V305106 01242000 EJECT 01243000 *********************************************************************** 01244000 * 01245000 * 'CONVERT' SUBROUTINE CONVERTS EBCDIC CHARACTERS TO BINARY 01246000 * VALUE. IT CHECKS THE NUMERIC VALIDITY AND SIZE OF THE ENTRY. 01247000 * 01248000 * - THE VALUE IS CHECKED FOR A MAXIMUM NUMBER OF 10 DIGITS. 01249000 * - A COUNT OF THE CHARACTERS ENTERED IS DETERMINED. 01250000 * - THEY ARE CHECKED TO MAKE SURE THEY ARE NUMERICS. 01251000 * - THE CHARACTERS ARE THEN PACKED AND CHECKED FOR A MAXIMUM 01252000 * - VALUE OF 2**31-1. 01253000 * - THE PACKED VALUE IS THEN CONVERTED TO BINARY. 01254000 * 01255000 * ENTRY - R8 CONTAINS ADDRESS OF THE EBCDIC VALUE 01256000 * 01257000 * EXIT - R3 CONTAINS THE EQUIVALENT BINARY VALUE 01258000 * R5 CONTAINS CHARACTER COUNT (MAYBE USEFUL TO CALLER) 01259000 * 01260000 * REGISTER USAGE - 3,5 01261000 * 01262000 * CALLED BY - 'EXTENT' AND 'BUFSP' OPTION PROCESSING 01263000 * 01264000 *********************************************************************** 01265000 CONVERT EQU * @V305106 01266000 LR R14,R8 SAVE POINTER TO EBCDIC VALUE @VM03191 01267000 LA R5,CHARMAX+1 SET R5 WITH MAX CHAR COUNT+1 @V305106 01268000 LA R3,CHARMAX SET R3 TO MAX CHAR COUNT @V305106 01269000 CONV1 CLI 1(R8),BLANK 1ST BLANK ? @V305106 01270000 BE CONV2 YES, CONTINUE @V305106 01271000 CLI 1(R8),COMMA LOOK AHEAD FOR POSS. COMMA @V305106 01272000 BE CONV2 YES, CONTINUE @V305106 01273000 CLI 1(R8),ENDLINE END OF CONSOLE LINE? @V305066 01274000 BE CONV2 YES, CONTINUE PROCESSING @V305106 01275000 CLI 1(R8),FENCE END OF PLIST ? @VM03191 01276000 BE CONV2 YES, CONTINUE PROCESSING @VM03191 01277000 LA R8,1(,R8) UPDATE TO NEXT CHARACTER @V305106 01278000 BCT R3,CONV1 DO THIS MAX-1 TIMES @V305106 01279000 B ERR304E TOO MANY CHARS, ERROR EXIT @V305106 01280000 * 01281000 * NOW CHECK TO MAKE SURE ALL CHARACTERS ENTERED ARE NUMERICS. 01282000 * R8 NOW POINTS TO THE LAST CHARACTER (DIGIT). 01283000 CONV2 SR R5,R3 GET COUNT OF CHAR IN R5 @V305106 01284000 LR R3,R5 IN R2 ALSO @V305106 01285000 CONV3 CLI 0(R8),CHAR0 ? IS IT NUMERIC ? @V305066 01286000 BL ERR304E NO, ERROR EXIT @V305106 01287000 CLI 0(R8),CHAR9 ... @V305066 01288000 BH ERR304E DITTO @V305106 01289000 BCTR R8,R0 BACK UP TO PREVIOUS CHAR @V305106 01290000 BCT R3,CONV3 DO THIS FOR EACH CHARACTER @V305106 01291000 * 01292000 * R8 NOW POINTS TO THE CHARACTER BEFORE THE FIRST ONE. 01293000 LA R8,1(,R8) POINT R8 TO 1ST CHAR, AND @V305106 01294000 LR R3,R5 SAVE CHAR COUNT FOR RETURN @V305106 01295000 BCTR R3,R0 REDUCE PACK COUNT FOR EXECUTE@V305106 01296000 EX R3,EXPACK PACK THE NUMERICS IN THE R8 @V305106 01297000 CP PACKFLD(8),NUMAX COMPARE IT TO THE MAX ALLOWED@V305106 01298000 BH ERR304E TOO BIG, TELL THE USER @V305106 01299000 CVB R3,PACKFLD CONVERT THIS TO BINARY @V305106 01300000 BR R10 RETURN TO CALLER @V305106 01301000 EXPACK PACK PACKFLD(8),0(,R8) PACK THE CHAR VALUE @V305106 01302000 SPACE 1 01303000 *********************************************************************** 01304000 * 01305000 * PROCESS THE 'CAT' OPTION 01306000 * 01307000 *********************************************************************** 01308000 UCATCHK EQU * @V305106 01309000 TM OPTNFLAG,XUCAT 'CAT' OPTION ENTERED? @V305106 01310000 BZ VSAMCHK NO, GO CHEK NEXT OPTION... @V305106 01311000 SPACE 1 01312000 TM MISCFLAG,CMSOP 'CMS' ENTERED? @V305106 01313000 BO ERR308EA SORRY, THIS IS VSAM OPTION..@V305106 01314000 XR R2,R2 @V305106 01315000 IC R2,UCAT+10 GET PLIST OFFSET FOR UCNAME @V305106 01316000 SLL R2,3 MULT OFFSET BY 8 (CMS TOKEN SIZE)@V305106 01317000 A R2,OPSTART ADD OPTN START,PT TO USERCAT NAME@V305106 01318000 LH R1,DOSNUM GET NO.DOSCBS FOR CHAIN SCAN@V305106 01319000 LTR R1,R1 ANY DOSCBS DEFINED? @V305106 01320000 BZ ERR307E NO CATALOG DEFINED....ERROR @V305106 01321000 DROP R4 @V305106 01322000 USING DOSSECT,R3 @V305106 01323000 L R3,DOSFIRST START SEARCH W/CHAIN ANCHOR @V305106 01324000 UCLOOP CLC DOSDD(7),0(R2) DDNAME MATCH? @V305106 01325000 BNE NXTDCB IF NOT, KEEP TRYING... @V305106 01326000 OI DOSINIT,DOSDDCAT IF FOUND, MARK AS CATALOG @V305106 01327000 B UCATOK WE'RE OK...CONTINUE @V305106 01328000 NXTDCB L R3,DOSNEXT NO, TRY NEXT DOSCB @V305106 01329000 BCT R1,UCLOOP KEEP GOING TILL WE RUN OUT..@V305106 01330000 DROP R3 @V305106 01331000 USING DOSSECT,R4 @V305106 01332000 B ERR307E DOESN'T EXIST...ERROR @V305106 01333000 SPACE 1 01334000 UCATOK MVC DOSUCNAM(8),0(R2) IT EXISTS,STOR UCNAME IN DOSCB@V305106 01335000 OI DOSINIT,DOSUCAT+DOSDDCAT MARK AS USER CATLG+USER@V305106 01336000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 01337000 SPACE 2 01338000 *********************************************************************** 01339000 * 01340000 * PROCESS THE 'VSAM' OPTION 01341000 * 01342000 *********************************************************************** 01343000 VSAMCHK EQU * @V305106 01344000 TM OPTNFLAG,XVSAM 'VSAM' OPTION ENTERED? @V305106 01345000 BZ EXIT NO, GO FINISH UP... @V305106 01346000 SPACE 1 01347000 TM MISCFLAG,CMSOP 'CMS' ENTERED? @V305106 01348000 BO ERR308EA SORRY, THS IS VSAM OPTION...@V305106 01349000 MVI DOSTYPE,VSAMDS MARK AS VSAM DATASET @V305106 01350000 B EXIT @V305106 01351000 EJECT 01352000 *********************************************************************** 01353000 * 01354000 * EXIT PROCESSING 01355000 * 01356000 *********************************************************************** 01357000 SPACE 2 01358000 EXIT EQU * @V305006 01359000 ST R15,SAVE15 SAVE RETURN CODE @V305006 01360000 TM MISCFLAG,NEW+OLD DID WE PROC BLOCK(OLD OR NEW) @V305006 01361000 BZ RETURN NO-EARLY ERRS, NO CLEANUP NEEDED @V305006 01362000 LTR R15,R15 ANY ERRORS? @V305006 01363000 BNZ ERRORS IF SO, SPECIAL CLEANUP CODE @V305006 01364000 TM MISCFLAG,NEW NEW DOSCB CREATED? @V305006 01365000 BZ OLDDCB IF NOT, WE CHANGED AN OLDIE @V305006 01366000 SPACE 1 01367000 *********************************************************************** 01368000 * NEW DOSCB... NO ERRORS 01369000 *********************************************************************** 01370000 L R1,MULTSAVE DID WE BLD NEW MULTIVOL BLK?@V305106 01371000 LTR R1,R1 @V305106 01372000 BZ EXTNEW IF NOT, CHEK EXTENT BLOK @V305106 01373000 ST R1,DOSVOLTB IF SO, SAVE A(MULTBLOK) IN DOSCB @V305106 01374000 EXTNEW L R1,EXTNSAVE DID WE BLD NEW EXTENTS BLK? @V305106 01375000 LTR R1,R1 @V305106 01376000 BZ DSNNEW IF NOT, CHEK FOR DSN BLOK @V305106 01377000 ST R1,DOSEXTTB IF SO, SAVE A(EXTBLOK) IN DOSCB @V305106 01378000 DSNNEW L R1,DSNSAVE DID WE BUILD A DATASETNAME BLOK? @V305006 01379000 LTR R1,R1 @V305006 01380000 BZ ATTACH IF NOT, ALL DONE, ATTACH NEW DOSC@V305006 01381000 ST R1,DOSOSDSN IF SO, SAVE A(DSNBLOK) IN DOSCB @V305006 01382000 ATTACH EQU * ATTACH NEW DOSCB TO CHAIN @V305006 01383000 L R2,PREVENT GET ADDR OF LAST ENTRY @V305006 01384000 LTR R2,R2 IS THIS FIRST ENTRY? @V305006 01385000 BNZ LINK NO, GO STORE IN PREV DOSCB @V305006 01386000 LA R2,DOSFIRST YES,USE THIS DOSCB AS ANCHOR@V305006 01387000 LINK STCM R4,BIN0111,1(R2) STOR 3-BYTE ADDR IN PREV DOSCB @V305006 01388000 * HIGH ORDER BYTE LEFT UNCHANGED 01389000 LH R2,DOSNUM GET COUNT OF ENTRIES @V305006 01390000 LA R2,1(,R2) ADD ONE TO IT, AND @V305006 01391000 STH R2,DOSNUM PUT IT BACK IN DOSCB HEADER @V305006 01392000 SPACE 1 01393000 RETURN EQU * RESTOR REGS AND RETN TO USER@V305006 01394000 L R15,SAVE15 RESTORE ERRCODE REG @V305006 01395000 L R14,SAVE14 RESTORE RETURN REG. @V305006 01396000 BR R14 RETURN @V305006 01397000 EJECT 01398000 *********************************************************************** 01399000 OLDDCB EQU * OLD DOSCB... NO ERRORS @V305006 01400000 *********************************************************************** 01401000 LA R3,OLDENTRY USE FOR MAPPING OLD COPY OF DOSCB@V305106 01402000 L R2,MULTSAVE DID WE BUILD NEW MULTBLOK? @V305106 01403000 LTR R2,R2 @V305106 01404000 BZ EXTOLD IF NOT, CHEK EXTENTS BLOK @V305106 01405000 LA R9,SAVMULT IF SO, CHEK FOR OLD MULTBLOK@V305106 01406000 DROP R4 @V305106 01407000 USING DOSSECT,R3 @V305106 01408000 OLDMSUB L R1,DOSVOLTB DID OLD COPY DOSCB HAVE MULTBLOK?@V305106 01409000 LTR R1,R1 @V305106 01410000 BZR R9 IF NOT, RETURN TO CALLER @V305106 01411000 DROP R3 @V305106 01412000 USING DOSSECT,R4 @V305106 01413000 LA R0,MULTSIZE GET SIZE OF MULTBLOK IN DWORDS @V305106 01414000 BAL R10,FRET FRET THE OLD MULTBLOK @V305106 01415000 BR R9 RETURN TO CALLER (OR DROP THRU) @V305106 01416000 SAVMULT ST R2,DOSVOLTB NOW SAVE A(NEW MULTBLOK) IN DOSCB@V305106 01417000 EXTOLD L R2,EXTNSAVE DID WE BUILD NEW EXTENTS BLOK? @V305106 01418000 LTR R2,R2 @V305106 01419000 BZ DSNOLD IF NOT, CHEK FOR NEW DATASETNAME @V305106 01420000 LA R9,SAVEXT IF SO, CHEK FOR OLD DSNAME BLOK @V305106 01421000 DROP R4 @V305106 01422000 USING DOSSECT,R3 @V305106 01423000 OLDESUB L R1,DOSEXTTB DID OLD COPY DOSCB HAVE EXTBLOK? @V305106 01424000 LTR R1,R1 @V305106 01425000 BZR R9 IF NOT, RETURN TO CALLER @V305106 01426000 LA R0,EXTNSIZE IF SO, GET SIZE OF EXTBLOK @V305106 01427000 DROP R3 @V305106 01428000 USING DOSSECT,R4 @V305106 01429000 BAL R10,FRET AND FRET THE OLD EXTBLOK @V305106 01430000 BR R9 RETURN TO CALLER (OR DROP THRU) @V305106 01431000 SAVEXT ST R2,DOSEXTTB NOW SAVE A(NEW EXTBLOK) IN DOSCB @V305106 01432000 DSNOLD L R2,DSNSAVE DID WE BUILD NEW DSNAME BLOK? @V305006 01433000 LTR R2,R2 @V305006 01434000 BZ RETURN IF NOT, WE'RE ALL THRU, RETURN @V305006 01435000 LA R9,SAVDSN IF SO, CHEK OLD COPY FOR DSNBLOK @V305006 01436000 DROP R4 @V305006 01437000 USING DOSSECT,R3 @V305006 01438000 OLDDSUB L R1,DOSOSDSN DOES OLD DSNBLOK EXIST? @V305006 01439000 LTR R1,R1 @V305006 01440000 BZR R9 IF NOT, RETURN TO CALLER @V305006 01441000 LA R0,DSNSIZE DSNBLOK SIZE IN DOUBLEWORDS @V305066 01442000 DROP R3 @V305006 01443000 USING DOSSECT,R4 @V305006 01444000 BAL R10,FRET AND FRET THE OLD DSNBLOK @V305006 01445000 BR R9 RETURN TO CALLER (OR DROP THRU) @V305006 01446000 SAVDSN ST R2,DOSOSDSN NOW SAVE NEW DSNAME BLOK @V305006 01447000 B RETURN ALL DONE...RETURN @V305006 01448000 EJECT 01449000 *********************************************************************** 01450000 ERRORS EQU * ERROR(S)... OLD OR NEW DOSCB@V305006 01451000 *********************************************************************** 01452000 L R1,MULTSAVE GET ADDR OF NEW MULTBLOK(IF ANY) @V305106 01453000 LA R0,MULTSIZE AND ITS SIZE ... @V305106 01454000 BAL R10,FRET FRET NEW MULTBLOK (IF ANY) @V305106 01455000 EXTERR L R1,EXTNSAVE GET ADDR OF NEW EXTBLOK (IF ANY) @V305106 01456000 LA R0,EXTNSIZE AND ITS SIZE ... @V305106 01457000 BAL R10,FRET FRET NEW EXTENTS BLOK (IF ANY) @V305106 01458000 DSNERR L R1,DSNSAVE DID WE BUILD A NEW DSNAME BLOK? @V305006 01459000 LTR R1,R1 @V305006 01460000 BZ DCBFRET IF NOT, GO DOSCB FRET CHEK @V305006 01461000 LA R0,DSNSIZE GET SIZE OF DSN BLOCK @V305066 01462000 TM MISCFLAG,DSNERRS ERRORS IN DATASET NAME? @V305006 01463000 BZ DSNFRET IF NOT, JUST FRET NAME (6DWRDS) @V305006 01464000 LA R0,BUFFSIZE IF SO, FRET THE WHOLE BUFFER @V305066 01465000 DSNFRET BAL R10,FRET FRET THE NEW DSNAME BLOK... @V305006 01466000 SPACE 1 01467000 DCBFRET TM MISCFLAG,OLD DO WE HAVE A OLD(CHANGED) DOSCB? @V305006 01468000 BZ NEWDCB NO, MUST BE NEW... @V305006 01469000 MVC 0(DOSENSIZ*8,R4),OLDENTRY IF OLD, JUST RESTOR IT@V305006 01470000 B RETURN AND RETURN TO USER. @V305006 01471000 NEWDCB LA R0,DOSENSIZ GET SIZE OF DOSCB IN DWORDS @V305006 01472000 LR R1,R4 PROVIDE ADDR OF SAME AND... @V305006 01473000 BAL R10,FRET FRET THE NEW DOSCB. @V305006 01474000 B RETURN ALL DONE, RETURN. @V305006 01475000 SPACE 3 01476000 *********************************************************************** 01477000 * 01478000 * SUB-ROUTINE TO CALL DMSFRET 01479000 * 01480000 *********************************************************************** 01481000 FRET EQU * @V305006 01482000 LTR R1,R1 CK WHETHER BLOK REALLY EXISTS... @V305106 01483000 BZR R10 IF NOT, RETURN FORTHWITH TO CALLER@V305106 01484000 ST R15,SAVE15 @V305006 01485000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305006 01486000 L R15,SAVE15 @V305006 01487000 BR R10 RETURN TO INVOKER'S ADDRESS @V305006 01488000 EJECT 01489000 *********************************************************************** 01490000 * 01491000 * CONSTANTS AND WORK AREAS * 01492000 * 01493000 *********************************************************************** 01494000 SPACE 2 01495000 CONREAD DS 0D @V305006 01496000 DC CL8'CONREAD' PROMPT PLIST @V305006 01497000 DC AL1(1) @V305006 01498000 DSNBUF DC AL3(0) INPUT BUFFER @V305006 01499000 DC CL1'U' TRANSLATE TO UPPER, PAD W/BLNKS @V305006 01500000 DSNBYTE DC AL3(0) NO. OF BYTES READ @V305006 01501000 PLISTEND DC XL4'FFFFFFFF' PARAM LIST END INDICATOR. @V305006 01502000 STATLST DS 0D @V305006 01503000 DC CL8'STATE' @V305006 01504000 STATFN DC CL8' ' @V305006 01505000 DC CL8' ' @V305006 01506000 STATMD DC CL2' ' @V305006 01507000 DC CL2' ' @V305006 01508000 DC A(*-*) @V305006 01509000 SPACE 1 01510000 SAVE14 DS F @V305006 01511000 ZERO DC F'0' @V305006 01512000 FILE DC CL8'FILE' @V305006 01513000 DISK DC CL8'DISK' @V305006 01514000 CMS DC CL8'CMS' @V305006 01515000 NONCMS DC CL8'NON-CMS' @V305006 01516000 DUMMY DC CL8'DUMMY' @V305006 01517000 CLEAR DC CL8'CLEAR' @V305106 01518000 JOB DC CL8'JOB' @V305106 01519000 MASTER DC CL8'MASTER' @V305106 01520000 JCAT DC CL8'IJSYSUC' NAME OF DOS VSAM JOBCAT @V305106 01521000 MCAT DC CL8'IJSYSCT' NAME OF DOS VSAM MASTER CATALOG @V305106 01522000 PACKFLD DS D @V305006 01523000 NUMAX DC PL8'2147483647' 2**31-1 @V305006 01524000 SAVESYS DC CL8'SYS___ ' SYSXXX ENTRY WITH 'XXX' FILLED-IN@V305106 01525000 DISKLIM DC X'09' MAX 9 CMS MODES @V305006 01526000 EXTNLIM DC X'10' MAX 16 EXTENTS @V305006 01527000 SPACE 1 01528000 BLANK EQU C' ' @V305006 01529000 LFTPAREN EQU C'(' @V305066 01530000 RTPAREN EQU C')' @V305066 01531000 CHARAST EQU C'*' @V305066 01532000 MODE1 EQU C'1' @V305066 01533000 DECPT EQU C'.' @V305066 01534000 BIN0001 EQU B'0001' @V305066 01535000 BIN0111 EQU B'0111' @V305066 01536000 FRETWDS EQU 11 @V305066 01537000 ZEROVOL EQU X'00' @V305066 01538000 FIRST0 EQU X'00' @V305066 01539000 MODEA EQU C'A' @V305066 01540000 MODEZ EQU C'Z' @V305066 01541000 MODEY EQU C'Y' @V305066 01542000 MODEG EQU C'G' @V305066 01543000 ZEROEXT EQU X'00' @V305066 01544000 ENDLINE EQU X'00' @V305066 01545000 CHAR0 EQU C'0' @V305066 01546000 CHAR9 EQU C'9' @V305066 01547000 DSNSIZE EQU 6 @V305066 01548000 BUFFSIZE EQU 17 @V305066 01549000 FENCE EQU X'FF' FENCE CODE @VM03191 01550000 PROG EQU X'01' @V305006 01551000 SYSLOG EQU X'00' @V305006 01552000 IGNORE EQU X'FE' UNIT CODE FOR 'IGN' ASSGNMT @V305006 01553000 MULTSIZE EQU 4 SIZE OF MULTIVOL BLOK IN DWORDS @V305006 01554000 EXTNSIZE EQU 22 SIZE OF EXTENTS BLOK IN DWORDS @V305006 01555000 CHARMAX EQU 10 @V305006 01556000 VSAMDS EQU C'A' VSAM LABEL RECORD CODE @V305106 01557000 SAMDS EQU C'S' DITTO FOR SEQUENTIAL (SAM) @V305106 01558000 MULTLEN EQU 3 @V305066 01559000 EXTLEN EQU 11 @V305066 01560000 ONE EQU 1 @V305066 01561000 COMMA EQU C',' @V305066 01562000 ALTSW EQU X'F0' @V305066 01563000 EJECT 01564000 * 01565000 * THIS TABLE CONTAINS ALL VALID OPTIONS, KEYWORD & NON-KEYWORD. 01566000 * EACH TABLE ENTRY CONSISTS OF THE VALID OPTION NAME, 01567000 * AN OPTION FLAG WHICH SETS 'OPTNFLAG' FOR PROCESSING, 01568000 * A FLAG BYTE, A PARAMETER OFFSET BYTE, AND THE ADDRESS 01569000 * OF A CONFLICTING OPTION, IF ANY. 01570000 * 01571000 * THE HIGH-ORDER FOUR BITS OF THE FLAG BYTE ARE 01572000 * SET ON WHEN THE OPTION IS FOUND IN THE COMMAND LINE. 01573000 * THIS PART OF THE FLAG IS CHECKED WHEN THE CONFLICTING 01574000 * OPTION IS FOUND IN THE COMMAND LINE. 01575000 * THE LOW ORDER FOUR BITS ARE INITIALIZED ON WHEN THE OPTION 01576000 * INCLUDES A PARAMETER WHICH ALSO MUST BE PROCESSED. 01577000 * 01578000 * IF AN OPTION IS FOUND IN THE PLIST AND IT TAKES A 01579000 * PARAMETER ('PARM' FIELD IN FLAG BYTE), DLBL STORES 01580000 * THE PLIST OFFSET OF THE OPTION'S PARAMETER IN THE OFFSET 01581000 * FIELD IN 'OPTAB' TO FACILITATE OPTION PROCESSING. 01582000 * 01583000 OPTAB DS 0D @V305006 01584000 PERM DC CL8'PERM',X'40',X'00',AL1(0),AL3(0) @V305006 01585000 CHANGE DC CL8'CHANGE',X'00',X'00',AL1(0),AL3(NOCHANGE) @V305006 01586000 NOCHANGE DC CL8'NOCHANGE',X'80',X'00',AL1(0),AL3(CHANGE) @V305006 01587000 SYSXXX DC CL8'SYS000',X'20',X'00',AL1(0),AL3(0) @V305106 01588000 BUFSP DC CL8'BUFSP',X'10',X'0F',AL1(0),AL3(0) @V305106 01589000 UCAT DC CL8'CAT',X'08',X'0F',AL1(0),AL3(0) @V305106 01590000 MULT DC CL8'MULT',X'04',X'00',AL1(0),AL3(EXTENT) @V305106 01591000 EXTENT DC CL8'EXTENT',X'02',X'00',AL1(0),AL3(MULT) @V305106 01592000 VSAM DC CL8'VSAM',X'01',X'00',AL1(0),AL3(0) @V305106 01593000 TABEND EQU * @V305006 01594000 SPACE 3 01595000 UNITTAB DC CL3'RDR',BL1'00000000' @V305006 01596000 DC CL3'IPT',BL1'00000001' @V305006 01597000 DC CL3'PCH',BL1'00000010' @V305006 01598000 DC CL3'LST',BL1'00000011' @V305006 01599000 DC CL3'LOG',BL1'00000100' @V305006 01600000 DC CL3'LNK',BL1'00000101' @V305006 01601000 DC CL3'RES',BL1'00000110' @V305006 01602000 DC CL3'SLB',BL1'00000111' @V305006 01603000 DC CL3'RLB',BL1'00001000' @V305006 01604000 DC CL3'XXX',BL1'00001001' (FILLER) @VA05247 01605000 DC CL3'XXX',BL1'00001010' (FILLER) @VA05247 01606000 DC CL3'CLB',BL1'00001011' @V305006 01607000 DC CL3'XXX',BL1'00001100' (FILLER) @VA05247 01608000 DC CL3'CAT',BL1'00001101' @V305006 01609000 UNITEND EQU (*-UNITTAB)/4 @V305006 01610000 EJECT 01611000 CLEARBEG EQU * THIS IS THE BEGIN ADDR OF FLAGS @V305006 01612000 * & FIELDS THAT ARE CLEARED BY 'XC' AT START OF PROGRAM. 01613000 * KEEP IN ORDER AND ADD FIELDS THAT NEED SAME TREATMENT. 01614000 * 01615000 * FOLLOWING FLAG CORRESPONDS TO FLAG BYTE IN OPTION TABLE 01616000 * 01617000 PARMFLAG DC X'00' @V305006 01618000 PARM EQU X'0F' PREVIOUS OPTION HAS A PARAMETER @V305006 01619000 FOUND EQU X'F0' OPTION FOUND IN COMMAND LINE @V305006 01620000 * 01621000 * THE FOLLOWING FLAG CORRESPONDS TO OPTION FLAG IN OPTAB 01622000 * 01623000 OPTNFLAG DC X'00' FLG SHOWS WHICH OPTIONS ENTERED @V305006 01624000 XNOCHNGE EQU X'80' @V305006 01625000 XPERM EQU X'40' @V305006 01626000 XSYSXXX EQU X'20' @V305006 01627000 XBUFSP EQU X'10' @V305006 01628000 XUCAT EQU X'08' @V305006 01629000 XMULT EQU X'04' @V305006 01630000 XEXTENT EQU X'02' @V305006 01631000 XVSAM EQU X'01' @V305106 01632000 * 01633000 MISCFLAG DC X'00' @V305006 01634000 OLD EQU X'40' ON IF DOSCB IS OLD (TO BE MOD'FD)@V305006 01635000 NEW EQU X'80' ON IF DOSCB IS NEW @V305006 01636000 DSNOP EQU X'20' ON IF 'DSN' SPEC NONCMS DATASET @V305006 01637000 CMSOP EQU X'10' ON IF 'CMS' ENTRD FOR CMS DATASET@V305006 01638000 DSNERRS EQU X'08' ON IF FULL DSN FUFF SHLD BE FRET @V305006 01639000 PRINT EQU X'04' ON IF ERRMSGS ARE PRINTED @V305006 01640000 XFOUND EQU X'02' ON IF EXT OR MULT BLOK FOUND@VA05247 01641000 SPACE 1 01642000 ATERMBUF DS A ADDRESS OF CONSOLE BUFFER @V305106 01643000 MULTSAVE DS A ADDRESS OF MULTIVOL BLOK @V305106 01644000 EXTNSAVE DS A ADDRESS OF EXTENTS BLOK @V305106 01645000 DSNSAVE DS A ADDRESS OF DATASET NAME BLOK@V305106 01646000 PREVENT DS A PTR TO PREVIOUS DOSCB IN CHAIN @V305106 01647000 SPACE 1 01648000 SAVE15 DS F SAVE GR 15 BEFORE DMSFRET CALL. @V305006 01649000 OPSTART DS F SAVE START OF OPTIONS PTR @V305006 01650000 SAVEUNIT DS H DOS LOGICAL UNIT CODE (HEX) @V305006 01651000 SPACE 2 01652000 CLEAREND EQU * END ADDR OF REUSABLE FIELDS @V305006 01653000 * INSERT ALL REUSABLE FIELDS ABOVE THIS LABEL 01654000 EJECT 01655000 LTORG @V305006 01656000 DOSCB @V305006 01657000 DMSDLB CSECT @V305006 01658000 OLDENTRY DC (DOSEND-DOSSECT)X'DD' SAVEAREA FOR EXISTNG DOSCB@V305006 01659000 SPACE 1 01660000 OSTBL DC 256X'00' TRANSLATE TBL FOR DSNAME @V305006 01661000 ORG OSTBL+C'.' @V305006 01662000 DC X'01' @V305006 01663000 ORG OSTBL+256 @V305006 01664000 EJECT 01665000 *********************************************************************** 01666000 * 01667000 * ERROR MESSAGES 01668000 * 01669000 *********************************************************************** 01670000 ERR3EA LR R5,R13 @V305006 01671000 ERR3E EQU * @V305006 01672000 DMSERR NUM=3,LET=E,SUB=(CHARA,(R5)),TEXT='INVALID OPTION ''...*01673000 .....''' @V305006 01674000 LA R15,24 RETURN CODE = 24 @V305006 01675000 B EXIT EXIT @V305006 01676000 SPACE 2 01677000 ERR29E EQU * @V305106 01678000 LA R2,8 BACK-UP R13 TO POINT AT @VM03130 01679000 SR R13,R2 OPTION WITH NO PARAMETER. @VM03130 01680000 DMSERR TEXT='NO ''........'' SPECIFIED',NUM=5,LET=E, @VM03130*01681000 SUB=(CHARA,(R13)) @VM03130 01682000 LA R15,24 RETURN CODE = 24 @V305006 01683000 B EXIT @V305006 01684000 EJECT 01685000 ERR65E EQU * @V305006 01686000 CLC 0(3,R7),=CL3'SYS' IS THIS SYSXXX OPTION ? @V305006 01687000 BNE ERR65 NO, CONTINUE @V305006 01688000 MVC 3(3,R7),=CL3'XXX' MAKE OPTION SYSXXX @V305006 01689000 ERR65 EQU * @V305006 01690000 DMSERR NUM=65,LET=E,SUB=(CHARA,(R7)),TEXT='''........'' OPTION*01691000 SPECIFIED TWICE' @V305006 01692000 LA R15,24 RETURN CODE = 24 @V305006 01693000 B EXIT EXIT @V305006 01694000 SPACE 2 01695000 ERR66E EQU * @V305006 01696000 DMSERR NUM=66,LET=E,SUB=(CHARA,(R2),CHARA,(R7)),TEXT='''......*01697000 ..'' AND ''........'' ARE CONFLICTING OPTIONS',RENT=NO 01698000 LA R15,24 RETURN CODE = 24 @V305006 01699000 B EXIT EXIT @V305006 01700000 EJECT 01701000 ERR23E EQU * @V305006 01702000 DMSERR NUM=23,LET=E,TEXT='NO FILETYPE SPECIFIED' @V305006 01703000 LA R15,24 RETURN CODE = 24 @V305006 01704000 B EXIT EXIT @V305006 01705000 SPACE 1 01706000 ERR50E EQU * @V305006 01707000 DMSERR NUM=50,LET=E,TEXT='PARAMETER MISSING AFTER DDNAME' 01708000 LA R15,24 RETURN CODE = 24 @V305006 01709000 B EXIT EXIT @V305006 01710000 SPACE 2 01711000 ERR70EB LR R5,R9 POINT AT CORRECT PARM @V305006 01712000 ERR70E EQU * @V305006 01713000 DMSERR NUM=70,LET=E,SUB=(CHARA,(R5)),TEXT='INVALID PARAMETER '*01714000 '........''' @V305006 01715000 LA R15,24 RETURN CODE = 24 @V305006 01716000 B EXIT EXIT @V305006 01717000 EJECT 01718000 ERR322I TM MISCFLAG,PRINT SUPPRESS MSGS? @V305006 01719000 BZ RET322 YES @V305006 01720000 DMSERR NUM=322,LET=I,TEXT='DDNAME ''........'' NOT FOUND; NO C*01721000 LEAR EXECUTED',SUB=(CHARA,(R5)) @V305006 01722000 RET322 B RETURN EXIT @V305006 01723000 SPACE 2 01724000 ERR221E DMSERR TEXT='INVALID DATASET NAME',NUM=221,LET=E @V305006 01725000 LA R15,24 RETURN CODE = 24 @V305006 01726000 B EXIT EXIT @V305006 01727000 SPACE 2 01728000 EJECT 01729000 ERR48E EQU * @V305006 01730000 DMSERR NUM=48,LET=E,SUB=(CHARA,(R8)),TEXT='INVALID MODE ''..''*01731000 ' @V305006 01732000 LA R15,24 @V305006 01733000 B EXIT @V305006 01734000 SPACE 1 01735000 ERR109S EQU * @V305006 01736000 DMSERR LET=S,NUM=109,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED' 01737000 LA R15,104 @V305006 01738000 B EXIT @V305006 01739000 SPACE 1 01740000 ERR001E EQU * @V305006 01741000 DMSERR NUM=1,LET=E,TEXT='NO FILENAME SPECIFIED' @V305006 01742000 LA R15,24 @V305006 01743000 B EXIT @V305006 01744000 EJECT 01745000 ERR301E EQU * @V305006 01746000 DMSERR NUM=301,LET=E,TEXT='''......'' NOT ASSIGNED FOR DISK ''*01747000 ..''',SUB=(CHARA,SAVESYS,CHARA,(PARMFLAG,1)),RENT=NO 01748000 LA R15,36 @V305006 01749000 B EXIT @V305006 01750000 ERR302E EQU * @V305006 01751000 DMSERR LET=E,NUM=302,TEXT='NO SYSXXX OPERAND ENTERED' @V305006 01752000 LA R15,24 @V305006 01753000 B EXIT @V305006 01754000 ERR086E EQU * @V305006 01755000 DMSERR LET=E,NUM=086,SUB=(CHARA,(R5)),TEXT='INVALID DDNAME ''.*01756000 .......''' @V305006 01757000 LA R15,24 @V305006 01758000 B EXIT @V305006 01759000 EJECT 01760000 ERR304E EQU * @V305006 01761000 LR R8,R14 POINT TO PARAMETER IN ERR. @VM03191 01762000 DMSERR NUM=304,LET=E,SUB=(CHARA,((R8),(R5))),TEXT='INVALID OPE*01763000 RAND VALUE ''................''' @V305006 01764000 LA R15,24 @V305006 01765000 B EXIT @V305006 01766000 ERR305E EQU * @V305106 01767000 DMSERR NUM=305,LET=E,TEXT='INCOMPLETE EXTENT RANGE' @V305106 01768000 LA R15,24 @V305106 01769000 B EXIT @V305106 01770000 ERR306E EQU * @V305006 01771000 DMSERR NUM=306,LET=E,SUB=(CHARA,SAVESYS),TEXT='...... NOT ASSI*01772000 GNED FOR ''IGNORE''' @V305006 01773000 LA R15,36 @V305006 01774000 B EXIT @V305006 01775000 EJECT 01776000 ERR307E EQU * @V305106 01777000 DMSERR NUM=307,LET=E,SUB=(CHARA,(R2)),TEXT='CATALOG DDNAME ''.*01778000 .......'' NOT FOUND' @V305106 01779000 LA R15,24 @V305106 01780000 B EXIT @V305106 01781000 SPACE 1 01782000 ERR308EA LA R2,CMS ENTER HERE FOR VSAM OPTS W/'CMS' @V305106 01783000 LA R3,NONCMS ... @V305106 01784000 ERR308E EQU * @V305006 01785000 DMSERR NUM=308,LET=E,SUB=(CHARA,(STATMD,1),CHARA,(R2),CHARA,(R*01786000 3)),TEXT='''..'' DISK IN ........ FORMAT; INVALID FOR ..*01787000 ...... DATASET',RENT=NO @V305006 01788000 LA R15,24 @VA05247 01789000 B EXIT @VA05247 01790000 ERRMSG36 EQU * @VA12416 01790100 DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X01790200 LET=E,SUB=(CHARA,(STATMD,1)) @VA12416 01790300 LA R15,36 RETURN CODE = 36 @VA12416 01790400 B EXIT @VA12416 01790500 EJECT @VA05247 01791000 ***************************************************************@VA05247 01792000 * @VA05247 01793000 * PROCESS THE 'NO OPERANDS' CONDITION: @VA05247 01794000 * @VA05247 01795000 * THE USER HAS REQUESTED A LIST OF ALL CURRENT DOSCBS @VA05247 01796000 * @VA05247 01797000 ***************************************************************@VA05247 01798000 SPACE 1 @VA05247 01799000 LIST EQU * LOOP THRU DOSCB CHAIN @VA05247 01800000 LA R0,LSTLEND GET DWORDS FOR LIST AREA @VA05247 01801000 LA R10,LIST1 DROP THRU AT END OF SUBRTN @VA05247 01802000 LISTPREP LH R2,DOSNUM GET NO. DOSCBS @VA05247 01803000 LTR R2,R2 ANY THERE? @VA05247 01804000 BZ ERR324A NO...EARLY OUT. @VA05247 01805000 LA R4,DOSFIRST LOAD A(DOSCB CHAIN ANCHOR) @VA05247 01806000 DMSFREE DWORDS=(0),ERR=ERR109S GET LIST AREA @VA05247 01807000 LR R3,R1 USE R3 FOR LIST @VA05247 01808000 USING DOSCBLST,R3 @VA05247 01809000 LR R8,R0 USE R8 FOR CLEAR LENGTH @VA05247 01810000 SLL R8,3 CONVERT DWORDS TO BYTES @VA05247 01811000 BCTR R8,R0 MINUS FOR CLEAR MVC @VA05247 01812000 BCTR R8,R0 ONE MORE TIME @VA05247 01813000 MVI 0(R3),BLANK BLANK THE LIST AREA @VA05247 01814000 EX R8,EXCLR ... @VA05247 01815000 BR R10 RETURN TO CALLER @VA05247 01816000 EXCLR MVC 1(*-*,R3),0(R3) ... @VA05247 01817000 SPACE 2 @VA05247 01818000 LIST1 MVC 0(HEADLEN,R3),LISTHEAD HEADER TO WORK AREA @VA05247 01819000 LA R6,HEADLEN AND LENGTH OF SAME @VA05247 01820000 BAL R10,WRTERM GO DISPLAY THE HEADER @VA05247 01821000 SPACE 1 @VA05247 01822000 LISTLOOP EQU * LOOP FOR EACH DOSCB @VA05247 01823000 L R4,0(,R4) POINT TO NEXT DOSCB @VA05247 01824000 MVC LDDNAME,DOSDD GET DDNAME @VA05247 01825000 CLI DOSDEV,DOSDUM IS THIS ONE 'DUMMY'? @VA05247 01826000 BNE LISTMODE NO @VA05247 01827000 MVC LMODE,DUMMY YES, DISPLAY IT SO @VA05247 01828000 B LISTLOGU GO GET 'SYSXXX' @VA05247 01829000 LISTMODE MVC LMODE(L'DOSDSMD),DOSDSMD GET CMS DISKMODE @VA05247 01830000 SPACE 1 @VA05247 01831000 LISTLOGU TM DOSINIT,DOSOS 'OS' DLBL ISSUED? @VA05247 01832000 BO LISTYPE YES, SKIP SYSXXX PROCESS @VA05247 01833000 MVC LLOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01834000 XR R8,R8 USE R8 FOR LUB CODE @VA05247 01835000 ICM R8,ONE,DOSXXX INSERT LUB CODE @VA05247 01836000 CLI DOSSYS,SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01837000 BNE LISTLOGP NO, PROCESS AS PROG... @VA05247 01838000 LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01839000 SLL R8,TWO INDX TO TABLE ENTRY @VA05247 01840000 AR R7,R8 ... @VA05247 01841000 MVC LLOGXXX,0(R7) MOVE IT TO LIST @VA05247 01842000 B LISTYPE GOTO 'TYPE' FIELD... @VA05247 01843000 LISTLOGP CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01844000 UNPK LLOGXXX,PACKFLD+6(L'LLOGXXX-1) LIST SYS CODE @VA05247 01845000 OI LLOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01846000 SPACE 1 @VA05247 01847000 LISTYPE CLI DOSTYPE,SAMDS SAM DATASET? @VA05247 01848000 BNE LISTVSAM NO, MUST BE VSAM... @VA05247 01849000 MVC LTYPE,SEQNTL 'SEQ' INTO LIST @VA05247 01850000 B LISTPERM SKIP BY ALL VSAM FIELDS... @VA05247 01851000 SPACE 1 @VA05247 01852000 LISTVSAM MVC LTYPE,VSAM 'VSAM' INTO LIST @VA05247 01853000 CLI DOSUCNAM,FIRST0 ANY USER CATALOG? @VA05247 01854000 BE LISTMCAT NO, DEFAULT TO MASTER @VA05247 01855000 MVC LCATALOG,DOSUCNAM PUT USER CAT NAME @VA05247 01856000 B LISTEXT AND CONTINUE... @VA05247 01857000 LISTMCAT MVC LCATALOG,MCAT 'IJSYSCT' INTO LIST @VA05247 01858000 LISTEXT XR R8,R8 USE R8 FOR EXT, VOL NOS. @VA05247 01859000 ICM R8,ONE,DOSEXTNO GET NO. EXTENTS @VA05247 01860000 CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01861000 MVC EDIT,PATTERN SETUP PATTERN FIELD @VA05247 01862000 ED EDIT(L'LEXT+2),PACKFLD+6 FORMAT NO. EXTENTS @VA05247 01863000 MVC LEXT,EDIT+2 INTO LIST WITH IT.. @VA05247 01864000 LISTVOL ICM R8,ONE,DOSVOLNO GET NO. VOLUMES @VA05247 01865000 CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01866000 MVC EDIT,PATTERN SETUP PATTERN @VA05247 01867000 ED EDIT(L'LVOL+2),PACKFLD+6 FORMAT NO. VOLS @VA05247 01868000 MVC LVOL,EDIT+2 INTO THE LIST @VA05247 01869000 LISTBUFS L R8,DOSBUFSP GET BUFFER SPACE @VA05247 01870000 CVD R8,PACKFLD PREP FOR EDIT @VA05247 01871000 MVC EDIT,PATTERN SETUP PATTERN @VA05247 01872000 ED EDIT(L'LBUFSPC+2),PACKFLD+4 FORMAT BUFSP PARM @VA05247 01873000 MVC LBUFSPC,EDIT+2 INTO THE LIST... @VA05247 01874000 SPACE 1 @VA05247 01875000 LISTPERM TM DOSINIT,DOSPERM DOSCB MARKED 'PERM'? @VA05247 01876000 BZ LISTNO NO, CONTINUE @VA05247 01877000 MVC LPERM,YES MOVE 'YES' TO LIST @VA05247 01878000 B LISTDISK AND CONTINUE @VA05247 01879000 LISTNO MVC LPERM,NO 'NO' TO LIST @VA05247 01880000 SPACE 1 @VA05247 01881000 LISTDISK TM DOSINIT,DOSDOS 'DOS' DISK DATASET? @VA05247 01882000 BZ LISTCMS NO, MUST BE CMS.. @VA05247 01883000 MVC LDISK,DOS 'DOS' DISK DATASET @VA05247 01884000 L R7,DOSOSDSN GET DOS(OS) DSNAME... @VA05247 01885000 LTR R7,R7 DO WE HAVE ONE? @VA05247 01886000 BZ LISTLIST NO, GOTO WRAP-UP... @VA05247 01887000 MVC LFILEID,0(R7) MOVE ENTIRE DOS FILEID @VA05247 01888000 B LISTLIST CONTINUE... @VA05247 01889000 LISTCMS MVC LDISK,CMS 'CMS' DISK DATASET @VA05247 01890000 MVC LFILENAM,DOSDSNAM LIST CMS FILENAME, @VA05247 01891000 MVC LFILETYP,DOSDSTYP AND CMS FILETYPE @VA05247 01892000 EJECT @VA05247 01893000 LISTLIST LA R6,LSTLEND*8 BYTE-LENGTH FOR DISPLAY @VA05247 01894000 BAL R10,WRTERM DISPLAY THE GOODIES @VA05247 01895000 BCT R2,LISTLOOP LOOP THRU DOSCB CHAIN... @VA05247 01896000 SPACE 1 @VA05247 01897000 LA R0,LSTLEND LIST AREA IN DWORDS @VA05247 01898000 LEND LR R1,R3 @VA05247 01899000 BAL R10,FRET FRET THE WORK AREA @VA05247 01900000 TM OPTNFLAG,XEXTENT+XMULT EXTENTS OR MULT WANTED? @VA05247 01901000 BZ RETURN NO, CLOSE THE SHOP... @VA05247 01902000 TM MISCFLAG,XFOUND EXTENT OR MULT WANTED,FOUND?@VA05247 01903000 BO RETURN YES, END IN PEACE... @VA05247 01904000 LA R7,EXTENT ASSUME EXTENTS WANTED @VA05247 01905000 TM OPTNFLAG,XEXTENT EXTENTS NOT FOUND? @VA05247 01906000 BO ERR324I YES...TELL THE USER. @VA05247 01907000 LA R7,MULT MULT.VOL LIST WANTED, @VA05247 01908000 B ERR324I SO SAY NONE FOUND. @VA05247 01909000 SPACE 1 @VA05247 01910000 ***************************************************************@VA05247 01911000 * 'WRTERM' SUBRTN TO DISPLAY LINE: @VA05247 01912000 * ENTRY - R3 = A(LINE) @VA05247 01913000 * R6 = LINE LENGTH (BYTES) @VA05247 01914000 ***************************************************************@VA05247 01915000 WRTERM EQU * @VA05247 01916000 WRTERM (R3),(R6) @VA05247 01917000 BCTR R6,R0 MINUS 1 FOR CLEAR TECHNIQUE @VA05247 01918000 BCTR R6,R0 AND ONE MORE FOR MVC @VA05247 01919000 MVI 0(R3),BLANK BLANK THE WORK AREA AGAIN @VA05247 01920000 EX R6,EXCLR2 ... @VA05247 01921000 BR R10 RETURN TO CALLER @VA05247 01922000 EXCLR2 MVC 1(*-*,R3),0(R3) ... @VA05247 01923000 EJECT @VA05247 01924000 ***************************************************************@VA05247 01925000 * @VA05247 01926000 * 'DLBL (EXTENT)' OR 'DLBL (MULT)' ENTERED: @VA05247 01927000 * USER WISHES EXTENTS OR VOLUMES LISTED. @VA05247 01928000 * @VA05247 01929000 ***************************************************************@VA05247 01930000 LIST2 EQU * COME HERE FOR EXTENTS LIST @VA05247 01931000 TM OPTNFLAG,XEXTENT EXTENT' USED? @VA05247 01932000 BO L2EXT YES, PROCESS... @VA05247 01933000 TM OPTNFLAG,XMULT 'MULT' USED? @VA05247 01934000 BZ ERR086E ERROR IF NEITHER... @VA05247 01935000 SPACE 1 @VA05247 01936000 L2EXT EQU * EITHER EXTENTS OR VOLS WANTE@VA05247 01937000 LA R0,EXTLEND DWORDS FOR WORK AREA @VA05247 01938000 BAL R10,LISTPREP GET STORAGE AND INIT. STUFF @VA05247 01939000 USING EXTLIST,R3 @VA05247 01940000 MVC EHDR,LISTHEAD PROVIDE MOST OF HEADER @VA05247 01941000 TM OPTNFLAG,XEXTENT EXTENTS WANTED? @VA05247 01942000 BZ L2LOOP IF NOT SKIP... @VA05247 01943000 MVC EEXTEND+1(L'EXTENT),EXTENT EXTENT HEADER @VA05247 01944000 SPACE 1 @VA05247 01945000 L2LOOP EQU * LOOP THRU ALL DOSCBS @VA05247 01946000 L R4,0(,R4) POINT TO NEXT DOSCB @VA05247 01947000 XR R5,R5 FOR LATER... @VA05247 01948000 TM OPTNFLAG,XEXTENT LOOKING FOR EXTENTS? @VA05247 01949000 BZ LMLTPREP NO, CHEK MULT VOLS @VA05247 01950000 LA R6,DOSEXTNO POINT TO NO. EXTENTS @VA05247 01951000 L R9,DOSEXTTB AND EXTENT TABLE... @VA05247 01952000 LA R0,EXTLEN LOAD SIZE OF EXT TABLE @VA05247 01953000 B ICMNUM SKIP TO CHEK ENTRIES @VA05247 01954000 LMLTPREP LA R6,DOSVOLNO POINT TO NO. VOLUMES @VA05247 01955000 L R9,DOSVOLTB AND VOLUME TABLE... @VA05247 01956000 LA R0,MULTLEN LOAD SIZE OF VOL TABLE @VA05247 01957000 ICMNUM ICM R5,ONE,0(R6) LOAD NUM OF ENTRIES @VA05247 01958000 BZ L2END NEXT DOSCB IF NO ENTRIES @VA05247 01959000 CLI 0(R3),BLANK HAVE WE LISTED HDR YET? @VA05247 01960000 BE LDDMOVE YES, SKIP THRU... @VA05247 01961000 LA R6,EXTLEND*8 PROVIDE HDR LENGTH @VA05247 01962000 BAL R10,WRTERM DISPLAY THE HEADER @VA05247 01963000 OI MISCFLAG,XFOUND REMEMBER WE FOUND SOMETHING @VA05247 01964000 LDDMOVE MVC EDDNAME,DOSDD LIST DDNAME OF DOSCB @VA05247 01965000 SPACE 1 @VA05247 01966000 LBLKLOOP EQU * LOOP THRU TABLE ENTRIES @VA05247 01967000 MVC EMODE(L'EMODE-1),DMODE(R9) MOVE MODE TO LIST @VA05247 01968000 TM DOSINIT,DOSOS 'OS' DOSCB ? @VA05247 01969000 BO LEXTCHK2 YES, SKIP SYSXXX PROCESS @VA05247 01970000 MVC ELOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01971000 XR R8,R8 USE R8 FOR LUB CODE @VA05247 01972000 ICM R8,ONE,DSYSCODE(R9) INSERT LUB CODE @VA05247 01973000 CLI DSYS(R9),SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01974000 BNE LSTLOGP2 NO, PROCESS AS PROG... @VA05247 01975000 LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01976000 SLL R8,TWO INDX TO TABLE ENTRY @VA05247 01977000 AR R7,R8 ... @VA05247 01978000 MVC ELOGXXX,0(R7) MOVE IT TO LIST @VA05247 01979000 B LEXTCHK2 GO CHEK FOR EXTENTS... @VA05247 01980000 LSTLOGP2 CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01981000 UNPK ELOGXXX,PACKFLD+6(L'ELOGXXX-1) LIST SYS CODE @VA05247 01982000 OI ELOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01983000 SPACE 1 @VA05247 01984000 LEXTCHK2 TM OPTNFLAG,XEXTENT EXTENTS WANTED? @VA05247 01985000 BZ LDISPLAY NO, SKIP THRU... @VA05247 01986000 L R8,DEXTB(R9) GET BEGIN. OF EXTENT @VA05247 01987000 CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01988000 MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01989000 ED EDIT(L'EEXTBEG+2),PACKFLD+2 EDIT THE VALUE @VA05247 01990000 MVC EEXTBEG,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01991000 L R8,DEXTE(R9) GET END OF EXTENT @VA05247 01992000 CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01993000 MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01994000 ED EDIT(L'EEXTEND+2),PACKFLD+2 EDIT THE VALUE @VA05247 01995000 MVC EEXTEND,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01996000 LDISPLAY LA R6,EXTLEND*8 PROVIDE LINE LENGTH @VA05247 01997000 BAL R10,WRTERM DISPLAY THE GOODIES @VA05247 01998000 AR R9,R0 POINT TO NEXT TAB ENTRY @VA05247 01999000 BCT R5,LBLKLOOP GET NEXT ENTRY IN TABLE @VA05247 02000000 SPACE 1 @VA05247 02001000 L2END BCT R2,L2LOOP GET NEXT DOSCB @VA05247 02002000 LA R0,EXTLEND DWORDS TO DMSFRET @VA05247 02003000 B LEND GO FREE WORK AREA , QUIT @VA05247 02004000 SPACE 1 @VA05247 02005000 ERR324A LA R7,DLBL NO DOSCBS ACTIVE @VA05247 02006000 ERR324I DMSERR NUM=324,LET=I,SUB=(CHARA,(R7)), *02007000 TEXT='NO USER DEFINED ........''S IN EFFECT' @VA05247 02008000 B RETURN THAT'S ALL THERE IS... @VA05247 02009000 EJECT @VA05247 02010000 ***************************************************************@VA05247 02011000 * @VA05247 02012000 * STORAGE FIELDS PECULIAR TO 'LIST' PROCESSING... @VA05247 02013000 * @VA05247 02014000 ***************************************************************@VA05247 02015000 DOS DC CL3'DOS' @VA05247 02016000 YES DC CL3'YES' @VA05247 02017000 NO DC CL3'NO' @VA05247 02018000 SEQNTL DC CL3'SEQ' @VA05247 02019000 PATTERN DC XL12'402020202020202020202020' @VA05247 02020000 EDIT DC CL12' ' @VA05247 02021000 DLBL DC CL8'DLBL' @VA05247 02022000 TWO EQU 2 @VA05247 02023000 ZONE EQU X'F0' @VA05247 02024000 * FOLLOWING ARE DISPLACEMENTS IN EXTENT, VOLUME TABLES @VA05247 02025000 DMODE EQU 0 DISK MODE (BOTH) @VA05247 02026000 DSYS EQU 1 SYS/PROG CODE (BOTH) @VA05247 02027000 DSYSCODE EQU 2 LOG UNIT CODE (BOTH) @VA05247 02028000 DEXTB EQU 3 BEGIN. EXTENT (EXT ONLY) @VA05247 02029000 DEXTE EQU 7 END EXTENT (EXT TAB ONLY) @VA05247 02030000 SPACE 2 @VA05247 02031000 LISTHEAD DS 0D ***DOSCB LIST HEADER*** @VA05247 02032000 DC C'DDNAME ' @VA05247 02033000 DC C'MODE ' @VA05247 02034000 DC C'LOGUNIT ' @VA05247 02035000 DC C'TYPE ' @VA05247 02036000 DC C'CATALOG ' @VA05247 02037000 DC C'EXT ' @VA05247 02038000 DC C'VOL ' @VA05247 02039000 DC C'BUFSPC ' @VA05247 02040000 DC C'PERM ' @VA05247 02041000 DC C'DISK ' @VA05247 02042000 DC C'DATASET.NAME' @VA05247 02043000 DS 0D @VA05247 02044000 HEADLEN EQU *-LISTHEAD @VA05247 02045000 EJECT @VA05247 02046000 EXTLIST DSECT @VA05247 02047000 DS 0D EXTENT, VOLUME INFO. @VA05247 02048000 EHDR DS 0CL22 @VA05247 02049000 EDDNAME DS CL7 DDNAME @VA05247 02050000 DS CL2 @VA05247 02051000 EMODE DS CL2 DISK MODE @VA05247 02052000 DS CL2 @VA05247 02053000 ELOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 02054000 ELOGXXX DS CL3 LOGICAL UNIT CODE @VA05247 02055000 DS CL3 @VA05247 02056000 EEXTBEG DS CL10 BEGIN OF EXTENT @VA05247 02057000 EEXTEND DS CL10 END OF EXTENT @VA05247 02058000 DS 0D @VA05247 02059000 EXTLEND EQU (*-EXTLIST)/8 LENGTH IN DWORDS @VA05247 02060000 SPACE 2 @VA05247 02061000 DOSCBLST DSECT @VA05247 02062000 DS 0D ***DOSCB LIST WORK AREA*** @VA05247 02063000 LDDNAME DS CL7 @VA05247 02064000 DS CL2 @VA05247 02065000 LMODE DS CL3 CMS DISK MODE OR 'DUM' @VA05247 02066000 DS CL1 @VA05247 02067000 LLOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 02068000 LLOGXXX DS CL3 DOS LOGICAL UNIT CODE @VA05247 02069000 DS CL3 @VA05247 02070000 LTYPE DS CL4 'VSAM' OR 'SEQ' @VA05247 02071000 DS CL1 @VA05247 02072000 LCATALOG DS CL7 'IJSYSCT','IJSYSUC',ETC. @VA05247 02073000 DS CL1 @VA05247 02074000 LEXT DS CL2 NO. EXTENTS @VA05247 02075000 DS CL2 @VA05247 02076000 LVOL DS CL2 NO. VOLUMES @VA05247 02077000 DS CL2 @VA05247 02078000 LBUFSPC DS CL6 BUFFER SPACE SIZE @VA05247 02079000 DS CL2 @VA05247 02080000 LPERM DS CL3 'YES' OR 'NO' @VA05247 02081000 DS CL2 @VA05247 02082000 LDISK DS CL3 'CMS' OR 'DOS' @VA05247 02083000 DS CL2 @VA05247 02084000 LFILEID DS CL44 DATASET NAME @VA05247 02085000 ORG *-44 @VA05247 02086000 LFILENAM DS CL8 CMS FILENAME @VA05247 02087000 DS CL1 @VA05247 02088000 LFILETYP DS CL8 CMS FILETYPE @VA05247 02089000 ORG , @VA05247 02090000 DS 0D @VA05247 02091000 LSTLEND EQU (*-DOSCBLST)/8 LENGTH IN DWORDS @VA05247 02092000 EJECT @VA05247 02093000 ***************************************************************@VA05247 02094000 * DSECTS AND DUMMY AREAS @VA05247 02095000 ***************************************************************@VA05247 02096000 NUCON @VA05247 02097000 BGCOM @VA05247 02098000 SVCSAVE @VA05247 02099000 ADT @VA05247 02100000 REGEQU @V305006 02101000 DMSDLB CSECT @V305006 02102000 END 02103000