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