ibm:vm370-lib:cms:dmsdlb.assemble_src
Table of Contents
DMSDLB Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R12416DS]
Source Listing
- DMSDLB.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsdlb.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator