ibm:vm370-lib:cms:dmsfld.assemble_src
Table of Contents
DMSFLD Source
References
- Fixes Applied : 16
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC309DS]
Source Listing
- DMSFLD.ASSEMBLE.txt
- FLD TITLE 'DMSFLD (CMS) VM/370 - RELEASE 6' 00001000
- * 00002000
- * MODULE NAME: 00003000
- * 00004000
- * DMSFLD (FILEDEF) 00005000
- * 00006000
- * FUNCTION: 00007000
- * 00008000
- * TO ALLOW THE USER TO SPECIFY, IN A MANNER SIMILAR TO 00009000
- * THE OS DATA DEFINITION CARD, I/O DEVICES AND CERTAIN 00010000
- * FILE CHARACTERISTICS WHICH WILL BE USED BY A PROGRAM AT 00011000
- * EXECUTION TIME. CAN ALSO BE USED TO MODIFY, DELETE AND 00012000
- * LIST PREVIOUSLY DEFINED FILE DESCRIPTIONS. 00013000
- * 00014000
- * ATTRIBUTES: TRANSIENT 00015000
- * NOTE: FILEDEF MUST BE GENMOD'D WITH THE SYSTEM OPTION 00016000
- * 00017000
- * ENTRY POINTS: 00018000
- * DMSFLD 00019000
- * 00020000
- * ENTRY CONDITIONS: 00021000
- * R1 MUST POINT TO FILEDEF PARAMETER LIST 00022000
- * CMS USER'S GUIDE GIVES A FULL DESCRIPTION OF THE 00023000
- * VARIOUS PARAMETER FORMATS. 00024000
- * THE GENERAL FORMAT IS AS FOLLOWS: 00025000
- * DS 0F 00026000
- * PLIST DC CL8'FILEDEF' 00027000
- * DC CL8'DDNAME' 00028000
- * DC CL8'CLEAR' OR 'DUMMY' OR DEVICE-TYPE V0742 00029000
- *| <DC CL8'FILENAME' FILEID OPTIONAL; USED ONLY 00030000
- *| DC CL8'FILETYPE' WITH 'DISK' 00031000
- *| <DC CL8'FILEMODE'>> 00032000
- * DC CL8'(' START OF OPTIONS 00033000
- * DC CL8'OPTIONS' 00034000
- * DC 8X'FF' FENCE 00035000
- * 00036000
- * 00037000
- * EXIT CONDITIONS: 00038000
- * NORMAL RETURN 00039000
- * R15 = 0 00040000
- * R0 = ADDRESS OF FCB 00041000
- * POSITIVE IF ALREADY EXISTS 00042000
- * NEGATIVE IF OBTAINED OR MODIFIED BY THIS CALL 00043000
- * 00044000
- * ERROR RETURN: 00045000
- * R15 NON-ZERO : 00046000
- * = 24 INVALID, DUPLICATE OR CONFLICTING OPTIONS 00047000
- * 24 NO FILETYPE, INVALID DEVICE, INVALID OPTION PARM 00048000
- * 24 INVALID TAPE MODE, PARAMETER MISSING 00049000
- * ENTER DATA SET NAME 00050000
- * 24 INVALID DATA SET NAME 00051000
- * 00052000
- * CALLS TO OTHER ROUTINES: 00053000
- *| DMSFREB,DMSFREC,DMSCWRB 00054000
- * 00055000
- * EXTERNAL REFERENCE: 00056000
- *| TYPE 00057000
- * CMSCB 00058000
- *| REGEQU 00059000
- * NUCON 00060000
- * 00061000
- * CALLED BY: 00062000
- * SOIOMAN, LANGUAGE PROCESSORS, 00063000
- * EXECUTION INTERFACES FOR PLI, FORTRAN 00064000
- * 00065000
- * 00066000
- * TABLES AND WORK AREAS: 00067000
- * 00068000
- * TABSTART - VALID OPTION TABLE 00069000
- * RECFTAB - VALID SETTINGS FOR 'RECFM' OPTION 00070000
- *| TRTCH - TAPE RECORDING MODE TABLE 00071000
- *| TRTAB - DISPLACEMENTS IN 'TRTCH' TABLE FOR TRTCH OPTION 00072000
- * COPYLIST - PLIST COPY INTERNAL 00073000
- * FCB FILE CONTROL BLOCK FREE STORAGE 00074000
- * DSN - BLOCK TO HOLD OS DATA SET NAME FREE STORAGE 00075000
- * 00076000
- * REGISTER USAGE: 00077000
- * 00078000
- * R0 - ADDRESS RETURN 00079000
- * R1 - PLIST ON ENTRY 00080000
- * R2 - WORKING REGISTER 00081000
- *| R3 - WORKING REGISTER 00082000
- * R4 - FCBSECT 00083000
- * R5 - PLIST - WORKING COPY 00084000
- *| R6 - FENCE 00085000
- *| R7 - WORKING TEMPORARY 00086000
- *| R8 - A(START OF OPTIONS) IF ANY; OTHERWISE, A(DDNAME) IN PLIST 00087000
- *| R9 - WORKING TEMPORARY 00088000
- * R10 - INTERNAL LINKAGE 00089000
- *| R11 - BASE2 00090000
- * R12 - BASE 00091000
- * R13 - SAVE AREA 00092000
- * R14 - EXTERNAL LINKAGE 00093000
- * R15 - EXTERNAL LINKAGE 00094000
- * 00095000
- * NOTES: 00096000
- * 00097000
- * | "FILEDEF" IS TREATED AS A "COMMAND" OR A "FUNCTION" 00098000
- * | ACCORDING TO THE HIGH-ORDER BYTE OF R1 AT INPUT, VIZ: 00099000
- * | If = x'0B', it was issued as a command from DMSINT. HRC309DS 00100000
- * | If = x'0D', it was issued from an EXEC file (DMSEXT), HRC309DS 00101000
- * | with "&CONTROL" set to either "CMS" or "ALL". HRC309DS 00102000
- * | If = X'01', it was issued from an EXEC file (DMSEXT), HRC309DS 00103000
- * | with "&CONTROL OFF" in effect. HRC309DS 00104000
- * | Otherwise it is assumed to be issued from a function, HRC309DS 00105000
- * | I.E. called from another program. HRC309DS 00106000
- * 00107000
- * | FOR "FILEDEF" AS A COMMAND, ALL ERROR MESSAGES ARE GIVEN, 00108000
- * | WHEREAS AS A FUNCTION THEY ARE OMITTED. 00109000
- * 00110000
- * OPERATION: 00111000
- * 00112000
- * THE STARTING ADDRESS OF THE CHAIN OF FCB'S IS 00113000
- *| OBTAINED FROM THE FCBSECT. THE PLIST IS THEN PLACED IN 00114000
- *| THE TRANSIENT AREA FOR A WORKING COPY OF THE PLIST. 00115000
- * 00116000
- *| THE PLIST IS THEN EXAMINED FOR 'STATUS' OPTIONS. IF EITHER 00117000
- * PERM AND/OR NOCHNG IS SPECIFIED, APPROPRIATE FLAGS 00118000
- *| ARE SET. 00119000
- * 00120000
- * SUBSEQUENT PROCESSING DEPENDS ON THE OPERANDS 00121000
- * SPECIFIED. THE FIRST OPERAND IS CHECKED, AND 00122000
- * DEPENDING ON ITS CONTENTS, OPERATION CONTINUES AS 00123000
- * DESCRIBED BELOW. 00124000
- * 00125000
- * NO OPERAND. FILEDEF WITH NO OPERAND 00126000
- * REQUESTS A LIST OF CURRENT FILE DEFINITIONS. FCBNUM 00127000
- * CONTAINS THE NUMBER OF ENTRIES IN THE CHAIN OF FCB'S. 00128000
- * THIS IS USED TO LOOP THROUGH THE CHAIN. FOR EACH, 00129000
- * FCBDD AND FCBDEV IS TYPED TO THE TERMINAL. FOR 00130000
- * DEFINITIONS OF DISK, FCBDSNAM (THE CMS FILENAME) AND 00131000
- * FCBDSTYP (THE CMS FILETYPE) ARE ALSO TYPED. 00132000
- * 00133000
- * *CLEAR. ALL FCB'S ON THE CHAIN ARE RELEASED EXCEPT 00134000
- * THOSE FLAGGED PERMANENT. THESE ARE RELEASED ONLY WHEN 00135000
- * SPECIFICALLY CLEARED. 00136000
- * 00137000
- * NUMERIC DDNAME. THE NUMBER IS CONVERTED TO A FORTRAN 00138000
- * DATA SET REFERENCE NUMBER (I.E., FTXXFNNN). 00139000
- * PROCESSING CONTINUES AS DESCRIBED UNDER ALPHA FILEID 00140000
- * BELOW. 00141000
- * 00142000
- * DDNAME. FCB IS USED TO LOOP THROUGH THE FCB CHAIN IN 00143000
- * FREE STORAGE LOOKING FOR THE SPECIFIED FCB. IF NO 00144000
- * MATCH IS FOUND, THE NEW FCB FLAG IS SET, FREE STORAGE 00145000
- * IS OBTAINED, AND THE ADDRESS OF THIS FCB IS PLACED IN 00146000
- * THE FIRST WORD OF THE LAST FCB ON THE CHAIN. THE 00147000
- * ADDRESS OF THE NEW FCB IS PUT IN REGISTER 0 AS A 00148000
- * NEGATIVE QUANTITY AND SAVED TO BE PASSED BACK TO THE 00149000
- * USER WHEN PARAMETER PROCESSING IS COMPLETE. IF THE 00150000
- * PERM FLAG IS SET, THE HIGH ORDER BYTE OF THE NEW FCB 00151000
- * IS FLAGGED PERMANENT. 00152000
- * 00153000
- * IF A MATCHING FCB IS FOUND, AND THE NOCHNG FLAG IS 00154000
- * SET, FILEDEF RETURNS TO THE USER WITH THE ADDRESS OF 00155000
- * THE FCB IN REGISTER 0. 00156000
- * 00157000
- * IF A MATCHING FCB IS FOUND AND THE NOCHNG FLAG IS NOT 00158000
- * SET, THE OLD FCB IS SAVED IN CASE OF AN ERROR, THE 00159000
- * OLD ENTRY FLAG IS SET, AND THE ADDRESS OF THE FCB IS 00160000
- * NEGATIVELY STORED IN REGISTER 0. IF THE PERM FLAG IS 00161000
- * SET, THE FCB IS FLAGGED PERMANENT. 00162000
- * 00163000
- * PROCESSING IS THEN DEPENDENT ON THE DEVICE TYPE AND 00164000
- * RELATED PARAMETERS SPECIFIED. 00165000
- * 00166000
- * DUMMY. FOR DEVICE DUMMY AN FCB IS CREATED 00167000
- * WITH A DEVICE TYPE OF X'00'. OPTIONS ARE PROCESSED AS 00168000
- * IF 'DISK' HAD BEEN SPECIFIED AS THE DEVICE. 00169000
- * 00170000
- * DEVICES: 00171000
- * 00172000
- * TERMINAL - USER'S TERMINAL 00173000
- * 00174000
- *| DISK - DISK FILE; FILEID IS OPTIONAL. IF FMODE IS 00175000
- * NOT A PART OF THE FILEID, THE FILE WILL BE 00176000
- * PLACED ON THE A-DISK. 00177000
- * 00178000
- * DSN - IF THE PARAMETER DSN ? IS SPECIFIED, FILEDEF 00179000
- * WILL TYPE OUT MSG. DMSFLD220R TO REQUEST THE USER 00180000
- * TO TYPE IN AN OS DATA SET NAME IN THE FORMAT Q1.Q2.QN, 00181000
- * Q1 Q2 AND QN BEING THE QUALIFIERS IN AN OS DATA SET NAME. 00182000
- * IF THE PARAMETER DSN Q1 Q2 QN IS SPECIFIED, FILEDEF WILL 00183000
- * ASSUME THAT Q1 Q2 AND QN ARE THE QUALIFIERS OF AN OS 00184000
- * DATA SET NAME. THE Q1 Q2 AND QN QUALIFIERS ARE STORED 00185000
- * IN THE FORMAT Q1.Q2.QN IN A FREE STORAGE BLOCK THAT 00186000
- * IS CHAINED TO THE FCB. 00187000
- * 00188000
- * PRINTER, PUNCH, READER - REPETITIVE SPOOLED DEVICES 00189000
- * 00190000
- * TAPN - TAPE FILE; WHERE N = 0-F, INDICATING THE HRC002DS 00191490
- * SYMBOLIC TAPE ADDRESS. 00192000
- * 00193000
- * OPTIONS: 00194000
- * 00195000
- *| UPCASE - PROVIDE TRANSLATION TO UPPERCASE. 00196000
- *| THIS IS THE DEFAULT CONDITION. 00197000
- * 00198000
- *| LOWCASE - PROVIDE NO TRANSLATION TO UPPERCASE; 00199000
- *| THE FCBCASE BIT IS SET ON IN THE FCBIOSW BYTE. 00200000
- * 00201000
- * CHANGE|NOCHANGE - DETERMINES IF AN EXISTING CMSCB IS 00202000
- * TO BE CHANGED OR REMAIN UNMODIFIED. CHANGE IS DEFAULT. 00203000
- * 00204000
- * PERMANENT - THE CMSCB CREATED FOR THIS DDNAME IS 00205000
- * RETAINED UNTIL SPECIFICALLY CLEARED; 00206000
- *| IT IS NOT REMOVED AFTER A GENERAL '*CLEAR' REQUEST. 00207000
- *| THE FCBPERM BIT (X'04') IS SET IN THE FCBINIT BYTE. 00208000
- * 00209000
- * AUXPROC - KEYWORD FOLLOWED BY ADCON CONTAINING THE V0742 00210000
- * ADDRESS OF AN AUXILIARY PROCESSING ROUTINE WHICH WILL V0742 00211000
- * RECEIVE CONTROL FROM DMSSEB TO PERFORM DEVICE I/O. V0742 00212000
- * THIS FEATURE, INVOKED BY INTERNAL CALL ONLY, IS MOST V0742 00213000
- * COMMONLY USED BY THE CMS LANGUAGE PROCESSOR INTERFACES. V0742 00214000
- * 00215000
- * CONCAT - IF THE CONCAT OPTION IS SPECIFIED, FILEDEF 00216000
- * WILL ASSUME THAT THE SPECIFIED FILEDEF IS UNIQUE UNLESS 00217000
- * A FILEDEF IS OUTSTANDING WITH A MATCHING DDNAME, 00218000
- * FILENAME AND FILETYPE. THIS ALLOWS THE USER TO 00219000
- * SPECIFY MORE THAN ONE FILEDEF FOR A PARTICULAR 00220000
- * DDNAME. THE CONCAT OPTION ALSO SETS THE FCBCATML 00221000
- * BIT IN THE FCB SO THAT THE OS SIMULATION KNOWS 00222000
- * THE FCB IS FOR A CONCATONATED MACLIB. 00223000
- * 00224000
- * MEMBER - IF THE MEMBER OPTION IS SPECIFIED, FILEDEF 00225000
- * STORES THE MEMBER NAME IN FCBMEMBR IN THE FCB TO 00226000
- * INDICATE THAT THE OS SIMULATION SHOULD SET THE 00227000
- * READ WRITE POINTER TO POINT TO THE MEMBER OF THE 00228000
- * SPECIFIED BPAM FILE AT OPEN TIME. 00229000
- * 00230000
- *| DSORG - PS|PO|DA SET THE FCBDSORG BYTE TO RECORD 00231000
- *| PHYSICAL SEQUENTIAL, PARTITIONED OR DIRECT ACCESS 00232000
- *| DATASET ORGANIZATION. 00233000
- * 00234000
- * 00235000
- * RECFM F|FB|V|VB|U - THE RECORD FORMAT IS SET IN THE 00236000
- * JFCRECFM INDICATING FIXED, FIXED BLOCKED, 00237000
- *| FIXED STANDARD, FIXED BLOCKED STANDARD, 00238000
- *| VARIABLE, VARIABLE BLOCKED, VARIABLE SPANNED, 00239000
- *| VARIABLE BLOCKED SPANNED, UNDEFINED, AND ANY TYPE 00240000
- *| WITH ASA OR MACHINE CONTROL CHARACTERS. 00241000
- * 00242000
- *| DISP MOD - ALLOWS USER TO UPDATE BDAM FILES. 00243000
- * 00244000
- * LRECL N - THE JFCLRECL IS SET TO N TO INDICATE THE 00245000
- * LOGICAL RECORD LENGTH. 00246000
- * 00247000
- * BLOCK N - INDICATES THE LENGTH OF A BLOCK OF RECORDS; 00248000
- * JFCBLKSI IS SET. 00249000
- * 00250000
- * OPTCD A|E|F|R - THE DESIRED OPTION CODE FOR THE DATA 00251000
- *| SET IS INDICATED IN JFCOPTCD. ANY COMBINATION 00252000
- *| (NON-DELIMITED, WITH A,R MUTUALLY EXCLUSIVE) IS 00253000
- *| ALLOWED. 00254000
- * 00255000
- * KEYLEN NN - SPECIFIES THE SIZE OF THE KEY IN BYTES. 00256000
- * 00257000
- * XTENT 50|NN - FOR BDAM DATA SETS, XTENT INDICATES THE 00258000
- * PRE-FORMATTED NUMBER OF RECORDS TO BE SET IN 00259000
- * JFCXTENT. 00260000
- * 00261000
- * LIMCT NN - SPECIFIES THE LIMIT COUNT ON THE NUMBER OF 00262000
- * BLOCKS TO BE SEARCHED WITHIN A BDAM DATA SET. 00263000
- * 00264000
- * FOR DEVICE = TAPN, ONLY: 00265000
- * 00266000
- * 7TRACK|9TRACK - SPECIFIES TRACK SETTING 00267000
- * 00268000
- * DEN 200|556|800|1600|6250 SPECIFIES BIT DENSITY @V200414 00269000
- * 00270000
- * TRTCH O|OC|OT|E|ET - INDICATES THE DESIRED TAPE 00271000
- * RECORDING TECHNIQUE ('O' IS DEFAULT): 00272000
- * 00273000
- * PARITY (ODD, EVEN), CONVERTER (ON, OFF), 00274000
- * TRANSLATOR (ON, OFF). 00275000
- *. 00276000
- EJECT 00277000
- DMSFLD START X'0' 00278000
- * 00279000
- * SET UP BASIC ADDRESSABILITY * 00280000
- * 00281000
- LR R12,R15 00282000
- USING DMSFLD,R12,R11 ADDRESSIBILITY 00283000
- LA R11,4095(R12) SET SECOND BASE @V201105 00284000
- LA R11,1(0,R11) @V201105 00285000
- ST R14,GR14SA 00286000
- LR R5,R1 SAVE INPUT PARAMETER POINTER 00287000
- ST R13,GR13SA SAVE SA POINTER 00288000
- USING NUCON,R0 00289000
- L R13,CURRSAVE POINT TO SYSTEM SAVE AREA 00290000
- USING SSAVE,R13 00291000
- SR R0,R0 CLEAR R0 FOR NOCHANGE PROCESSING 00292000
- ST R0,EGPR0 SAVE IT 00293000
- USING NUCON,R0 00294000
- SR R13,R13 CLEAR R13 FOR LATER USE 00295000
- XC VALFLAG(8),VALFLAG RESET FLAGS FOR RE-UE@SE 00296000
- LA R7,TABSTART+8 00297000
- LA R8,12 LENGTH OF EACH ENTRY 00298000
- LA R9,TABEND-4 00299000
- RESET0 NI 0(R7),X'0F' RESET OPTION 'FOUND' FLAGS 00300000
- BXLE R7,R8,RESET0 00301000
- MVI MSGSWT,00 DEFAULT SWITCH FOR "FUNCTION" @VA01154 00302000
- * (WITHOUT ERROR MESSAGES) 00303000
- CLM R5,8,=X'0B' hi byte of "R1" < X'0B' ? HRC309DS 00304000
- BL LETSGO yes, it's a function or EXEC HRC309DS 00305000
- CLM R5,8,=X'0D' EXEC w/&CONTROL ALL or CMS? HRC309DS 00306000
- BH LETSGO no, treat as a function call HRC309DS 00307000
- OI MSGSWT,PRINT called from DMSINT or EXEC, so HRC309DS 00308000
- * we will display error messages HRC309DS 00309000
- * 00310000
- * THE PLIST PTR IS UPDATED TO POINT TO OPERAND ONE AND 00311000
- * THE PLIST END INDICATOR IS PUT IN GR 6. 00312000
- * 00313000
- USING FCBSECT,R4 TABLE ADDRESSABILITY 00314000
- LETSGO LA R5,8(,R5) SKIP TO FIRST PARAMETER 00315000
- SR R15,R15 ZERO RETURN CODE REGISTER 00316000
- L R6,PLISTEND SET REG 6 = X'FFFFFFFF' 00317000
- C R6,0(,R5) ? NULL ENTRIES ? 00318000
- BE LIST YES. GO LIST CURRENT OSCB 00319000
- * CHECK FOR ANY OPTIONS. 00320000
- LR R2,R5 SAVE CURRENT PLIST POINTER 00321000
- LR R9,R6 TEMP SWITCH P1017 00322000
- OPT1A C R6,0(,R2) ? END OF PARAMETER ? 00323000
- BE SETPLIST YES - GO SET UP PLIST COPY 00324000
- CLI 0(R2),C'(' ? START OF OPTIONS ? 00325000
- BNE ADDTO NO, TRY SOME MORE 00326000
- C R6,8(R2) check for '(' as last parm HRC309DS 00326050
- BNE OPT1B not there, proceed normally HRC309DS 00326100
- ST R6,8(R2) overwrite the lone '(' with HRC309DS 00326150
- ST R6,12(R2) a fence to make it go away HRC309DS 00326200
- B SETPLIST and pretend we never saw it HRC309DS 00326250
- OPT1B DS 0H HRC309DS 00326300
- LTR R9,R9 P1017 00327000
- BM PAROK O.K., FIRST PAREN P1017 00328000
- LR R5,R2 TWO '(' FOUND: ERROR P1017 00329000
- B ERR3E P1017 00330000
- PAROK EQU * P1017 00331000
- XR R9,R9 CLEAR SWITCH P1017 00332000
- SR R13,R13 00333000
- LR R13,R2 SAVE START OF OPTION 00334000
- ADDTO LA R2,8(,R2) INCREMENT 00335000
- CLI 0(R2),C')' CHEK END OF PLIST 00336000
- BNE OPT1A NO - SCAN NEXT 8 BYTES 00337000
- LTR R9,R9 TEST FOR '(' ENTERED P1017 00338000
- BNM REPFF P1017 00339000
- LR R5,R2 ERROR IF NO '(' P1017 00340000
- B ERR70E P1017 00341000
- REPFF EQU * P1017 00342000
- ST R6,0(,R2) REPLACE WITH X'FF'S FOR LATER USE... 00343000
- SETPLIST LR R4,R5 SET UP LENGTH REGISTER 00344000
- LA R9,COPYLIST PROGRAM'S END 00345000
- LR R8,R2 SAVE TEMP (R2) FOR STATUS OPTION CHEK 00346000
- SR R8,R4 PUT LENGTH OF PLIST IN R8 00347000
- EXECUTE EX R8,COPY COPY PLIST AT PROGRAM'S END 00348000
- LA R9,COPYLIST START OF PLIST COPY 00349000
- AR R8,R9 ADD LENGTH OF PLIST COPY 00350000
- MVC 0(4,R8),PLISTEND BORDER PATROL 00351000
- LA R5,COPYLIST POINT TO COPY ADDRESS 00352000
- TESTOPT LTR R13,R13 ANY OPTIONS? 00353000
- BNZ OPTNS YES. 00354000
- OI OPTNFLAG,NOOPTNS NO '(' FOUND: NO OPTIONS ALLOWED 00355000
- LR R8,R5 DUMMY R8 00356000
- B OP1 GO PROCESS PARAMS 00357000
- EJECT 00358000
- * 00359000
- * IF A '(' HAS BEEN DETECTED, USER OPTIONS FOLLOWING IT WILL BE VALID 00360000
- * AND R8 WILL POINT TO THE FIRST OF THESE OPTIONS; 00361000
- * OTHERWISE, R8 WILL POINT TO START OF PLIST (DDNAME). 00362000
- * 00363000
- OPTNS CLC CLEAR(8),8(R5) ? CLEAR REQUEST ? @VA04076 00364000
- BE ERR704I YES, THAT'S A NO-NO 00365000
- SR R13,R4 CALCULATE LENGTH OF PARAMETERS 00366000
- LR R4,R13 SAVE LENGTH 00367000
- LR R13,R5 START OF PLIST COPY 00368000
- AR R13,R4 START OF OPTION 00369000
- CLI 1(R13),BLANK DO OPTIONS FOLLOW IMMEDIATELY? 00370000
- BNE ADJOPT YES 00371000
- LA R13,8(,R13) GET FIRST OPTION 00372000
- LR R8,R13 SAVE OPTION START 00373000
- B NOCHTEST 00374000
- ADJOPT MVC 0(7,R13),1(R13) LEFT ADJUST OPTION CHECK 00375000
- MVI 7(R13),X'40' PAD WITH BLANK 00376000
- LR R8,R13 SAVE OPTION START 00377000
- * 00378000
- * CHECK STATUS OPTIONS... 00379000
- NOCHTEST MVC KEYWORD(8),NOCHANGE SET UP NOCHNG OPTION CHECK 00380000
- LR R1,R5 SAVE DEVICE PTR 00381000
- BAL R10,SCAN 00382000
- CLI FLAG2,MATCH ? HIT 00383000
- BNE PERMTEST NO 00384000
- OI FLAG3,NOCH YES - SO STIPULATE 00385000
- PERMTEST LR R5,R13 00386000
- MVC KEYWORD(8),PERM SET UP PERM CHECK 00387000
- BAL R10,SCAN SCAN... 00388000
- LR R5,R13 RESET 00389000
- CLI FLAG2,MATCH ? HIT 00390000
- BNE CONCATCK NO @V201105 00391000
- OI FLAG3,PERMBIT SET PERM BIT IN FCB 00392000
- CONCATCK MVC KEYWORD(8),CONCAT LOOK FOR CONCAT OPTION @V201105 00393000
- BAL R10,SCAN @V201105 00394000
- LR R5,R13 RESTORE R5 @V201105 00395000
- CLI FLAG2,MATCH FOUND @V201105 00396000
- BNE CHNGTEST NO @V201105 00397000
- OI FLAG3,CATFLG REMEMBER IT @V201105 00398000
- OI FLAG1,NEW IDICATE NEW ENTRY @V201105 00399000
- CLC 8(8,R1),=CL8'DSN' OS DISK @V201105 00400000
- BE CATDEF YES, SET FN FT DEFAULT @V201105 00401000
- CLC 16(8,R1),=CL8'DSN' SAME QUESTION @V201105 00402000
- BE CATDEF SAME ANSWER @V201105 00403000
- C R6,16(R1) FN SPECIFIED @V201105 00404000
- BE CATDEF NO, USE DEFAULT @V201105 00405000
- CLI 16(R1),C'(' SAME QUESTION @V201105 00406000
- BE CATDEF SAME ANSWER @V201105 00407000
- MVC STATFN(16),16(R1) SAVE FN FT FOR FCB LOOP @V201105 00408000
- B CHNGTEST @V201105 00409000
- CATDEF MVC STATFN(8),=CL8'FILE' DEFAULT FNAME @V201105 00410000
- MVC STATFN+8(8),0(R1) DDNAME AS FTYPE @V201105 00411000
- CHNGTEST MVC KEYWORD(8),CHANGE 00412000
- BAL R10,SCAN 00413000
- LR R5,R1 RESET DEVICE POINTR 00414000
- B OP1 GO CHECK PARAMETERS 00415000
- EJECT 00416000
- * 00417000
- *********************************************************************** 00418000
- * 00419000
- * PROCESSING NULL OPERANDS 00420000
- * 00421000
- * 1. THIS IS A REQUEST FOR A LIST ON SYSOUT OF THE 00422000
- * DDNAMES IN THE FCB TABLE. 00423000
- * 00424000
- *********************************************************************** 00425000
- * 00426000
- LIST EQU * 00427000
- LH R2,FCBNUM GET COUNT OF ENTRIES 00428000
- LTR R2,R2 00429000
- BZ RETURN ALL CLEAR 00430000
- L R4,FCBFIRST GET PTR TO 1ST ENTRY 00431000
- LIST1 MVC LISTMES(8),FCBDD PUT DDNAME INTO MESSAGE 00432000
- SR R8,R8 CLEAR REG 8 00433000
- IC R8,FCBDEV GET DEVICE TYPE CODE 00434000
- AR R8,R8 DOUBLE IT FOR TABLE LOOK UP 00435000
- LA R7,DUMMY GET ADDRESS OF DUMMY 00436000
- AR R7,R8 POINT TO PROPER ENTRY IN TABLE 00437000
- MVC LISTMES+9(8),0(R7) MOVE DEV NAME TO MSG 00438000
- CLC LISTMES+9(8),TAP IS IT A TAPE DEVICE. 00439000
- BNE LIST2 00440000
- MVC LISTMES+12(1),FCBTAPID+3 PUT TAP NUMBER INTO MSG 00441000
- * TYPE '8 BLANKS' 00442000
- LIST2 CLC LISTMES+9(2),DISK ? IS IT DISK ? 00443000
- BNE LIST3 NO 00444000
- MVC LISTMES+18(8),FCBDSNAM MOVE IN DSNAME 00445000
- MVC LISTMES+27(8),FCBDSTYP MOVE IN DSTYPE 00446000
- MVC LISTMES+36(2),FCBDSMD MOVE IN DSMODE @V201122 00447000
- MVC LISTLEN(3),DSKLEN 00448000
- L R1,FCBOSDSN GET OS DSN ADDR @V201122 00449000
- LTR R1,R1 IS IT SPECIFIED @V201122 00450000
- BZ LIST3 NO, DON'T USE DSN @V201122 00451000
- MVC LISTOSDS(44),0(R1) TYPE OS DSN @V201122 00452000
- MVC LISTLEN(3),OSDSKLEN USE OS DSN LENGTH @V201122 00453000
- LIST3 LA R1,LISTYP ADDRESS OF DESCRIPTION 00454000
- B LISTSVC CALL TYPE. 00455000
- DS 0F ALIGN. 00456000
- LISTYP DC CL8'TYPLIN' 00457000
- DC AL1(1),AL3(LISTMES),C'D' 00458000
- LISTLEN DC AL3(L'LISTMES) 00459000
- LISTMES DC CL22' ' FOR DDNAMES AND DEVICE NAMES @V201122 00460000
- LISTDSK DC CL18' ' FOR DSNAMES AND DSTYPES 00461000
- LISTOSDS DC CL44' ' SPACE FOR OS DSN @V201122 00462000
- LISTSVC SVC CMS 00463000
- L R4,0(,R4) GET PTR TO NEXT ENTRY 00464000
- MVC LISTLEN(3),GENLEN RESTORE DEFAULT LENGTH 00465000
- MVI LISTMES,X'40' SET FIRST BYTE TO BLANK @VA02592 00466000
- MVC LISTMES+1(21),LISTMES BLANK OUT MSG FIELD @VA02592 00467000
- BCT R2,LIST1 CONTINUE FOR ALL ENTRIES 00468000
- B RETURN FINISHED. 00469000
- DSKLEN DC AL3(LISTOSDS-LISTMES) @V201122 00470000
- OSDSKLEN DC AL3(LISTSVC-LISTMES) @V201122 00471000
- GENLEN DC AL3(L'LISTMES) 00472000
- DS 0H @V201122 00473000
- * 00474000
- EJECT 00475000
- * 00476000
- *********************************************************************** 00477000
- * 00478000
- * PROCESSING OF OPERAND ONE 00479000
- * 00480000
- * 1. THREE OPTIONS ARE POSSIBLE: 00481000
- * A. A DDNAME, OR 00482000
- * B. A DATA SET REFERENCE NUMBER (DSRN), OR 00483000
- * C. AN ASTERISK *, (CLEAR ALL). 00484000
- * 00485000
- * 2. TYPE AND VALIDITY ARE CHECKED. 00486000
- * 3. FOR DSRN, A DDNAME IS CREATED. 00487000
- * A. WITH THE DDNAME, THE FCB TABLE IS SEARCHED FOR A 00488000
- * MATCH, AND SVCFREE CALLED IF NECESSARY. 00489000
- * B. FOR *, THE CLEAR OPTION IS PROCESSED. 00490000
- * 00491000
- *********************************************************************** 00492000
- * 00493000
- * PLIST POINTS TO PARAMETER 1. 00494000
- * THE FIRST PARAMETER IS CHECKED FOR TYPE AND VALIDITY. 00495000
- * 00496000
- OP1 EQU * 00497000
- OI FLAG4,OLD RESET SVCFREE FLAG 00498000
- NI FLAG4,255-NEW 00499000
- C R6,8(,R5) ? ONLY 1 PARAM ? 00500000
- BE ERR50E YES, QUIT 00501000
- CLI 0(R5),C'Z' ? 1ST CHAR NUMERIC ? 00502000
- BH DSRN YES IF > THAN X'E9'. 00503000
- CLI 0(R5),C'*' ? CLEAR REQUEST ? 00504000
- BNE SRCHFCB NO, GO PROCESS AS DDNAME. 00505000
- * 00506000
- * PROCESS * CLEAR REQUEST. 00507000
- * 00508000
- AST EQU * 00509000
- CLI 1(R5),BLANK ? ONLY * ENTERED ? R 195 00510000
- BNE ERR70E NO, ERROR EXIT @VA03259 00511000
- CLC CLEAR(8),8(R5) ? 2ND OPERAND CLEAR ? 00512000
- BNE ERR3E NO, ERROR EXIT. 00513000
- C R6,16(,R5) ? ONLY 2 PARAMETERS ? 00514000
- BE RELEASE YES - CONTINUE 00515000
- LA R5,16(,R5) POINT TO THE INVALID OPTION 00516000
- B ERR3E AND GO TO ERR RTN. 00517000
- * 00518000
- * ALL ENTRIES EXCEPT SYSIN AND SYSOUT WILL BE RELEASED. 00519000
- * 00520000
- RELEASE LH R7,FCBNUM GET COUNT OF ENTRIES 00521000
- LTR R7,R7 ? ANY ENTRIES ? 00522000
- BZ RETURN NO, FINISHED. 00523000
- LR R6,R7 SET UP LOOPING REGISTER 00524000
- LA R2,FCBFIRST INITIALIZE CHAIN 00525000
- LA R5,FCBENSIZ SIZE TO RELEASE IN DLWDS 00526000
- ST R5,PLFREE+8 STORE IN FRET LIST 00527000
- LOOP LR R4,R2 SAVE CHAIN POINTER 00528000
- L R1,0(,R2) GET POINTER TO NEXT FCB 00529000
- TM 0(R1),PERMBIT IS THIS A PERMANENT FCB? 00530000
- LR R2,R1 SAVE POINTER 00531000
- BO ITERATE SKIP FRET - PERMANENT FCB 00532000
- MVC 1(3,R4),1(R1) RESET FORWARD POINTER 00533000
- LR R2,R4 RESTORE POINTER 00534000
- ST R1,PLFREE+12 STORE FCB ADDRESS IN FRET LIST 00535000
- DROP R4 @V201105 00536000
- LR R4,R1 PUT ADDRESS OF FCB INTO REG4 @VA12529 00536500
- USING FCBSECT,R1 @V201105 00537000
- L R1,FCBOSDSN GET OS DSNAME BLOCK POINTER @V201105 00538000
- LA R1,0(,R1) @V201105 00539000
- DROP R1 @V201105 00540000
- USING FCBSECT,R4 @V201105 00541000
- LTR R1,R1 DOES IT EXIST @V201105 00542000
- BZ FSTRLS NO @VA12529 00543000
- DMSFRET DWORDS=6,LOC=(1) RELEASE IT @V201105 00544000
- FSTRLS EQU * 00544200
- LR R5,R2 SAVE CHAIN POINTER @VA12529 00544400
- STH R7,FCBNUM SAVE CURRENT FCB COUNT @VA12529 00544600
- L R7,FCBOSFST GET OSFST ADDRESS @VA12529 00544800
- SR R8,R8 CLEAR REGISTER @VA12529 00545000
- BAL R10,CLRFST1 CHECK FOR OSFST FREE @VA12529 00545200
- BAL R10,FRET GO RELEASE FCB @VA12529 00545400
- LR R2,R5 RESTORE CHAIN POINTER @VA12529 00545600
- LH R7,FCBNUM RESTORE COUNT OF ENTRIES @VA12529 00545800
- BCTR R7,R0 DECREMENT FCBNUM 00546000
- ITERATE BCT R6,LOOP LOOP UNTIL ALL ENTRIES CHECKED 00547000
- STH R7,FCBNUM SET NEW FCBNUM 00548000
- B RETURN GET OUT 00549000
- EJECT 00550000
- * 00551000
- * PROCESS 1ST OPERAND AS A DSRN. 00552000
- * 00553000
- DSRN CLI 1(R5),BLANK 1 DIGIT DSRN 00554000
- BE DSRN1 YES, COMPLETE DDNAME. 00555000
- CLI 1(R5),C'0' ? 2ND CHAR A DIGIT TOO ? 00556000
- BL ERR70E NO, ERROR @VA03259 00557000
- CLI 2(R5),BLANK ? ONLY 2 DIGITS ? 00558000
- BNE ERR70E NO, ERROR EXIT @VA03259 00559000
- MVC REFNUM(2),0(R5) CREAT DDNAME FROM DUMMY 00560000
- B DSRN2 GO PUT DDNAME INTO PLIST. 00561000
- DSRN1 MVI REFNUM,C'0' PAD SINGLE DIGIT WITH ZERO. 00562000
- MVC REFNUM+1(1),0(R5) PUT SINGLE DIGIT IN DUMMY 00563000
- DSRN2 MVC 0(8,R5),DSRNDUM MOVE DUMMY DDNAME TO PLIST 00564000
- EJECT 00565000
- * 00566000
- * VALID DDNAME/DSRN EXISTS. THE NEXT CHECK IS TO SEE IF THERE IS 00567000
- * ALREADY AN ENTRY IN THE FCB TABLE. 00568000
- * 00569000
- SRCHFCB LH R2,FCBNUM GET COUNT OF FCB ENTRIES 00570000
- LTR R2,R2 ? ANY ENTRIES ? 00571000
- BZ SRCHFCB4 NO, SKIP UPDATING POINTERS 00572000
- * 00573000
- * THIS COUNT SHOULD BE CHECKED FOR ZERO IF THE USER CAN CLEAR THE 00574000
- * SYSIN/SYSOUT ENTRIES. 00575000
- * ALSO, PREVENT WILL CONTAIN THE ADDRESS OF THE LAST FCB ENTRY OR 00576000
- * THE LAST ONE BEFORE A MATCH WAS FOUND. 00577000
- * 00578000
- L R4,FCBFIRST PTR TO 1ST ENTRY. 00579000
- SRCHFCB1 CLC FCBDD(8),0(R5) ? FIND A MATCH ? 00580000
- BE SRCHFCB2 YES, SKIP FREE CALL BUT SAVE OLD ENTRY. 00581000
- SRCHFCB6 ST R4,PREVENT SAVE PREVIOUS ENTRY POINT @V201105 00582000
- L R4,0(,R4) UPDATE PTR TO NEXT ENTRY 00583000
- BCT R2,SRCHFCB1 CONTINUE UNTIL NO MORE ENTRIES 00584000
- * 00585000
- * NO MATCH FOUND, SO A NEW ENTRY MUST BE OBTAINED. 00586000
- * 00587000
- SRCHFCB4 EQU * @VA01157 00588000
- CLC 8(8,R5),CLEAR CLEAR REQUEST? @VA01157 00589000
- BE CLR YES, DON'T GET A NEW AREA @VA01157 00590000
- OI FLAG4,NEW SET SVCFREE FLAG ON @VA01157 00591000
- NI FLAG4,255-OLD 00592000
- OI FLAG1,NEW SET ENTRY INDICATOR TO NEW. 00593000
- NI FLAG1,255-OLD 00594000
- LA R0,FCBENSIZ GET N'DBLE WORDS FOR FCBSECT 00595000
- ST R0,PLFREE+8 SAVE IN OLD PLIST 00596000
- DMSFREE DWORDS=(0),TYPE=USER 00597000
- SR R15,R15 CLEAR ERROR REG. 00598000
- ST R1,PLFREE+12 SAVE A(NEWLY ACQUIRED FREE CORE) 00599000
- LH R4,FCBNUM TEST FOR FIRST ENTRY 00601000
- LTR R4,R4 00602000
- BNZ CHAIN BRANCH AROUND INITIALIZATION @VA05963 00603000
- ST R1,FCBFIRST SET UP FIRST FCB ENTRY 00604000
- B CLRSTOR NO PREVIOUS ENTRY @VA05963 00605000
- CHAIN EQU * @VA05963 00606000
- L R4,PREVENT GET PREVIOUS FCB ADDR @VA05963 00607000
- USING FCBSECT,R4 @VA05963 00608000
- STCM R1,B'0111',FCBNEXT+1 POINT FORWARD TO NEW FCB @VA05963 00609000
- DROP R4 @VA05963 00610000
- CLRSTOR EQU * @VA05963 00611000
- LR R4,R1 GET V(FCBSECT) 00612000
- USING FCBSECT,R4 @VA05963 00613000
- MVI 0(R4),X'00' CLEAR THE STORAGE OBTAINED 00614000
- MVC 1(FCBENSIZ*8-1,R4),0(R4) FROM SVCFREE 00615000
- MVC FCBDD(8),0(R5) PUT DDNAME INTO NEW ENTRY 00616000
- LNR R0,R4 00617000
- L R13,CURRSAVE 00618000
- ST R0,EGPR0 00619000
- CKCATFLG TM FLAG3,CATFLG CONCAT SPECIFIED @V201105 00620000
- BNO CHKPERM NO @V201105 00621000
- OI FCBINIT,FCBCATML SET FCB CONCAT INDICATOR @V201105 00622000
- CLC FCBDD(8),=CL8'DOSLIB' IS IT DOSLIB FCB ? @V305001 00623000
- BNE CHKPERM NO, BRANCH @V305001 00624000
- OI FCBINIT,FCBDOSL SET CONCAT DOSLIB FCB @V305001 00625000
- CHKPERM TM FLAG3,PERMBIT PERMANENT FCB @V201105 00626000
- BNO DUM1 NO 00627000
- OI FCBSECT,PERMBIT YES, FLAG IT 00628000
- B DUM1 GO PROCESS OPERAND TWO. 00629000
- * 00630000
- * AN EXISTING ENTRY WAS FOUND. 00631000
- * 00632000
- * A COPY OF IT WILL BE SAVED IN THE EVENT THAT ERRORS ARE DETECTED 00633000
- * BEFORE COMPLETION OF PROCESSING SO THAT A CANCELLED FILEDEF IMPLIES 00634000
- * THAT NO CHANGE HAS BEEN MADE TO EXISTING ENTRIES. 00635000
- * 00636000
- SRCHFCB2 EQU * @VA01157 00637000
- CLC 8(8,R5),CLEAR CLEAR REQUEST? @VA01157 00638000
- BE CLRA YES,GET RID OF IT @VA01157 00639000
- TM FLAG3,CATFLG CONCAT REQUESTED? @VA01157 00640000
- BNO SRCHFCB8 NO @V201105 00641000
- OI FCBINIT,FCBCATML INDICATE CONCATENATION @VA14030 00641500
- CLC FCBDSNAM(16),STATFN REQUESTED FN FT=EXISTING FN @V201105 00642000
- BNE SRCHFCB6 NO, LOOK FOR MORE @V201105 00643000
- SRCHFCB8 TM FLAG3,NOCH NOCHANGE ON EXISTING FCB @V201105 00644000
- BZ SRCHFCB3 NOPE. REVISE CURRENT OSCB 00645000
- LR R0,R4 RETURN THE A (SPECIFIC OSCB) 00646000
- L R13,CURRSAVE RESTORE USER SAVE AREA 00647000
- ST R0,EGPR0 SAVE FCB ADDRESS 00648000
- B RETURN 00649000
- SRCHFCB3 OI FLAG1,OLD INDICATE MATCH FOUND (OLD ENTRY) 00650000
- LNR R0,R4 00651000
- L R13,CURRSAVE 00652000
- ST R0,EGPR0 00653000
- SRCHFCB5 NI FLAG1,255-NEW SET ENTRY INDICATOR TO OLD 00654000
- MVC OLDENTRY(FCBENSIZ*8),0(R4) SAVE OLDER COPY 00655000
- NI FCBINIT,255-FCBCATML TURN OFF CONCATENATION @VA14030 00655500
- XC FCBMEMBR(12),FCBMEMBR CLEAR FST & MEMBER @VA04338 00656000
- B CKCATFLG CHECK FOR CONCAT FLAG @V201122 00657000
- EJECT 00658000
- *********************************************************************** 00659000
- * 00660000
- * 00661000
- * PROCESSING OF OPERAND TWO 00662000
- * 00663000
- * 00664000
- *********************************************************************** 00665000
- * 00666000
- *********************************************************************** 00667000
- * 00668000
- * PROCESS THE DUMMY OPERAND 00669000
- * 00670000
- ********************************************** ************************ 00671000
- * 00672000
- * PLIST STILL POINTS TO THE FIRST OPERAND (PARAMETER). 00673000
- * 00674000
- DUM1 EQU * 00675000
- CLC DUMMY(8),8(R5) ? DUMMY OPTION ? 00676000
- BNE D1 NO, GO CHECK FOR DSK. 00677000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 00678000
- LA R9,16(,R5) POSITION PTR AFTER 'DUMMY' 00679000
- B D1BB AND ACT LIKE 'DISK' DEVICE-TYPE 00680000
- EJECT 00681000
- *********************************************************************** 00682000
- * 00683000
- * PROCESS THE DISK OPERAND 00684000
- * 00685000
- *********************************************************************** 00686000
- * 00687000
- * PLIST (R5) STILL POINTS TO THE DDNAME (PARAMETER 1). 00688000
- * 00689000
- D1 CLC DISK(8),8(R5) 'DISK' DEVICE 00690000
- BNE T1 NEITHER, TRY TAPE OPTION 00691000
- TM FLAG1,NEW IS THIS A 'NEW' FILEDEF? @VA06191 00692000
- BO D1AA BRANCH IF YES @VA06191 00693000
- CLI FCBDEV,FCBDSK WAS OLD DEVTYP DISK? @VA06191 00694000
- BE D1AA BRANCH IF YES @VA06191 00695000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 00696000
- MVC FCBDSNAM(8),FILE DEFAULT FILENAME EQ FILE @VA09122 00696200
- MVC FCBDSTYP(8),0(R5) DEFAULT FILETYPE TO DDNAME @VA09122 00696400
- MVC FCBDSMD(2),A1 DEFAULT MODE EQ A1 @VA09122 00696600
- D1AA LA R9,16(,R5) POSITION R9 AFTER 'DISK' 00697000
- MVI FCBDEV,FCBDSK SET DISK DEVICE CODE 00698000
- * 00699000
- * REMEMBER...R8 HAS A(OPTION START) IF ANY; OTHERWISE, START OF PLIST 00700000
- D1BB CR R9,R8 CHEK FOR START OF OPTIONS 00701000
- BE DEFAULT IF SO, DEFAULT NAME,TYPE AND MODE 00702000
- * 00703000
- * IF FILEDEF IS ISSUED FROM THE TERMINAL, A '(' WILL REMAIN IN PLIST; 00704000
- * IF FILEDEF IS CALLED VIA 'SVC', THERE IS NO '(' AT THIS POINT...THUS 00705000
- * THERE ARE CHEKS FOR BOTH 'START OF OPTIONS' CONDITIONS: 00706000
- * R9=R8 ... SVC CALL '(' ... TERMINAL COMMAND 00707000
- * 00708000
- CLI 0(R9),C'(' SAME FOR TERM. COMMAND... 00709000
- BE DEFAULT 00710000
- C R6,0(R9) CHEK END OF LINE 00711000
- BNE BUMPR9 IF NOT, TRY NEXT PLIST POSITION 00712000
- * 00713000
- DEFAULT EQU * @VA04338 00714000
- TM FLAG1,NEW IS THIS A NEW FILEDEF ? @VA04338 00715000
- BO DEFFNFT GO GET DEFAULT FN FT @VA06191 00716000
- CLI FCBDEV,FCBDUM DUMMY DEVICE? @VA06191 00717000
- BNE STATCALL BRANCH IF NOT, KEEP FN FT @VA06191 00718000
- DEFFNFT EQU * @VA06191 00719000
- MVC FCBDSNAM(8),FILE PUT IN DEFAULT NAME 'FILE' @VA04338 00720000
- MVC FCBDSNAM+8(8),0(R5) AND USE DDNAME AS FILETYPE 00721000
- DEFMODE MVC FCBDSMD(2),A1 PROVIDE DEFAULT MODE 00722000
- STATCALL MVC STATFN(18),FCBDSNAM INFO. FOR STATE CALL 00723000
- CLC 0(8,R9),=CL8'DSN' OS REQUESTED @V201105 00724000
- BNE FLDSTATE NO @V201105 00725000
- DMSFREE DWORDS=17,TYPE=USER GET WORK AREA @V201105 00726000
- LR R3,R1 ADDR. TO R3 @V201105 00727000
- CLC 8(8,R9),=CL8'?' PROMPT WANTED ? @V201105 00728000
- BNE NOPROMPT NO @V201105 00729000
- LA R9,16(0,R9) GET PAST '?' @V201105 00730000
- REREAD DMSERR TEXT='ENTER DATA SET NAME:',NUM=220,LET=R,DOT=NO 00731000
- STCM R3,B'0111',DSNBUF SET TERMINAL READ PBIST @V201105 00732000
- LA R1,CONREAD PLIST TO R1 @V201105 00733000
- SVC 202 READ OS DSNAME @V201105 00734000
- ICM R15,B'0111',DSNBYTE GET LENGTH READ @V201105 00735000
- LTR R15,R15 ZERO BYTES @V201122 00736000
- BZ BADDSN YES, ERROR @V201122 00737000
- SH R15,=H'44' CHECK FOR > 44 CHARACTERS @V201122 00738000
- BNP OSDSNSET LESS THAN 44, CONTINUE @V201122 00739000
- CKOVR44 LA R1,43(R15,R3) GET ADDR OF NEXT BYTE CHECK @V201122 00740000
- CLI 0(R1),C' ' ANY NON BLANKS SPECIFIED? @V201122 00741000
- BNE BADDSN YES, THEN ERROR @V201122 00742000
- BCT R15,CKOVR44 CHECK NEXT CHARACTER @V201122 00743000
- B OSDSNSET GO COMPLETE FCB @V201122 00744000
- NOPROMPT LR R15,R3 USE R15 FOR WORK @V201105 00745000
- MVI 0(R3),C' ' BLANK DSNAME BLOCK @V201105 00746000
- MVC 1(44,R3),0(R3) PLUS ONE @V201105 00747000
- LA R1,45(0,R3) SET END OF DSNAME BLOCK MINUS 3 @V201105 00748000
- NXTPARM LA R9,8(0,R9) NEXT PARAMETER @V201105 00749000
- CLI 0(R9),C'(' END OF PARAM @V201105 00750000
- BE QUALEND YES, RELEASE WORK AREA @V201105 00751000
- C R6,0(R9) END OF PARAM @V201105 00752000
- BE QUALEND YES, RELEASE WORK AREA @V201105 00753000
- CR R8,R9 END OF PARAM @V201105 00754000
- BE QUALEND YES @V201105 00755000
- MVC 0(8,R15),0(R9) 1ST OS QUALIFIER (OR NEXT) @V201105 00756000
- NXTQUAL LA R15,1(0,R15) NEXT CHAR. THIS QUALIFIER @V201105 00757000
- CR R15,R1 CHECK AGAINST 44 BYTE LIMIT @V201105 00758000
- BH BADDSN IF HIGH ERROR @V201105 00759000
- CLI 0(R15),C' ' BLANK @V201105 00760000
- BE PERIOD YES, SET PERIOD @V201105 00761000
- CLI 0(R15),C'.' IS PERIOD SPECIFIED @V201105 00762000
- BE BADDSN YES, THEN BAD DATA SET NAME @V201105 00763000
- B NXTQUAL LOOK AT NEXT CHAR @V201105 00764000
- PERIOD MVI 0(R15),C'.' SET QUALIFIER END @V201105 00765000
- LA R15,1(0,R15) GET PAST PERIOD @V201105 00766000
- B NXTPARM CHECK FOR ANOTHER QUALIFIER @V201105 00767000
- QUALEND SH R15,=H'1' BACK OFF LAST PERIOD @V201105 00768000
- CR R15,R3 WERE ANY QUALIFIERS ENTERED @V201105 00769000
- BNH BADDSN NO, ERROR @V201105 00770000
- MVI 0(R15),C' ' RESET LAST PERIOD TO BLANK @V201105 00771000
- OSDSNSET LR R2,R3 SET TO SCAN FOR INVLD NAME @V201105 00772000
- CLI 0(R2),C'.' 1ST CHAR = '.' @V201105 00773000
- BE BADDSN YES, ERROR @V201105 00774000
- DSNLP LA R15,43(,R3) POINT TO END OF DSNAME @V201105 00775000
- SR R15,R2 LENGTH TO TRT @V201105 00776000
- BM BADDSN LONGER THAN 44 CHAR @V201105 00777000
- EX R15,OSTRT SCAN FOR INVLD CHAR @V201105 00778000
- BZ GOODDSN NO INVLD CHAR @V201105 00779000
- LR R2,R1 SET R2 TO INVLD CHAR @V201105 00780000
- CLI 0(R2),C'.' IS CHAR '.' @V201105 00781000
- BNE BADDSN NO, ERROR @V201105 00782000
- LA R2,1(,R2) NEXT CHAR @V201105 00783000
- CLI 0(R2),C'.' IS THIS '.' ALSO @V201105 00784000
- BNE DSNLP NO, OK @V201105 00785000
- BADDSN LR R1,R3 SET TO RELEASE WORK AREA @V201105 00786000
- DMSFRET DWORDS=17,LOC=(1) @V201105 00787000
- B ERR221E @V201105 00788000
- OSTRT TRT 0(*-*,R2),OSTBL EXECUTED SCAN OF DSNAME @V201105 00789000
- GOODDSN ST R3,FCBOSDSN SET DSN BLOCK ADR IN FCB @V201122 00790000
- TM FLAG1,IDMATCH FILEID MATCH IN ANOTHER FCB? @VA05963 00791000
- BNO USEDSN NO, DO STATE @VA05963 00792000
- LR R1,R3 SET TO RELEASE WORK AREA @V201122 00793000
- DMSFRET DWORDS=17,LOC=(1) @V201122 00794000
- B ERR224E PRINT ERROR MSG @V201122 00795000
- USEDSN LA R1,48(,R3) RELEASE UNUSED WORK AREA @V201122 00796000
- DMSFRET DWORDS=11,LOC=(1) @V201122 00797000
- FLDSTATE EQU * @V201122 00798000
- LA R1,STATLST PURELY SYNTACTICAL 'STATE' 00799000
- XC FCBDSMD(2),FCBDSMD CLEAR FCB INDICATOR @VA12255 00799500
- ICM R1,B'1000',=X'01' INDICATE CALL IS FROM DMSFLD @VA03409 00800000
- MVC STATAST(FOUR),ASTERISK FOR REUSABILITY @VA06220 00801000
- L R15,ASTATE ... @V305066 00802000
- BALR R14,R15 ... @V305066 00803000
- MVC FCBDSMD(2),STATFM RESTORE FILE MODE IND @VA12255 00803500
- MVC A1(2),=CL2'A1' RESTORE DEFAULT MODE @V201105 00804000
- LTR R15,R15 00805000
- BZ DCONT IGNORE IF FOUND 00806000
- CH R15,=H'28' 00807000
- BE DCONT IGNORE 'NOT FOUND' 00808000
- CH R15,=H'80' OS DATA SET NOT FOUND @V201105 00809000
- BNL DCONT YES, OK @V201105 00810000
- CH R15,=H'36' ALSO IGNORE 'DISK NOT ACCESSED' 00811000
- BNE EXIT SYNTAX ERROR 00812000
- LA R3,24(R1) POINT TO MODE LETTER @VA03409 00813000
- DMSERR NUM=69,LET=I,TEXT='DISK ''..'' NOT ACCESSED', X00814000
- SUB=(CHARA,((R3),1)) GIVE INFORMATION MSG 00815000
- DCONT XR R15,R15 CLEAR RETURN CODES FROM STATE 00816000
- C R6,0(R9) IF END OF LINE, PROCESS DEF'LT OPTNS 00817000
- BE D2C 00818000
- B D2 IF NOT,PROCESS USER OPTIONS 00819000
- * 00820000
- BUMPR9 LA R9,8(,R9) BUMP R9 TO NEXT PLIST POSITION 00821000
- C R6,0(R9) IF END OF LINE, ERROR - NO FILETYPE 00822000
- BE ERR23E 00823000
- CLI 0(R9),C'(' CHEK OPTION START (TERM. COMMAND) 00824000
- BE ERR23E ALSO ERROR 00825000
- CR R9,R8 DITTO FOR START OF OPTIONS (SVC CALL 00826000
- BE ERR23E 00827000
- CLI FLAG1,NEW BUILDING NEW FCB? @VA05963 00828000
- BE COMPID1 YES, CHECK FILEID MATCH @VA05963 00829000
- CLC FCBDSNAM(16),D16(R5) SAME ID AS PREVIOUS ENTRY? @VA05963 00830000
- BNE DELETDSN NO, DELETE DSN @VA05963 00831000
- CLC FCBDSMD(D01),D32(R5) MODE LETTER EQUAL @VA07707 00832000
- BE CHKNXT YES, GET NEXT PARAMETER @VA05963 00833000
- DELETDSN EQU * @VA05963 00834000
- XC FCBOSDSN,FCBOSDSN DELETE RESIDUAL DSN @VA05963 00835000
- MOVEID EQU * @VA05963 00836000
- MVC FCBDSNAM(16),16(R5) USE USER NAME & TYPE 00837000
- B CHKNXT LOOK FOR ANOTHER PARAMETER @VA05963 00838000
- COMPID1 EQU * @VA05963 00839000
- DROP R4 @VA05963 00840000
- USING FCBSECT,R15 @VA05963 00841000
- L R15,FCBFIRST GET START OF FCB CHAIN @VA05963 00842000
- COMPID2 EQU * @VA05963 00843000
- CLC FCBDSNAM(16),D16(R5) PLIST NAME AND TYPE MATCH? @VA05963 00844000
- BE COMPID4 YES, CHECK MODE @VA05963 00845000
- COMPID3 EQU * @VA05963 00846000
- L R15,0(,R15) GET CHAIN PTR AT LABEL FCBNEXT @VA05963 00847000
- LA R15,0(,R15) CLEAR HIGH ORDER BYTE @VA05963 00848000
- LTR R15,R15 END OF CHAIN? @VA05963 00849000
- BNZ COMPID2 NO, CHECK NEXT FCB @VA05963 00850000
- B MOVEID PUT FILEID IN FCB @VA05963 00851000
- COMPID4 EQU * @VA05963 00852000
- CLC FCBDSMD(1),ASTERISK MODE=*? @VA05963 00853000
- BE COMPID5 YES, CHECK OS DSN @VA05963 00854000
- CLC D32(1,R5),ASTERISK MODE=*? @VA05963 00855000
- BE COMPID5 YES,CHECK OS DSN @VA05963 00856000
- CLC FCBDSMD(1),D32(R5) MODES EQUAL? @VA05963 00857000
- BNE COMPID3 NO, CHECK NEXT FCB @VA05963 00858000
- COMPID5 EQU * @VA05963 00859000
- OI FLAG1,IDMATCH FILEID MATCH IN OUTSTANDING FCB @VA05963 00860000
- CLC FCBOSDSN,ZERO OS DSN OUTSTANDING? @VA05963 00861000
- BNE ERR224E YES, PRINT ERROR MSG @VA05963 00862000
- B COMPID3 NO, CHECK NEXT FCB @VA05963 00863000
- CHKNXT EQU * @VA05963 00864000
- DROP R15 @VA05963 00865000
- USING FCBSECT,R4 @VA05963 00866000
- LA R9,8(,R9) BUMP R9 TO NEXT PLIST POSITION 00867000
- * 00868000
- C R6,0(R9) IF END OF LINE, USE DEFAULT MODE 00869000
- BE DEFMODE 00870000
- CLI 0(R9),C'(' CHEK OPTION START (TERM. COMMAND)... 00871000
- BE DEFMODE ALSO DEFAULT MODE 00872000
- CR R9,R8 DITTO FOR START OF OPTIONS (SVC CALL 00873000
- BE DEFMODE 00874000
- CLC 0(8,R9),=CL8'DSN' OS REQUEST @V201105 00875000
- BE DEFMODE YES, DEFAULT MODE @V201105 00876000
- CLI 0(R9),C'*' IS MODE '*' ? V0638 00877000
- BE USRMODE IF SO, MODE NUMBER NOT ALLOWED V0638 00878000
- CLI 0(R9),C' ' IS MODE MISSING @VA11480 00878100
- BNE MODENUM NO, CHECK FOR MODE NUMBER @VA11480 00878200
- LA R9,8(,R9) BUMP TO NEXT PLIST SLOT @VA11480 00878300
- B DEFMODE BR - USE DEFAULT MODE @VA11480 00878400
- MODENUM EQU * @VA11480 00878500
- CLI 1(R9),C' ' IS MODE NUMBER MISSING? V0638 00879000
- BNE USRMODE IF NOT, OKAY V0638 00880000
- MVI 1(R9),C'1' IF MISSING, DEFAULT IT TO 1 V0638 00881000
- USRMODE MVC FCBDSMD(2),0(R9) USE HIS MODE V0638 00882000
- LA R9,8(,R9) BUMP R9 TO NEXT PLIST SLOT 00883000
- B STATCALL NOW CHEK FOR SYNTAX ERRORS 00884000
- D2C TM FLAG1,NEW IS IT A NEW ENTRY 00885000
- BO DT13 YES, PROCESS DEFAULTS 00886000
- B EXIT NO, DON'T OVERRIDE EXISTING FIELDS 00887000
- D2 CLI 0(R9),C'(' CHEK FOR TERM COMMAND 00888000
- BNE D2A NO 00889000
- LA R9,8(,R9) YES, SKIP BY '('... 00890000
- D2A CR R9,R8 IF R9=R8, PROCESS USER OPTIONS 00891000
- BNE D2AB ERROR CONDITION P1017 00892000
- TM VALFLAG,X'FF' P1017 00893000
- BZ DT0 'DISK' DEVICE IF NOT SET P1017 00894000
- B DT00 OTHER DEVICES ALREADY SET P1017 00895000
- D2AB EQU * P1017 00896000
- LR R5,R9 OTHERWISE, INVALID OPTIONS (R9>R8) 00897000
- B ERR70E OR XTRA OPERAND AFTER MODE (R9<P1017 00898000
- EJECT 00899000
- * 00900000
- * KEYWORD SEARCH FOR BDAM DISK PROCESSING 00901000
- * 00902000
- DT0 OI VALFLAG,DSKDEV INDICATE DISK FOR OPTN SCAN 00903000
- DT00 MVC KEYWORD(8),KEYLEN SEARCH FOR 'KEYLEN' OPTN 00904000
- LR R5,R8 SET R5 TO OPTION START @V201105 00905000
- BAL R10,SCAN SCAN INPUT LINE 00906000
- CLI FLAG2,MATCH ?SCORE? 00907000
- BNE XTENTEST NO, GO CHECK XTENT 00908000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE 00909000
- BAL R10,CONVERT CHECK KEYLENGTH VALUE 00910000
- STC R7,JFCKEYLE SET UP JFCB FIELD 00911000
- XTENTEST LR R5,R8 RESET KEYWORD OPTION POINTER 00912000
- MVC KEYWORD(8),XTENT SET IEYWORD = XTENT 00913000
- BAL R10,SCAN SCAN INPUT LINE 00914000
- CLI FLAG2,MATCH ?BULLSEYE? 00915000
- BE XTENTCVT YES, GO CONVERT THE SINNER 00916000
- TM FLAG1,NEW NEW ENTRY? 00917000
- BNO LIMCTEST NO DON'T SET DEFAULTS 00918000
- MVI FCBXTENT+1,DXTENT MOVE IN DEFAULT VALUE 00919000
- B LIMCTEST GO TO NEXT TEST 00920000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE 00921000
- XTENTCVT BAL R10,CONVERT CHECK XTENT VALUE AND CONVERT IT 00922000
- STH R7,FCBXTENT SET UP FCB FIELD 00923000
- LIMCTEST LR R5,R8 RESET KEYWORD OPTION POINTER 00924000
- MVC KEYWORD(8),LIMCT SET KEYWORD = LIMCT 00925000
- BAL R10,SCAN SCAN INPUT LINE 00926000
- CLI FLAG2,MATCH ?HIT? 00927000
- BNE OPCDTEST NO, GO CHECK OPTCD 00928000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE 00929000
- BAL R10,CONVERT CHECK LIMCT VALUE 00930000
- STC R7,JFCLIMCT SET UP JFCB FIELD 00931000
- OPCDTEST LR R5,R8 RESET KEYWORD OPTION POINTER 00932000
- MVC KEYWORD(8),OPTCD SET KEYWORD = OPTCD 00933000
- BAL R10,SCAN SCAN INPUT LINE 00934000
- CLI FLAG2,MATCH ?ON TARGET? 00935000
- BNE DT1 NO, GO CHECK DSORG 00936000
- LA R9,3 COMBO OF 3 OPTIONS POSSIBLE 00937000
- MVI JFCOPTCD,RESET SET OPTCD TO '0' 00938000
- LR R10,R5 SAVE OPTIONS PTR P1017 00939000
- EOPTEST CLI 0(R5),EOPTCD ? OPTION = EXTENDED SEARCH ? 00940000
- BNE FOPTEST NO 00941000
- OI JFCOPTCD,EOPT SET CODE 00942000
- B COMBO SCRAM 00943000
- FOPTEST CLI 0(R5),FOPTCD ? OPTION = FEEDBACK ? 00944000
- BNE AOPTEST NO 00945000
- OI JFCOPTCD,FOPT SET CODE 00946000
- B COMBO SCRAM 00947000
- AOPTEST CLI 0(R5),AOPTCD ? OPTION = ACTUAL ADDRESSING ? 00948000
- BNE ROPTEST NO 00949000
- OI JFCOPTCD,AOPT SET CODE 00950000
- B COMBO SCRAM 00951000
- ROPTEST CLI 0(R5),ROPTCD ? OPTION = RELEATIVE ADDRESSING ? 00952000
- BE SETROPT YES P1017 00953000
- LR R5,R10 IF NOT, MUST BE ERROR P1017 00954000
- B ERR29E P1017 00955000
- SETROPT EQU * P1017 00956000
- OI JFCOPTCD,ROPT SET CODE 00957000
- COMBO LA R5,1(,R5) COMBINATION CHEK 00958000
- CLI 0(R5),BLANK ANY LEFT ? 00959000
- BE DT1 NO. CARRY ON 00960000
- BCT R9,EOPTEST YES. SEE WHAT IT IS... 00961000
- LR R5,R10 RESTORE OPTION PTR P1017 00962000
- B ERR29E MORE THAN 3 OPTCD'S P1017 00963000
- DT1 EQU * P1017 00964000
- TM JFCOPTCD,AOPT+ROPT P1017 00965000
- LR R5,R10 P1017 00966000
- BO ERR29E ERROR IF 'A' AND 'R' BOTH P1017 00967000
- LR R5,R8 00968000
- * 00969000
- * PROCESS DSORG KEYWORD 00970000
- * 00971000
- MVC KEYWORD(8),DSORG SET KEYWORD="DSORG" 00972000
- BAL R10,SCAN SCAN INPUT LINE 00973000
- CLI FLAG2,MATCH WAS DSORG ENTERED? 00974000
- BNE DT2A NOPE 00975000
- CLC PSORG(3),0(R5) ? DSORG = PHYSICAL SEQUENTIAL ? 00976000
- BE DT1D YES 00977000
- CLC DAORG(3),0(R5) ? DSORG = DIRECT ACCESS ? 00978000
- BNE DT1A NO. 00979000
- MVI FCBDSORG,DSORGDA 00980000
- B DT2B 00981000
- DT1A CLC POORG(3),0(R5) DSORG = PARTIONED ? @VA04918 00982000
- BNE ERR29E 00983000
- MVI FCBDSORG,DSORGPO 00984000
- B DT2B 00985000
- DT1D MVI FCBDSORG,DSORGPS DEFAULT TO "PS" 00986000
- DT2B MVI FCBDSORG+1,0 CLEAR DSORG+1 00987000
- DT2A LR R5,R8 RESET KEYWORD OPTION POINTER 00988000
- MVC KEYWORD(8),DISP SET KEYWORD = 'DISP' 00989000
- BAL R10,SCAN SCAN INPUT LINE 00990000
- CLI FLAG2,MATCH 00991000
- BNE DT2E 00992000
- CLC MOD(8),0(R5) DISP = MOD? 00993000
- BNE ERR29E ONLY MOD IS ALLOWED 00994000
- MVI JFCBIND2,X'80' SET MOD 00995000
- DT2E LR R5,R8 RESET KEYWORD OPTION POINTER 00996000
- * 00997000
- * PROCESS RECFM KEYWORD. 00998000
- * 00999000
- DT2C MVC KEYWORD(8),RECFM SET UP FOR SCAN FOR RECFM 01000000
- BAL R10,SCAN INVOKE THE KEYWORD SCANNER 01001000
- CLI FLAG2,MATCH RECFM KEYWORD FOUND ? 01002000
- BNE DT6 NOPE 01003000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE. 01004000
- LA R9,RECFTAB SET RECFM TABLE SEARCH 01005000
- LA R2,6 LENGTH OF EACH ENTRY 01006000
- LA R3,RECFEND 01007000
- RFCHEK CLC 0(5,R9),0(R5) TABLE ENTRY=PLIST ENTRY 01008000
- BNE RFBXLE NO, TRY AGAIN 01009000
- MVC FCBRECFM(1),5(R9) SET RECFM IN FCB 01010000
- B DT6 AND CONTINUE 01011000
- RFBXLE BXLE R9,R2,RFCHEK 01012000
- B ERR29E ERROR, NOT FOUND 01013000
- DT6 LR R5,R8 RESET PLIST TO 1ST KEYWORD 01014000
- * 01015000
- * PROCESS AUXILIARY PROCESSING ROUTINE INDICATION FOR THIS DATA SET 01016000
- * 01017000
- DT6A MVC KEYWORD(8),AUXPROC SCAN FOR "AUXPROC" 01018000
- BAL R10,SCAN 01019000
- CLI FLAG2,MATCH WAS "AUXPROC" FOUND? 01020000
- BNE DT6B NO. 01021000
- MVC FCBPROC(4),0(R5) SET A(PROCESSING ROUTINE) INTO OSCB 01022000
- DT6B LR R5,R8 01023000
- * 01024000
- * PROCESS LRECL KEYWORD 01025000
- * 01026000
- MVC KEYWORD(8),LRECL SCAN FOR LRECL. 01027000
- BAL R10,SCAN INVOKE SCANNER 01028000
- CLI FLAG2,MATCH FOUND LRECL ? 01029000
- BNE DT8 NO 01030000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE. 01031000
- BAL R10,CONVERT CHECK LRECL VALUE AND CONVERT IT 01032000
- C R7,MAXREC MORE THAN 32,760 ? @VA13014 01032300
- BH CONV4 YES, THAT'S THE MAXIMUM @VA13014 01032600
- STH R7,FCBLRECL PUT BINARY LRECL VALUE IN NEW ENTRY 01033000
- B DT8 SKIP. 01034000
- DT8 LR R5,R8 RESET TO 1ST KEYWORD ADDRESS 01035000
- * 01036000
- * PROCESS BLOCK SIZE KEYWORD. 01037000
- * 01038000
- MVC KEYWORD(8),BLOCK SCAN FOR BLOCK SIZE 01039000
- BAL R10,SCAN INVOKE SCANNER 01040000
- CLI FLAG2,MATCH BLKSIZ FOUND ? 01041000
- BE BLKYES YES P3100 01042000
- LR R5,R8 RESET TO 1ST KEYWORD V0212 01043000
- MVC KEYWORD(8),BLKSIZE CHEK THE OTHER ONE P3100 01044000
- BAL R10,SCAN P3100 01045000
- CLI FLAG2,MATCH P3100 01046000
- BNE DT8A NO, NEXT OPTION @V201105 01047000
- BLKYES EQU * P3100 01048000
- * SCAN RETURNS WITH PLIST POINTING TO THE KEYWORD VALUE. 01049000
- BAL R10,CONVERT CHECK BLKSIZ VALUE AND CONVERT IT 01050000
- C R7,MAXREC MORE THAN 32,760 ? @VA13014 01050300
- BH CONV4 YES, THAT'S THE MAXIMUM @VA13014 01050600
- STH R7,FCBBLKSZ PUT VINARY BLKSIZ VALUE IN NEW ENTRY 01051000
- DT8A LR R5,R8 RESET R5 @V201105 01052000
- MVC KEYWORD(8),MEMBER LOOK FOR MEMBER OPTION @V201105 01053000
- BAL R10,SCAN @V201105 01054000
- CLI FLAG2,MATCH FOUND @V201105 01055000
- BNE DT10 NO, DO NEXT @V201105 01056000
- CLI 0(R5),X'FF' END OF OPTIONS @V201105 01057000
- BE ERR29E YES @VA03258 01058000
- CLI 0(R5),C')' END OF OPTIONS @V201105 01059000
- BE ERR29E YES @VA03258 01060000
- MVC FCBMEMBR(8),0(R5) PUT MEMBER NAME IN FCB @V201105 01061000
- * 01062000
- * PROCESS MODE KEYWORD FOR TAPE OPTION (TAP). 01063000
- * 01064000
- DT10 LR R5,R8 RESTORE R5 TO 1ST KEYWORD 01065000
- XR R7,R7 CLEAR R7 FOR CODE USE 01066000
- * 'CODE' IN COMMENTS REFERS TO DISPLACEMENT IN 'TRTCH' ASSIGNED TO 01067000
- * KEYWORD OPERANDS. 01068000
- MVC KEYWORD(8),DEN SEARCH FOR DENSITY KEYWORD 01069000
- BAL R10,SCAN USE 'SCAN' ROUTINE FOR KEYWORDS 01070000
- CLI FLAG2,MATCH 'DEN' FOUND ? 01071000
- BNE TRK9SRCH NO. 01072000
- LA R9,DENTAB YES - SEARCH FOR VALID DEN 01073000
- DENSRCH CLC 0(8,R9),0(R5) IS GIVEN DENSITY A VALID ONE ? 01074000
- BE GOODEN YES - CONTINUE 01075000
- CLC 0(8,R9),DENEND NO - IS THIS END OF DEN TABLE ? 01076000
- BE ERR29E SORRY, THAT'S IT 01077000
- LA R9,8(,R9) 01078000
- B DENSRCH OTHERWISE, GET ANOTHER 01079000
- * 01080000
- GOODEN OI TAPSW,DENSITY YES - SET DENSITY SWITCH 01081000
- MVC TDENSITY(4),0(R5) SAVE DENSITY 01082000
- TRK9SRCH LR R5,R8 RESTORE R5 TO 1ST KEYWORD 01083000
- MVC KEYWORD(8),NINTRACK SEARCH FOR 9-TRACK OPTION 01084000
- BAL R10,SCAN 'SCAN' FOR OPTION 01085000
- LR R5,R8 RESET OPTION PTR 01086000
- CLI FLAG2,MATCH '9TRACK' FOUND ? 01087000
- BNE TRK7SRCH NO. 01088000
- OI TAPSW,TRK9 YES - SET 9-TRACK SWITCH 01089000
- * 01090000
- TRK7SRCH MVC KEYWORD(8),SEVTRACK SEARCH FOR 7-TRACK OPTION 01091000
- BAL R10,SCAN GOT O 'SCAN' FOR OPTION 01092000
- LR R5,R8 RESET OPTION PTR 01093000
- CLI FLAG2,MATCH '7TRACK' FOUND ? 01094000
- BNE TRTSRCH NO. 01095000
- OI TAPSW,TRK7 YES - SET 7-TRACK SWITCH 01096000
- * 01097000
- TRTSRCH MVC KEYWORD(8),TRKTCH SEARCH FOR TRTCH KEYWORD 01098000
- BAL R10,SCAN USE 'SCAN' FOR KEYWORD 01099000
- XR R7,R7 CLEAR FOR CODE USE 01100000
- CLI FLAG2,MATCH 'TRTCH' FOUND ? 01101000
- BNE DENCHEK NO. 01102000
- OI TAPSW,TRTFLAG YES - SET TRT SWITCH 01103000
- TM TAPSW,TRK9 DID USER SPEC'FY 9-TRACK ? 01104000
- BO ERR35E IF SO, ERROR 01105000
- * 01106000
- * SEARCH TRTAB TABLE TO GET DISPLACEMENT FOR 'TRTCH' 01107000
- LA R9,TRTAB START OF TABLE 01108000
- AGAIN CLC 0(3,R9),0(R5) CHEK FOR O, OC,OT,E,ET P1017 01109000
- BE VALID FOUND 01110000
- CLC 0(2,R9),TRTEND CHEK END OF TABLE 01111000
- BE ERR29E ERROR IF NOTHING FOUND 01112000
- LA R9,4(,R9) BUMP INDEX AND P1017 01113000
- B AGAIN CHEK AGAIN 01114000
- * 01115000
- VALID IC R7,3(R9) GET CODE FOR 'TRTCH' DISPL P1017 01116000
- TM TAPSW,DENSITY DENSITY GIVEN? 01117000
- BZ EQUAL7 NO. DEFAULT DENSITY. 01118000
- B DENSNUM YES - CONTINUE LATER 01119000
- * 01120000
- DENCHEK TM TAPSW,DENSITY DENSITY GIVEN? (NO TRTCH COND.) 01121000
- BZ CHEKNEW NO - DROP TO CHEK FOR NEW ENTRY 01122000
- DENSNUM CLC TDENSITY(4),SIXTN00 COMP DENSITY TO 1600 BPI 01123000
- BE VAL1600 01124000
- CLC TDENSITY(4),HIDENSTY DENSITY 6250 ? @V200414 01125000
- BE VAL6250 YES..VALIDATE @V200414 01126000
- CLC TDENSITY(4),EIGHT00 COMP DENSITY TO '800' BPI 01127000
- BL CHEKLOW 01128000
- BE CHEKEQL 01129000
- VAL1600 TM TAPSW,TRK7 CHEK FOR '7TRACK' 01130000
- BO ERR35E 01131000
- TM TAPSW,TRTFLAG 'TRTCH' IS EQUALLY BAD 01132000
- BO ERR35E 01133000
- LA R7,16(,R7) SET 9 TRACK, 1600 BPI 01134000
- B DT11 01135000
- * 01136000
- VAL6250 TM TAPSW,TRK7 CHECK FOR 7 TRACK @V200414 01137000
- BO ERR35E INVALID TAPE MODE @V200414 01138000
- TM TAPSW,TRTFLAG CHECK FOR TRTCH @V200414 01139000
- BO ERR35E INVALID TAPE MODE @V200414 01140000
- LA R7,17(,R7) SET 9TRACK 6250 BPI @V200414 01141000
- B DT11 @V200414 01142000
- CHEKEQL TM TAPSW,TRK7 IF =800, CHEK FOR 7TRACK 01143000
- BO EQUAL7 IF 7TRACK, DROP 01144000
- TM TAPSW,TRTFLAG BETTER CHEK 'TRTCH' ALSO (7TRK)... 01145000
- BO EQUAL7 01146000
- XR R7,R7 DEFAULT TO PROVIDE 9TRK,800 BPI (0) 01147000
- B DT11 01148000
- EQUAL7 LA R7,1(,R7) 7TRACK, 800 BPI CODE (1) 01149000
- TM TAPSW,TRTFLAG 'TRTCH' SPEC'D? 01150000
- BO DT11 YES. 01151000
- LA R7,2(,R7) NO, DEFAULT TO 'O' 01152000
- B DT11 01153000
- * 01154000
- CHEKLOW TM TAPSW,TRK9 MAKE SURE IT'S 7 TRACK... 01155000
- BNZ ERR35E 01156000
- TM TAPSW,TRTFLAG 'TRTCH' SPEC'D? 01157000
- BO CHEK200 YES 01158000
- LA R7,2(,R7) NO, DEFAULT TO 'O' 01159000
- CHEK200 EQU * 01160000
- CLC TDENSITY(4),TWO00 CHEK FOR 200 BPI 01161000
- BH FIVE56 IF NOT, DROP 01162000
- LA R7,11(,R7) PROVIDE 7TRK, 200 BPI CODE (11) 01163000
- B DT11 01164000
- FIVE56 LA R7,6(,R7) IF >200, USE 7TRK, 556 BPI CODE (6) 01165000
- B DT11 01166000
- CHEKNEW TM FLAG1,NEW NEW ENTRY? 01167000
- BNO DT14 NO, DON'T SET DEFAULT 01168000
- MVI FCBMODE,X'00' SET MODE TO DEFAULT VALUE. 01169000
- B DT14 GO CKECK ERRRONEOUS PARAMS. 01170000
- * 01171000
- DT11 LTR R7,R7 IS MODE NUMBER 0 TO 17 ? @V200414 01172000
- BM ERR35E NO - ERROR 01173000
- C R7,=F'17' @V200414 01174000
- BH ERR35E NO - ERROR 01175000
- * USE R7 AS DISPLACEMENT IN 'TRTCH' TABLE 01176000
- IC R2,TRTCH(R7) 01177000
- STC R2,FCBMODE 01178000
- * 01179000
- B DT14 GO CHECK ERRONEOUS PARAMS. 01180000
- * 01181000
- * THE FOLLOWING IS (IDENTICAL) DEFAULT PROCESSING FOR DSK AND 01182000
- * TAP OPERANDS. 01183000
- * 01184000
- DT12 MVI FCBMODE,X'00' SET MODE TO DEFAULT VALUE. 01185000
- DT13 MVI FCBXTENT+1,DXTENT DEFAULT 50 01186000
- B EXIT FINISHED. 01187000
- * 01188000
- EJECT 01189000
- * THE CODE CHECKS FOR ERRONEOUS PARAMETERS WHEN USING THE DISK OR TAPE 01190000
- * OPTIONS OF THE FILEDEF COMMAND. 01191000
- * 01192000
- DT14 EQU * 01193000
- LR R5,R8 RESET TO FIRST KEYWORD FOR SEARCH 01194000
- OI FLAG3,LASTCHK FINAL CHEK FOR BAD OPTIONS 01195000
- DT15 EQU * 01196000
- BAL R2,SCANTS INVOKE OPTION SCANNER 01197000
- CLI 2(R5),ROPTCD IS THIS 9TRACK,7TRACK OR PERMANENT? 01198000
- BE BUMP8A 01199000
- CLC 0(3,R5),NOCHANGE IS THIS NOCHANGE? 01200000
- BE BUMP8A 01201000
- CLC 0(2,R5),CHANGE CHANGE? 01202000
- BE BUMP8A 01203000
- CLC 0(2,R5),CONCAT CONCAT OPTION? @V201105 01204000
- BE BUMP8A YES, CONTINUE @V201105 01205000
- CLC 0(2,R5),LOWRCASE LOWCASE? 01206000
- BE CHKTERM 01207000
- CLC 0(2,R5),UPCASE UPCASE? 01208000
- BNE BUMP16A IF NONE OF THESE, IT'S KEYWORD 01209000
- CHKTERM TM VALFLAG,TERMDEV TERMINAL DEVICE? 01210000
- BNO ERR3E IF NOT, ERROR 01211000
- BUMP8A LA R5,8(,R5) BUMP PTR '8' FOR NON-KEYWORD OPTIONS 01212000
- B ENDCHEKA 01213000
- BUMP16A LA R5,16(,R5) UPDATE THE POINTER 01214000
- ENDCHEKA C R6,0(,R5) ? IS THIS END OF SCAN ? 01215000
- BNE DT15 NO, INVOKE THE SCANNER AGAIN @VA07074 01216100
- B EXIT YES,PLIST O.K. 01217000
- * 01218000
- SPACE 2 01219000
- * THE SCAN ROUTINE CHECKS THE PARAMETER WHICH IS POINTED TO BY PLIST 01220000
- * TO SEE IF IT IS A LEGAL PARAMETER. IF IT IS NOT LEGAL AN ERROR 01221000
- * MESSAGE IS TYPED AT THE USER'S CONSOLE. 01222000
- * 01223000
- SCANTS EQU * 01224000
- LA R7,TABSTART START ADDR OF KEYWORD/OPTION TABLE 01225000
- LR R3,R8 01226000
- LA R8,12 LENGTH OF EACH TAB ENTRY 01227000
- LA R9,TABEND END OF TABLE 01228000
- * 01229000
- KEYCOMP CLC 0(8,R7),0(R5) CHEK VALID OPTION 01230000
- BNE BXLE TRY AGAIN... 01231000
- TM FLAG3,LASTCHK IS THIS FINAL CHEK? 01232000
- BO FINAL YES, SKIP 01233000
- MVC TESTBYTE(1),8(R7) GET FLAG BYTE 01234000
- NC TESTBYTE(1),VALFLAG 'AND' IT FOR VALID DEVICE 01235000
- CLC TESTBYTE(1),VALFLAG DEVICE/OPTION COMPATABLE? 01236000
- BNE ERR3E 01237000
- FINAL LR R8,R3 01238000
- BR R2 01239000
- BXLE BXLE R7,R8,KEYCOMP 01240000
- BNE ERR3E INVALID OPTION 01241000
- EJECT 01242000
- *********************************************************************** 01243000
- * 01244000
- * PROCESS THE TAP OPERAND 01245000
- * 01246000
- *********************************************************************** 01247000
- * 01248000
- T1 CLC TAP(3),8(R5) ? 1ST 3 CHARACTERS 'TAP' 01249000
- BNE CLR NO, GO CHECK FOR CLEAR. 01250000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01251000
- BO T1B YES @VA09051 01252000
- CLI FCBDEV,FCBTAP WAS OLD FILEDEF TAPE? @VA06191 01253000
- BE T1A BRANCH IF YES @VA06191 01254000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01255000
- MVC FCBTAPID(8),TAP2 DEFAULT TAPE = TAP2 @VA09051 01255200
- T1A EQU * @VA06191 01255500
- CLI 11(R5),BLANK SPECIFIC TAPE ID @VA09051 01255800
- BNE T1B YES @VA09051 01256100
- MVC 8(4,R5),FCBTAPID NO, USE OLD TAPE ID @VA09051 01256400
- T1B EQU * @VA09051 01256700
- MVI FCBDEV,FCBTAP SET DEVICE CODE. 01257000
- CLI 11(R5),BLANK ? NO SPECIFIC TAPE ID ? 01258000
- BNE T2 FALSE, GO CHECK ITS VALIDITY. 01259000
- MVI 11(R5),C'2' MAKE DEFAULT TAPE = 'TAP2' 01262000
- B T3 SKIP TO FINISH. 01263000
- T2 CLI 12(R5),BLANK ? ONLY 1 DIGIT ON TAPID ? 01264000
- BNE ERR27A NO, TOO MANY. ERROR EXIT. 01265000
- CLI 11(R5),C'A' ? IS IT < 'A' ? HRC002DS 01266090
- BL ERR27A YES, ERROR EXIT. HRC002DS 01266180
- CLI 11(R5),C'F' ? IS IT > 'F' ? HRC002DS 01266270
- BNH T3 NO, CONTINUE HRC002DS 01266360
- CLI 11(R5),C'0' ? IS IT A NUMERIC < 0 ? HRC002DS 01266450
- BL ERR27A NO, ERROR EXIT. 01267000
- CLI 11(R5),C'9' ? IS A DIGIT > 9 ? HRC002DS 01268490
- BH ERR27A YES, ERROR EXIT. 01269000
- T3 MVC FCBTAPID(8),8(R5) PUT TAPID INOT FCB 01270000
- C R6,16(,R5) ? REST DEFAULTED ? 01271000
- BE DT12 YES, PROCESS AS SUCH ABOVE. 01272000
- OI VALFLAG,TAPDEV INDICATE TAPE FOR OPTN SCAN 01273000
- LA R5,16(,R5) UPDATE PLIST TO KEYWORDS 01274000
- TM OPTNFLAG,NOOPTNS CHEK '(' FOR OPTIONS 01277000
- BO ERR70E SORRY, NO OPTIONS ALLOWED P1017 01278000
- LR R9,R5 POINT TO OPTIONS @VA09115 01279100
- B D2 CHECK DELIMITER ON OPTIONS @VA09115 01279200
- EJECT 01281000
- * 01282000
- *********************************************************************** 01283000
- * 01284000
- * PROCESS THE CLEAR OPERAND 01285000
- * 01286000
- *********************************************************************** 01287000
- * 01288000
- * PLIST POINTS TO THE 1ST PARAMETER. 01289000
- * 01290000
- CLR CLC CLEAR(8),8(R5) ? 2ND PARAMETER CLEAR ? 01291000
- BNE DEV1 NO, CHECK FOR OTHERS. 01292000
- TM FLAG1,OLD EXITING ENTRY? 01293000
- BZ ERR704I NO, ILLEGAL CLEAR REQUEST 01294000
- * THERE CAN ONLY BE TWO OPERANDS FOR THIS REQUEST. 01295000
- * 01296000
- CLRA EQU * @VA01157 01297000
- C R6,16(,R5) ONLY 2 PARAMETERS @V201105 01298000
- BE CLRLOOP YES CONTINUE @V201105 01299000
- LA R5,16(,R5) UPDATE PLIST IN CASE OF ERR @V201105 01300000
- B ERR3E PRINT ERROR MSG. @V201105 01301000
- CLRLOOP LA R4,0(,R4) CLEAR HIGH ORDER BYTE @V201105 01302000
- LTR R2,R4 END OF CHAIN @V201105 01303000
- BZ RETURN YES, RETURN @V201105 01304000
- CLC FCBDD(8),0(R5) IS THIS RIGHT DDNAM @V201105 01305000
- BE CLR2 YES, CONTINUE @V201105 01306000
- ST R4,PREVENT SAVE FCB ADDRESS @V201105 01307000
- L R4,0(,R4) GET NEXT FCB POINTER @V201105 01308000
- B CLRLOOP CHECK NEXT FCB @V201105 01309000
- CLR2 BAL R10,CLRDSN FREE DSN BLOCK @V201105 01310000
- LA R10,FCBENSIZ GET DOUBLE WORD SIZE FOR RELEASE @V201105 01311000
- ST R10,PLFREE+8 PUT IT IN SVCFRET PLIST @V201105 01312000
- ST R4,PLFREE+12 PUT ADDRESS OF ENTRY IN PLIST 01313000
- LR R2,R4 SETUP REG4 FOR MOVE @V201122 01314000
- L R4,PREVENT GET ADDRESS OF PREVIOUS ENTRY 01315000
- LR R10,R4 SET UP UPDATING REGISTER 01316000
- LTR R4,R4 ? FIRST OR ONLY ENTRY? 01317000
- BNZ CLR1 NO, UPDATE NORMALLY 01318000
- LA R10,FCBFIRST YES, USE 1ST ADDRRESS FOR UPDATE 01319000
- CLR1 MVC 1(3,R10),1(R2) UPDATE TO SKIP CLEARED ENTRY 01320000
- LH R2,FCBNUM GET COUNT OF ENTRIES 01321000
- BCTR R2,R0 SUBTRACT 1 01322000
- STH R2,FCBNUM PUT COUNT BACK IN FCB TABLE 01323000
- L R4,PLFREE+12 GET FCB ADDRESS @V201105 01324000
- L R4,0(,R4) GET NEXT FCB PTR @V201105 01325000
- BAL R10,FRET FREE FCB BLOCK @V201105 01326000
- B CLRLOOP CLEAR ALL FCB'S WITH DDNAME @V201105 01327000
- * 01328000
- EJECT 01329000
- *********************************************************************** 01330000
- * 01331000
- * PROCESS ALL OTHER OPERANDS 01332000
- * 01333000
- * 01334000
- * THIS INCLUDES: TERM, RDR, PTR, PUN, AND CRT. 01335000
- * IF NONE OF THESE ARE FOUND FOR PARAMETER 2, 01336000
- * IT IS AN ERROR EXIT. 01337000
- *********************************************************************** 01338000
- * 01339000
- * PLIST IS UPDATED TO POINT TO THE 2ND OPERAND. 01340000
- * 01341000
- DEV1 LA R5,8(,R5) UPDATE PLIST TO PARAM 2 01342000
- * DEVICE TYPE = CONSOLE 01343000
- LA R14,TERM PROVIDE NAME AND P3100 01344000
- LA R2,1 MINIMUM ABBREV. TO SUBRTN P3100 01345000
- BAL R10,DEVABBR CHEK FOR 'TERM' DEVICE P3100 01346000
- BNE DEV3 NO, GO ON. 01347000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01348000
- BO SETCON BRANCH IF YES @VA06191 01349000
- CLI FCBDEV,FCBCON WAS OLD FILETYPE CONSOLE? @VA06191 01350000
- BE SETCON BRANCH IF YES @VA06191 01351000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01352000
- SETCON MVI JFCBUFNO,X'01' SET CONSOLE BUFFERING TO 1 01353000
- OI VALFLAG,TERMDEV 01354000
- MVI FCBDEV,FCBCON SET DEVICE CODE AND 01355000
- TM FLAG1,NEW ? NEW ENTRY ? 01356000
- BNO DEV1B NO 01357000
- NI FCBIOSW,255-FCBCASE DEFAULT TO 'UPCASE' 01358000
- DEV1B C R6,8(,R5) ANY OPTIONS? 01359000
- BE COMMONT NO, DROP 01360000
- CLI 8(R5),C'(' OPTIONS MUST HAVE PARENS. 01361000
- BE DEV2A O.K. 01362000
- LA R9,8(,R5) SKIP TO OPTIONS @VA09115 01363000
- CR R9,R8 SVC CAL @VA09115 01363500
- BNE D2AB NO , INVALID PARAMETER @VA09115 01364000
- DEV2A LR R14,R5 SAVE POINTR P1017 01365000
- MVC KEYWORD(8),LOWRCASE SEARCH FOR 'LOWCASE' 01366000
- BAL R10,SCAN SCAN... 01367000
- CLI FLAG2,MATCH WAS IT FOUND 01368000
- BNE DEV2B NO 01369000
- OI FCBIOSW,FCBCASE SET CODE TO LOWER CASE 01370000
- DEV2B LR R5,R14 P1017 01371000
- MVC KEYWORD(8),UPCASE SEARCH FOR 'UPCASE' 01372000
- BAL R10,SCAN SCAN... 01373000
- LR R5,R14 P1017 01374000
- CLI FLAG2,MATCH FOUND ? @VA09624 01374200
- BNE COMMONT @VA09624 01374400
- NI FCBIOSW,255-FCBCASE DEFAULT UPCASE @VA09624 01374600
- B COMMONT 01375000
- * DEVICE TYPE = CARD READER 01376000
- DEV3 EQU * P3100 01377000
- LA R14,RDR PROVIDE DEVICE NAME P3100 01378000
- LA R2,1 AND MIN. ABBREV FOR SUBRTN P3100 01379000
- BAL R10,DEVABBR CHEK FOR 'READER' P3100 01380000
- BNE DEV4 NO, GO ON. 01381000
- TM BATFLAGS,BATRUN IS BATCH RUNNING? V0742 01382000
- BZ NOTBAT V0742 01383000
- OI BATFLAG2,BATDCMS TELL BATCH WHO'S CALLING V0742 01384000
- L R14,GR14SA SO BATCH GOES BACK TO CMS V0742 01386000
- L R15,ABATABND ENTER BATCH AT 'ABEND' POINT V0742 01387000
- BR R15 AND DON'T COME BACK.... V0742 01388000
- NOTBAT EQU * V0742 01389000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01390000
- BO DEV3A BRANCH IF YES @VA06191 01391000
- CLI FCBDEV,FCBRDR WAS OLD FILETYPE READER? @VA06191 01392000
- BE COMMON BRANCH IF YES @VA06191 01393000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01394000
- DEV3A EQU * @VA06191 01395000
- MVI FCBDEV,FCBRDR SET DEVICE CODE. 01396000
- B COMMON 01397000
- * DEVICE TYPE = PRINTER 01398000
- DEV4 EQU * P3100 01399000
- LA R14,PRT PROVIDE DEVICE NAME AND P3100 01400000
- LA R2,2 MIN. ABBREV FOR SUBRTN P3100 01401000
- BAL R10,DEVABBR CHEK FOR 'PRINTER' P3100 01402000
- BNE DEV5 NO. 01403000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01404000
- BO DEV4A BRANCH IF YES @VA06191 01405000
- CLI FCBDEV,FCBPTR WAS OLD FILETYPE PRINTER? @VA06191 01406000
- BE COMMON BRANCH IF YES @VA06191 01407000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01408000
- DEV4A EQU * 01409000
- MVI FCBDEV,FCBPTR SET CODE. 01410000
- B COMMON 01411000
- * DEVICE TYPE = CARD PUNCH 01412000
- DEV5 EQU * P3100 01413000
- LA R14,PUN PROVIDE DEVICE NAME AND P3100 01414000
- LA R2,2 MIN. ABBREV FOR SUBRTN P3100 01415000
- BAL R10,DEVABBR CHEK FOR 'PUNCH' P3100 01416000
- BNE DSNDEV @V201105 01417000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01418000
- BO DEV5A BRANCH IF YES @VA06191 01419000
- CLI FCBDEV,FCBPCH WAS OLD FILETYPE PUNCH? @VA06191 01420000
- BE COMMON BRANCH IF YES @VA06191 01421000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01422000
- DEV5A EQU * 01423000
- MVI FCBDEV,FCBPCH SET CODE. 01424000
- B COMMON @V201105 01425000
- DSNDEV LR R9,R5 R9 POINTS TO DEV @V201105 01426000
- SH R5,=H'8' BACK R5 TO DDNAME @V201105 01427000
- CLC 0(8,R9),=CL8'DSN' DSN PARAM @V201105 01428000
- BE OSDSK YES, SET DISK DEVICE TYPE @V201105 01429000
- CLC 8(8,R9),=CL8'DSN' IS NEXT PARAM DSN @V201105 01430000
- BNE ERR27A NO, INVALID DEVICE TYPE @V201105 01431000
- LA R9,8(0,R9) POINT TO IT @V201105 01432000
- MVC A1(2),8(R5) SET REQUESTER'S MODE FOR ABOVE @V201105 01433000
- MVC FCBDSMD(2),A1 USE HIS MODE @VA05882 01434000
- OSDSK EQU * @VA06191 01435000
- TM FLAG1,NEW NEW FILEDEF ENTRY? @VA06191 01436000
- BO OSDSK1 BRANCH IF YES @VA06191 01437000
- CLI FCBDEV,FCBDSK WAS OLD FILETYPE DISK? @VA06191 01438000
- BE DEFAULT BRANCH IF YES @VA06191 01439000
- XC FCBDSNAM(FCBSIZ),FCBDSNAM CLEAR OUT BLOCK @VA06191 01440000
- OSDSK1 EQU * @VA06191 01441000
- MVI FCBDEV,FCBDSK SET DISK DEVICE TYPE @VA06191 01442000
- B DEFFNFT SET DEFAULT FN FT @VA11265 01443000
- COMMON OI VALFLAG,URECDEV INDICATE UNITREC FOR OPTION SCAN 01444000
- COMMONT LA R5,8(,R5) UPDATE PTR TO 1ST KEYWORD 01445000
- C R6,0(,R5) ? IS IT THE END OR A KEY ? 01446000
- BE EXIT IT IS THE END, BROTHER 01447000
- TM OPTNFLAG,NOOPTNS CHEK '(' FOR OPTIONS 01450000
- BO ERR70E SORRY, NO OPTIONS ALLOWED P1017 01451000
- LR R9,R5 POINT TO OPTIONS @VA09115 01452100
- B D2 CHECK DELIMITER ON OPTIONS @VA09115 01452200
- * 01454000
- DEVABBR EQU * CHEK DEVICE NAME AND POSS ABBREP3100 01455000
- LR R9,R5 PRESERVE COMMAND LINE PTR P3100 01456000
- BCTR R2,0 DECREMENT FOR 'EXECUTE' P3100 01457000
- AR R9,R2 USE R9 TO SCAN FOR 1ST BLANK P3100 01458000
- MATCHR EX R2,COMPABR LOOK FOR MATCH P3100 01459000
- BCR 7,R10 IF NO MATCH, RETURN: CC > 0 P3100 01460000
- CLI 1(R9),C' ' MATCH: NEXT CHAR BLANK? P3100 01461000
- BCR 8,R10 YES, RETURN: CC = 0 P3100 01462000
- CH R2,=H'7' LAST CHAR? P3100 01463000
- BCR 8,R10 YES,RETURN: CC = 0 P3100 01464000
- LA R2,1(,R2) IF NOT, BUMP CHAR COUNT AND P3100 01465000
- LA R9,1(,R9) BLANK PTR AND P3100 01466000
- B MATCHR CONTINUE SCANNING P3100 01467000
- COMPABR CLC 0(*-*,R14),0(R5) MATCH DEVICE PASSED VS. ENTRY P3100 01468000
- EJECT 01469000
- * 01470000
- *********************************************************************** 01471000
- * 01472000
- * KEYWORD SCAN SUB-ROUTINE 01473000
- * 01474000
- * THIS SUB-ROUTINE ATTEMPTS TO FIND THE KEYWORD (GIVEN 01475000
- * TO IT AS A PARAMETER) IN THE COMMAND INPUT PLIST. 01476000
- * 01477000
- *********************************************************************** 01478000
- * 01479000
- * 'SCAN' SEARCHES THE PLIST FOR THE OPTION PASSED TO IT 01480000
- * IN 'KEYWORD'. IF FOUND, A FLAG IS SET AND THE SCAN CONTINUES 01481000
- * TO CHECK FOR A DUPLICATE OPTION. IF NO DUPLICATION, 01482000
- * 'SCANTS' IS CALLED TO POSITION R7 AT THE OPTION TABLE ENTRY 01483000
- * FOR THIS OPTION. IF THERE IS A POSSIBLE CONFLICTING OPTION 01484000
- * FOR THE 'FOUND' OPTION, THE TABLE ENTRY FOR THE CONFLICTING 01485000
- * OPTION IS CHECKED FOR THE 'FOUND' FLAG. IF THE FLAG IS ON 01486000
- * THERE IS A CONFLICT AND AN ERROR EXIT IS TAKEN. 01487000
- * 01488000
- SCAN EQU * 01489000
- SCANNING CLC KEYWORD(8),0(R5) MATCH? 01490000
- BNE SCANNOT NO... 01491000
- S R5,=F'8' DECREMENT POINTER @VA02376 01492000
- CLC 0(8,R5),MEMBER IS IT 'MEMBER' OPTION? @VA02376 01493000
- BNE SCANREST NO, CONTINUE PROCESSING @VA02376 01494000
- LA R5,16(,R5) SKIP TO NEXT OPTION @VA02376 01495000
- B SCANNING CONTINUE SCANNING @VA02376 01496000
- SCANREST LA R5,8(,R5) RESTORE POINTER @VA02376 01497000
- TM VALFLAG,FOUND IS THIS A REPEAT? 01498000
- BO ERR65E YES, ERROR 01499000
- LR R2,R5 KEEP OPTION POINTR 01500000
- OI VALFLAG,FOUND FIRST HIT. 01501000
- SCANBUMP LA R5,8(,R5) 01502000
- B SCANNING KEEP ON MOVING... 01503000
- * 01504000
- SCANNOT C R6,0(,R5) END OF PLIST? 01505000
- BNE SCANBUMP NO, CONTINUE 01506000
- TM VALFLAG,FOUND WAS OPTION FOUND? 01507000
- BO SCANHIT YES, GO PROCESS 01508000
- MVI FLAG2,NOMATCH NO, TELL CALLER 01509000
- BR R10 01510000
- SCANHIT MVI FLAG2,MATCH TELL CALLER IT'S A HIT 01511000
- NI VALFLAG,255-FOUND TURN OFF 'FOUND' CONDITION 01512000
- LR R5,R2 POINT TO OPTION IN COMMAND LINE 01513000
- BAL R2,SCANTS GO POINT TO TABLE ENTRY 01514000
- LA R5,8(,R5) POINT TO KEYWRD OPERAND FOR CALLER 01515000
- * R7 -> TABLE ENTRY FOR OPTION 01516000
- L R2,8(R7) LOAD CONFLICTING OPTION ADDR. 01517000
- LA R2,0(,R2) CLEAR THE FLAG BYTE 01518000
- LTR R2,R2 ANY POSSIBLE CONFLICTS? 01519000
- BZ SCANRET IF NOT, RETURN 01520000
- TM 8(R2),FOUND IF SO, CHEK IF CONFLICT OPTION FOUND 01521000
- BO ERR66E CONFLICTING OPTIONS 01522000
- SCANRET OI 8(R7),FOUND SET 'FOUND' OPTN'S CONFLICT FLAG 01523000
- BR R10 RETURN 01524000
- EJECT 01525000
- * 01526000
- *********************************************************************** 01527000
- * 01528000
- * CONVERSION 01529000
- * NUMERIC TO BINARY SUB-ROUTINE 01530000
- * 01531000
- * THIS SUB-ROUTINE IS USED IN DSK AND TAP OPERAND 01532000
- * PROCESSING FOR CONVERTING LRECL AND BLKSIZ EBCDIC 01533000
- * INPUT VALUES TO BINARY REPRESENTATION. 01534000
- * 01535000
- * 1. IT IS ASSUMED THAT PLIST POINTS TO THE VALUE. 01536000
- * 2. THE VALUE WILL 1ST BE CHECKED TO MAKE SURE SIZE IS NOT 01537000
- * EXCEEDED BY CHARACTER COUNT. 01538000
- * 3. A COUNT OF THE CHARACTERS ENTERED IS DETERMINED. 01539000
- * 4. THEY ARE CHECKED TO MAKE SURE THEY ARE NUMERICS. 01540000
- * 5. THE CHARACTERS ARE THEN PACKED AND CONVERTED TO BINARY. 01541000
- * 6. GR'S 7 & 11 ARE THE ONLY ONES EFFECTIVELY CHANGED. 01542000
- * 7. THE BINARY VALUE IS CHECKED TO MAKE SURE IT DOESN'T 01543000
- * EXCEED THE MAXIMUM. 01544000
- * 8. ERROR EXIT IS ERROR NUMBER 5. 01545000
- * 9. THE BINARY VALUE IS RETURNED IN GR 7. 01546000
- * 01547000
- *********************************************************************** 01548000
- * 01549000
- CONVERT EQU * 01550000
- LA R7,CHARMAX+1 SET R7 WITH MAX CHAR COUNT + 1 01551000
- LA R9,CHARMAX SET R9 TO MAX CHAR COUNT 01552000
- LR R1,R5 SAVE PARAM POINTER 01553000
- * 01554000
- * SEARCH FOR THE FIRST BLANK IN THE STRING TO GET THE COUNT. 01555000
- * 01556000
- CONV1 CLI 1(R5),BLANK ? FIND 1ST BLANK ? 01557000
- BE CONV2 YES, CONTINUE PROCESSING 01558000
- LA R5,1(,R5) UPDATE TO NEXT CHARACTER 01559000
- BCT R9,CONV1 DO THIS MAX-1 TIMES, I.E., 01560000
- * THE 1ST CHAR COULD NOT HAVE BEEN BLANK. 01561000
- B CONV4 TOO MANY CHARACTERS, ERROR EXIT. 01562000
- * 01563000
- * NOW CHECK TO MAKE SURE ALL CHARACTERS ENTERED ARE NUMERICS. 01564000
- * PLIST NOW POINTS TO THE LAST CHARACTER (DIGIT). 01565000
- * 01566000
- CONV2 SR R7,R9 GET COUNT OF CHAR IN R7 01567000
- LR R2,R7 IN R2 ALSO 01568000
- CONV3 CLI 0(R5),C'0' ? IS IT NUMERIC ? 01569000
- BL CONV4 NO, ERROR EXIT 01570000
- CLI 0(R5),C'9' 01571000
- BH CONV4 DITTO 01572000
- BCTR R5,R0 BACK UP TO PREVIOUS CHAR 01573000
- BCT R2,CONV3 DO THIS FOR EACH CHARACTER 01574000
- * 01575000
- * NOW PUT IN THE DECIMAL SIGN AND PACK THE NUMERICS. 01576000
- * PLIST NOW POINTS TO THE CHARACTER BEFORE THE FIRST ONE. 01577000
- * 01578000
- AR R5,R7 POINT PLIST TO LAST CHARACTER 01579000
- NI 0(R5),X'CF' PUT IN DECIMAL + SIGN 01580000
- BCTR R7,R0 DECREMENT CHARACTER COUNT TO: 01581000
- SR R5,R7 1. POINT PLIST TO 1ST CHARACTER, AND 01582000
- * 2. REDUCE PACK COUNT FOR EXECUTE 01583000
- STC R7,CONV5+3 SAVE R7 FOR RESTORING PARAMETER 01584000
- EX R7,EXPACK PACK THE NUMERICS IN THE PLIST 01585000
- CVB R7,PACK CONVERT THIS TO BINARY 01586000
- CONV5 OI 0(R5),X'F0' POSSIBLE ERROR MESSAGE 01587000
- C R7,NUMAX COMPARE IT TO THE MAX ALLOWED 01588000
- BH CONV4 TOO BIG FOR HALFWORD 01589000
- BR R10 RETURN TO INVOKER 01590000
- CONV4 LR R5,R1 RESTORE PARM POINTR 01591000
- B ERR29E ERROR EXIT. 01592000
- * 01593000
- EJECT 01594000
- *********************************************************************** 01595000
- * 01596000
- * ERROR MESSAGES 01597000
- * 01598000
- *********************************************************************** 01599000
- * 01600000
- ERR3E TM MSGSWT,PRINT SUPPRESS MSGS? 01601000
- BZ RET3 YES 01602000
- DMSERR NUM=3,LET=E,SUB=(CHARA,(R5)),TEXT='Invalid option ''...*01603000
- .....''' HRC309DS 01604000
- RET3 LA R15,24 RETURN CODE = 24 01605000
- B EXIT 01606000
- SPACE 2 01607000
- ERR65E TM MSGSWT,PRINT SUPPRESS MSGS? 01608000
- BZ RET65 YES 01609000
- DMSERR NUM=65,LET=E,SUB=(CHARA,(R5)),TEXT='''........'' option*01610000
- specified twice' HRC309DS 01611000
- RET65 LA R15,24 RETURN CODE = 24 01612000
- B EXIT 01613000
- SPACE 2 01614000
- ERR66E TM MSGSWT,PRINT SUPPRESS MSGS? 01615000
- BZ RET66 YES 01616000
- DMSERR NUM=66,LET=E,SUB=(CHARA,(R2),CHARA,(R7)),TEXT='''......*01617000
- ..'' and ''........'' are conflicting options',RENT=NO 01618000
- RET66 LA R15,24 return code = 24 HRC309DS 01619000
- B EXIT 01620000
- SPACE 2 01621000
- SPACE 2 01622000
- ERR23E TM MSGSWT,PRINT SUPPRESS MSGS? 01623000
- BZ RET23 YES 01624000
- DMSERR NUM=23,LET=E,TEXT='No filetype specified' HRC309DS 01625000
- RET23 LA R15,24 RETURN CODE = 24 01626000
- B EXIT 01627000
- SPACE 2 01628000
- ERR27A LA R5,8(,R5) POINT TO DEVICE 01629000
- ERR27E TM MSGSWT,PRINT SUPPRESS MSGS? 01630000
- BZ RET27 YES 01631000
- DMSERR NUM=27,LET=E,SUB=(CHARA,(R5)),TEXT='Invalid device ''..*01632000
- ......''' HRC309DS 01633000
- RET27 LA R15,24 RETURN CODE = 24 01634000
- B EXIT 01635000
- SPACE 2 01636000
- ERR29E TM MSGSWT,PRINT SUPPRESS MSGS? 01637000
- BZ RET29 YES 01638000
- LA R3,8 THIS ROUTINE SUBS 8 FROM 01639000
- LR R2,R5 THE PARAMETER TO GET THE OPTION @VA05995 01640000
- SR R2,R3 FOR ERROR MESSAGE. @VA05995 01641000
- DMSERR NUM=29,LET=E,SUB=(CHARA,(R5),CHARA,(R2)),TEXT='Invalid *01642000
- parameter ''........'' in the option ''........'' filed'*01643000
- ,RENT=NO HRC309DS 01644000
- RET29 LA R15,24 RETURN CODE = 24 01645000
- B EXIT 01646000
- SPACE 2 01647000
- ERR35E TM MSGSWT,PRINT SUPPRESS MSGS? 01648000
- BZ RET35 YES 01649000
- DMSERR NUM=35,LET=E,TEXT='Invalid tape mode' HRC309DS 01650000
- RET35 LA R15,24 RETURN CODE = 24 01651000
- B EXIT 01652000
- SPACE 2 01653000
- ERR50E TM MSGSWT,PRINT SUPPRESS MSGS? 01654000
- BZ RET50 YES 01655000
- DMSERR NUM=50,LET=E,TEXT='Parameter missing after DDname' 01656000
- RET50 LA R15,24 return code = 24 HRC309DS 01657000
- B EXIT 01658000
- SPACE 2 01659000
- ERR70E EQU * P1017 01660000
- DMSERR NUM=70,LET=E,SUB=(CHARA,(R5)),TEXT='Invalid parameter '*01661000
- '........''' HRC309DS 01662000
- LA R15,24 RETURN CODE = 24 P1017 01663000
- B EXIT P1017 01664000
- SPACE 2 P1017 01665000
- ERR704I TM MSGSWT,PRINT SUPPRESS MSGS? 01666000
- BZ RET704 YES 01667000
- DMSERR NUM=704,LET=I,TEXT='Invalid CLEAR request' HRC309DS 01668000
- RET704 B RETURN @VA01157 01669000
- ERR221E DMSERR TEXT='Invalid dataset name',NUM=221,LET=E HRC309DS 01670000
- LA R15,24 @V201105 01671000
- B EXIT RETURN @V201105 01672000
- ERR224E DMSERR NUM=224,LET=E, X01673000
- TEXT='Fileid already in use' HRC309DS 01674000
- LA R15,24 SET ERROR CODE @V201105 01675000
- OI FLAG4,NEW SET NEW FLAG ON @VA02692 01676000
- NI FLAG4,255-OLD TURN OLD FLAG OFF @VA02692 01677000
- B EXIT RETURN @V201105 01678000
- EJECT 01679000
- * 01680000
- *********************************************************************** 01681000
- * 01682000
- * EXIT PROCESSING 01683000
- * 01684000
- *********************************************************************** 01685000
- * 01686000
- EXIT EQU * 01687000
- TM FLAG1,NEW NEW ENTRY? 01688000
- BO EXIT1 YES, GO PROCESS BELOW 01689000
- LTR R15,R15 ? ANY ERRORS ? 01690000
- BZ CHKOSDSN NO, CHECK FOR OLD DSN BLOCK @V201105 01691000
- TM FLAG1,OLD OLD ENTRY ? @VA04413 01692000
- BO CKIFERR YES,SEE IF IN ERROR ? @VA04413 01693000
- B RETURN OTHERWISE,NOT NEW OR OLD RETURN. @VA04413 01694000
- CKIFERR CH R15,=H'24' WAS INVALID PARM SPECIFIED ? @VA04413 01695000
- BE RESTORE YES, RESTORE OLD FCB. @VA04413 01696000
- CLM R15,BIN0001,INVCHAR INVALID CHARACTER FOUND? @VA06434 01697000
- BE RESTORE YES, RESTORE OLD FCB @VA06434 01698000
- TM FLAG4,NEW SVCFREE FLAG SET? @VA06434 01699000
- BZ RETURN NO NEED TO RESTORE OLD ENTRY @VA06434 01700000
- RESTORE EQU * @VA04413 01701000
- MVC 0(FCBENSIZ*8,R4),OLDENTRY RESOTRE OLD ENTRY 01702000
- B RETURN FINISHED. 01703000
- EXIT1 LTR R15,R15 ? ANY ERRORS ? 01704000
- BZ ADDTOCNT UPDATE FCB COUNT @VA05963 01705000
- EXIT2 LA R10,RETURN SET UP RTN ADDR FOR FRET CALL 01706000
- SR R1,R1 CLEAR REG FOR COMPARE @V201105 01707000
- CH R1,FCBNUM IS FCBNUM ZERO @V201105 01708000
- BE CLRFIRST YES, ZERO FCBFIRST @VA05963 01709000
- L R2,PREVENT GET PREVIOUS FCB ADDR @VA05963 01710000
- MVC D01(3,R2),ZERO DELETE CHAIN PTR BUT NOT HIGH @VA05963 01711000
- * ORDER BYTE 01712000
- NEWFLAG EQU * @VA05963 01713000
- TM FLAG4,NEW SVCFREE FLAG ON? 01714000
- BO FRET CALL ON SVCFRET TO GIVE BACK ENTRY 01715000
- B RETURN FINISHED 01716000
- CLRFIRST EQU * @VA05963 01717000
- ST R1,FCBFIRST CLEAR FCBFIRST @VA05963 01718000
- B NEWFLAG CHECK FREE FLAG @VA05963 01719000
- CHKOSDSN EQU * @VA04338 01720000
- LR R2,R4 SAVE CURR FCB PTR @VA04338 01721000
- LA R4,OLDENTRY POINT TO OLD FCB COPY @VA04338 01722000
- BAL R10,CLRDSN1 CLEAR DSN BLOCK @VA04338 01723000
- TM FCBINIT,FCBCATML CONCAT SPECIFIED @V201122 01724000
- BNO RETURN NO, RETURN @V201122 01725000
- ST R2,PREVENT PUT CURRENT ENTRY INTO PREV. @VA14030 01726000
- * ENTRY 01727000
- L R4,0(,R4) GET NEXT BLOCK IN CHAIN @V201122 01728000
- B CLRLOOP CLEAR OTHER BLOCKS WITH DDNAM @V201122 01729000
- CLRDSN1 EQU * @VA04338 01730000
- SR R1,R1 ZERO REGISTER @VA11278 01731000
- L R7,FCBOSFST PICK UP OLD OSFST BLOCK @VA11278 01731500
- L R8,FCBOSFST-FCBSECT(,R2) PICK UP CURR OSFST @VA11278 01732000
- ICM R1,SEVEN,FCBOSDSN+1 PICK UP OLD DSN BLOCK @VA11278 01732500
- BZR R10 NO, RETURN TO CALLER @VA14030 01734000
- L R2,FCBOSDSN-FCBSECT(,R2) PICK UP CURR DSN BLOCK @VA04338 01735000
- LA R2,0(,R2) CLEAR HI ORDER BYTE @VA04338 01736000
- CR R1,R2 ARE THEY THE SAME ? @VA04338 01737000
- BE CLRFST1 NO, CHECK FOR OSFST FREE @VA11278 01738000
- B CLRDSN2 GO FRET DSN BLOCK @VA04338 01739000
- CLRDSN EQU * @VA11278 01740000
- L R7,FCBOSFST PICK UP OLD OSFST BLOCK @VA11278 01740500
- SR R8,R8 INDICATE CURR IS OLD @VA11278 01741000
- SR R1,R1 ZERO REGISTER @VA11278 01741500
- ICM R1,SEVEN,FCBOSDSN+1 PICK UP DSN BLOCK @VA11278 01742000
- BZ CLRFST1 NO, CHECK FOR OSFST FREE @VA11278 01742500
- CLRDSN2 EQU * @VA04338 01743000
- ST R15,GR15SAVE SAVE ERROR CODE @VA14030 01744000
- DMSFRET DWORDS=6,LOC=(1) RELEASE IT @V201122 01744050
- L R15,GR15SAVE RESTORE ERROR CODE @VA14030 01744100
- * REMOVE AND FREE OS FST FROM ACTIVE DISK TABLE AND OS FST CHAIN 01744150
- CLRFST1 EQU * @VA11278 01744200
- LA R7,0(,R7) CLEAR HI ORDER BYTE @VA11278 01744250
- LTR R7,R7 DOES OSFST EXIST? @VA11278 01744300
- BZR R10 NO - RETURN TO CALLER @VA11278 01744350
- LA R8,0(,R8) CLEAR HI ORDER BYTE @VA11278 01744400
- CR R7,R8 ARE OSFST'S THE SAME @VA11278 01744450
- BER R10 YES, DON'T FRET IT @VA11278 01744500
- ST R15,GR15SAVE SAVE ERROR CODE @VA14030 01744550
- SR R1,R1 ZERO OUT R1 @VA14165 01744600
- NEXTDISK EQU * @VA14165 01744640
- L R15,AADTNXT ADDRESS OF DMSLAD ADTNXT @VA14165 01744680
- BALR R14,R15 GET NEXT ADT POINTER @VA14165 01744720
- LTR R15,R15 WAS THERE ANOTHER ADT ?? @VA14165 01744760
- BNZ FSTFREE NO, NONE FOUND, FREE FST @VA14165 01744800
- USING ADTSECT,R1 ADT ADDRESSABILITY @VA14165 01744840
- TM ADTFLG2,ADTFROS IS THIS AN OS DISK ?? @VA14165 01744880
- BNO NEXTDISK NO, GO GET NEXT ADT POINTER@VA14165 01744920
- CLM R7,SEVEN,OSADTFST+1 ADT HAVE SAME OS FST ADDR @VA14165 01744960
- BNE CKCHAIN NO,SEE IF IT'S IN FST CHAIN@VA14165 01745000
- USING OSFST,R7 OSFST ADDRESSABILITY @VA14165 01745040
- MVC OSADTFST+1(3),OSFSTNXT+1 MOVE PREVIOUS TO ADT @VA14165 01745080
- B FSTFREE SINCE UNCHAINED FREE FST @VA14165 01745120
- DROP R7 @VA14165 01745160
- CKCHAIN EQU * @VA14165 01745200
- USING OSFST,R8 OSFST ADDRESSABILITY @VA14165 01745240
- L R8,OSADTFST GET CURRENT OSFST @VA14165 01745280
- CKFST EQU * @VA14165 01745320
- LA R8,0(,R8) CLEAR HI ORDER BYTE @VA14165 01745360
- LTR R8,R8 END OF OSFST CHAIN? @VA14165 01745400
- BZ NEXTDISK YES- FREE OLD OSFST @VA14165 01745440
- CLM R7,SEVEN,OSFSTNXT+1 OLD FST = PREVIOUS @VA11278 01745500
- BE UNCHFST YES, UNCHAIN OLD FST @VA11278 01745550
- L R8,OSFSTNXT GET PREVIOUS FST @VA11278 01745600
- B CKFST CHECK THIS SLOT @VA11278 01745650
- DROP R8 @VA11278 01745700
- USING OSFST,R7 OSFST ADDRESSABILITY @VA11278 01745750
- UNCHFST EQU * @VA11278 01745800
- MVC OSFSTNXT+1-OSFST(,R8),OSFSTNXT+1 UNHOOK OLD FST @VA11278 01745850
- FSTFREE EQU * @VA11278 01745900
- LA R0,OSFSTLTH GET OSFST LENGTH @VA11278 01745950
- LR R1,R7 ADDRESS OF OSFST BLOCK @VA11278 01746000
- DMSFRET DWORDS=(0),LOC=(1) FREE OS FST BLOCK @VA11278 01746050
- L R15,GR15SAVE RESTORE ERROR CODE @VA14030 01746100
- BR R10 RETURN TO CALLER @VA11278 01746150
- DROP R1 @VA11278 01746200
- DROP R7 @VA11278 01746250
- * 01748000
- * ADD A NEW ENTRY TO THE TABLE. 01749000
- * PREVENT CONTAINS THE ADDRESS OF THE LAST FCBENTRY IN THE CHAIN. 01750000
- * 01751000
- ADDTOCNT EQU * @VA05963 01752000
- LH R2,FCBNUM GET COUNT OF ENTRIES 01753000
- LA R2,1(,R2) ADD ONE TO IT, AND 01754000
- STH R2,FCBNUM PUT IT BACK IN FCB HEADER 01755000
- * RESTORE GENERAL REGISTERS AND EXIT FROM FILEDEF. 01756000
- * 01757000
- RETURN MVC PREVENT(4),ZERO CLEAR PREVIOUS ENTRY POINTER 01758000
- RETURN2 L R13,GR13SA GET R13 BACK 01759000
- L R14,GR14SA GET GR14 BACK 01760000
- BR R14 RETURN 01761000
- EJECT 01762000
- *********************************************************************** 01763000
- * 01764000
- * SUB-ROUTINE TO CALL SVCFRET 01765000
- * 01766000
- *********************************************************************** 01767000
- * 01768000
- FRET L R1,PLFREE+12 GET A(RELEASE STORAGE) 01769000
- L R0,PLFREE+8 GET N'DBLE WORDS 01770000
- FRET1 ST R15,GR15SAVE SAVE R15 01771000
- DMSFRET DWORDS=(0),LOC=(1) 01772000
- L R15,GR15SAVE RESOTRE R15 01773000
- BR R10 RETURN TO INVOKER'S ADDRESS 01774000
- * 01775000
- EJECT 01776000
- * 01777000
- *********************************************************************** 01778000
- * EXECUTED INSTRUCTIONS * 01779000
- *********************************************************************** 01780000
- * 01781000
- DS 0F ALIGN. 01782000
- EXPACK PACK PACK(8),0(0,R5) PACK INSTRUCTION 01783000
- * 01784000
- * THE NUMBER OF BYTES TO BE PACKED WILL BE DETERMINED BY 01785000
- * GR7 AT EXECUTE TIME. 01786000
- * 01787000
- *********************************************************************** 01788000
- * 01789000
- * CONSTANTS AND WORK AREAS * 01790000
- * 01791000
- *********************************************************************** 01792000
- CONREAD DC CL8'CONREAD' PROMPT PLIST @V201105 01793000
- DC AL1(1) @V201105 01794000
- DSNBUF DC AL3(0) INPUT BUFFER @V201105 01795000
- DC CL1'U' TRANSLATE TO UPPER, PAD W/BLNKS @V201105 01796000
- DSNBYTE DC AL3(0) NO. OF BYTES READ @V201105 01797000
- DC X'FFFFFFFF' FENCE @V201105 01798000
- DS 0F 01799000
- GR13SA DS F SAVE GR 13 ON ENTRY. 01800000
- GR15SAVE DS F SAVE GR 15 BEFORE SVCFRET CALL. 01801000
- GR14SA DS F SAVE AREA FOR RETURN REGISTER 01802000
- DENTAB EQU * VALID DENSITY TABLE 01803000
- TWO00 DC CL8'200' 01804000
- EIGHT00 DC CL8'800' 01805000
- SIXTN00 DC CL8'1600' 01806000
- HIDENSTY DC CL8'6250' @V200414 01807000
- DENEND DC CL8'556' 01808000
- TDENSITY DS F USER DENSITY SAVE 01809000
- PLISTEND DC XL4'FFFFFFFF' PARAM LIST END INDICATOR. 01810000
- MAXREC DC F'32760' MAXIMUM LRECL AND BLKSIZE @VA13014 01810100
- DSRNDUM DC C'FT' BUILD AREA FOR DDNAME. 01811000
- REFNUM DS 2C 01812000
- DC C'F001' 01813000
- PREVENT DS F PTR TO PREVIOUS FCB ENTRY. 01814000
- DS 0D ALIGN. 01815000
- PACK DC 2F'0' SPACE FOR PACKED DECIMAL. 01816000
- NUMAX DC F'65535' MAX HALFWORD BINARY. 01817000
- BASE2 DC A(DMSFLD+4096) 01818000
- EIGHT DC F'8' CONSTANT 8. 01819000
- NOCHSAVE DS F 01820000
- CHARMAX EQU 5 01821000
- * PARAMETER LIST FOR SVCFREE AND SVCFRET CALLS. 01822000
- DS 0D ALIGN. 01823000
- PLFREE DS 8C 01824000
- DC 2F'0' N'DBLE WORDS,A(STORAGE) 01825000
- OLDENTRY DC 184X'DD' 01826000
- COPYSIZE EQU 6 01827000
- COPY MVC COPYLIST,0(R5) COPY PLIST IN TRANSAREA 01828000
- ZERO DC F'0' 01829000
- FILE DC CL8'FILE' 01830000
- DUMMY DC CL8'DUMMY' 01831000
- * KEEP THIS ORDER THRU 'CRT' FOR LIST OF ACTIVE FCBS... 01832000
- PRT DC CL8'PRINTER' 01833000
- RDR DC CL8'READER' 01834000
- TERM DC CL8'TERMINAL' 01835000
- TAP DC CL8'TAP' 01836000
- DISK DC CL8'DISK' 01837000
- PUN DC CL8'PUNCH' 01838000
- CRT DC CL8'CRT' 01839000
- BATCH DC CL8'BATCH' 01840000
- MOD DC CL8'MOD' 01841000
- CLEAR DC CL8'CLEAR' 01842000
- TAP2 DC CL8'TAP2' DEFAULT TAPE ID @VA09051 01842500
- A1 DC CL2'A1' 01843000
- PSORG DC CL8'PS' 01844000
- DAORG DC CL3'DA' 01845000
- POORG DC CL3'PO' 01846000
- DSORGPS EQU X'40' 01847000
- DSORGPO EQU X'02' 01848000
- DSORGDA EQU X'20' 01849000
- PERMBIT EQU X'04' 01850000
- * 01851000
- * THIS TABLE CONTAINS ALL VALID OPTIONS, KEYWORD & NON-KEYWORD. 01852000
- * EACH TABLE ENTRY CONSISTS OF THE VALID OPTION NAME, 01853000
- * A FLAG BYTE, AND THE ADDRESS OF A CONFLICTING OPTION, 01854000
- * IF ANY. THE HIGH-ORDER FOUR BITS OF THE FLAG BYTE ARE 01855000
- * SET ON WHEN THE OPTION IS FOUND IN THE COMMAND LINE. 01856000
- * THIS PART OF THE FLAG IS CHECKED WHEN THE CONFLICTING 01857000
- * OPTION IS FOUND IN THE COMMAND LINE. 01858000
- * THE LOW-ORDER BITS SIGNIFY THE DEVICE(S) FOR WHICH THE 01859000
- * OPTION IS VALID. 01860000
- * 01861000
- TABSTART DS 0D 01862000
- PERM DC CL8'PERM',X'00',AL3(0) FLAG X'00' EQUIVALENT TO X'0F' 01863000
- CHANGE DC CL8'CHANGE',X'00',AL3(NOCHANGE) 01864000
- NOCHANGE DC CL8'NOCHANGE',X'00',AL3(CHANGE) 01865000
- RECFM DC CL8'RECFM',X'0F',AL3(0) 01866000
- LRECL DC CL8'LRECL',X'0F',AL3(0) 01867000
- BLOCK DC CL8'BLOCK',X'0F',AL3(0) 01868000
- BLKSIZE DC CL8'BLKSIZE',X'0F',AL3(0) P3100 01869000
- DSORG DC CL8'DSORG',X'08',AL3(0) 01870000
- AUXPROC DC CL8'AUXPROC',X'0F',AL3(0) 01871000
- KEYLEN DC CL8'KEYLEN',X'08',AL3(0) 01872000
- XTENT DC CL8'XTENT',X'08',AL3(0) 01873000
- LIMCT DC CL8'LIMCT',X'08',AL3(0) 01874000
- OPTCD DC CL8'OPTCD',X'08',AL3(0) 01875000
- DISP DC CL8'DISP',X'08',AL3(0) 01876000
- UPCASE DC CL8'UPCASE',X'02',AL3(LOWRCASE) 01877000
- LOWRCASE DC CL8'LOWCASE',X'02',AL3(UPCASE) 01878000
- NINTRACK DC CL8'9TRACK',X'04',AL3(SEVTRACK) 01879000
- SEVTRACK DC CL8'7TRACK',X'04',AL3(NINTRACK) 01880000
- DEN DC CL8'DEN',X'04',AL3(0) 01881000
- TRKTCH DC CL8'TRTCH',X'04',AL3(NINTRACK) 01882000
- MEMBER DC CL8'MEMBER',X'08',AL3(CONCAT) @V201105 01883000
- CONCAT DC CL8'CONCAT',X'08',AL3(0) @V201105 01884000
- TABEND EQU * 01885000
- * 01886000
- RECFTAB EQU * RECFM OPTION SETTINGS 01887000
- DC CL5'F',X'80' 01888000
- DC CL5'FB',X'90' 01889000
- DC CL5'V',X'40' 01890000
- DC CL5'VB',X'50' 01891000
- DC CL5'VBS',X'58' 01892000
- DC CL5'VS',X'48' 01893000
- DC CL5'FS',X'88' 01894000
- DC CL5'FBS',X'98' 01895000
- DC CL5'U',X'C0' 01896000
- DC CL5'FA',X'84' 01897000
- DC CL5'FBA',X'94' 01898000
- DC CL5'VA',X'44' 01899000
- DC CL5'VBA',X'54' 01900000
- DC CL5'VBSA',X'5C' 01901000
- DC CL5'VSA',X'4C' 01902000
- DC CL5'FSA',X'8C' 01903000
- DC CL5'FBSA',X'9C' 01904000
- DC CL5'UA',X'C4' 01905000
- DC CL5'FM',X'82' 01906000
- DC CL5'FBM',X'92' 01907000
- DC CL5'VM',X'42' 01908000
- DC CL5'VBM',X'52' 01909000
- DC CL5'VBSM',X'5A' 01910000
- DC CL5'VSM',X'4A' 01911000
- DC CL5'FSM',X'8A' 01912000
- DC CL5'FBSM',X'9A' 01913000
- RECFEND DC CL5'UM',X'C2' 01914000
- DS F 01915000
- * FOLLOWING FLAG CORRESPONDS TO TO FLAG BYTE IN OPTION TABLE 01916000
- VALFLAG DC X'00' 01917000
- FOUND EQU X'F0' OPTION FOUND IN COMMAND LINE 01918000
- DSKDEV EQU X'08' DEVICE FLAGS 01919000
- TAPDEV EQU X'04' 01920000
- TERMDEV EQU X'02' 01921000
- URECDEV EQU X'01' 01922000
- * 01923000
- TESTBYTE DS X 01924000
- EOPTCD EQU C'E' 01925000
- EOPT EQU X'20' 01926000
- FOPTCD EQU C'F' 01927000
- FOPT EQU X'10' 01928000
- AOPTCD EQU C'A' 01929000
- AOPT EQU X'08' 01930000
- ROPTCD EQU C'R' 01931000
- ROPT EQU X'01' 01932000
- DXTENT EQU X'32' 01933000
- * KEEP FLAGS IN ORDER... 01934000
- FLAG1 DC X'00' FLAG FOR FCB ENTRY MATCH. 01935000
- FLAG4 DC X'00' FLAG FOR ENTRY INTO SVCFREE ROUTINE 01936000
- OLD EQU X'40' 01937000
- NEW EQU X'80' 01938000
- IDMATCH EQU X'20' @VA05963 01939000
- FLAG2 DC X'00' FLAG FOR SCANNER MATCH. 01940000
- MATCH EQU X'FF' 01941000
- NOMATCH EQU X'00' 01942000
- FLAG3 DC X'00' FLAG FOR DSK OR TAP OPTION. 01943000
- LASTCHK EQU X'10' 01944000
- CATFLG EQU X'02' CONCATENATION REQUESTED @V201105 01945000
- NOCH EQU X'01' NOCHNG TO USER SET UP FCB 01946000
- OPTNFLAG DC X'00' INVALID OPTIONS FLAG 01947000
- NOOPTNS EQU MATCH OPTIONS NOT ALLOWED 01948000
- TAPSW DC X'00' SWITCH FOR TAPE OPTIONS 01949000
- RESET EQU X'00' RESET 01950000
- TRK9 EQU X'80' 9TRACK 01951000
- TRK7 EQU X'40' 7TRACK 01952000
- DENSITY EQU X'20' DENSITY SPECIFIED 01953000
- TRTFLAG EQU X'10' 'TRTCH' SPECIFIED 01954000
- DBLKSZ DC H'80' DEFAULT BLOCK SIZE. 01955000
- DLRECL EQU DBLKSZ DEFAULT LRECL. 01956000
- BLANK EQU C' ' 01957000
- SEVEN EQU 7 VALUE @VA11278 01957500
- KEYWORD DS 8C 01958000
- INVCHAR DC X'14' RET CODE INVALID CHARACTER @VA06434 01959000
- BIN0001 EQU B'0001' BINARY MASK '0001' @VA06434 01960000
- CMS EQU 202 01961000
- MSGSWT DC X'00' ERROR MSG PRINT FLAG 01962000
- PRINT EQU X'80' 01963000
- D01 EQU X'01' 1-BYTE DISPLACEMENT @VA05963 01964000
- D16 EQU X'10' 16-BYTE DISPLACEMENT @VA05963 01965000
- D32 EQU X'20' 32-BYTE DISPLACEMENT @VA05963 01966000
- FOUR EQU X'04' LENGTH OF 4-BYTE FIELD @VA06220 01967000
- ASTERISK DC C'****' 6-POINTED SPLATS @VA06220 01968000
- STATLST DS 0D 01969000
- DC CL8'STATE' 01970000
- STATFN DC CL8' ' 01971000
- DC CL8' ' 01972000
- STATFM DC CL2' ' @VA12255 01973000
- DC CL2' ' 01974000
- STATAST DC CL4'****' '*' IS AN INVALID CHARACTER @VA06220 01975000
- EJECT 01976000
- * THE FOLLOWING IS THE TABLE FOR MODE SET FOR TAPE 01977000
- SPACE 3 01978000
- TRTCH EQU * 01979000
- DC B'11001011' 800 BPI/9TRACK 01980000
- DC B'10010011' 800 BPI/ODD /CV- ON/TR-OFF 01981000
- DC B'10111011' 800 BPI/ODD/CV-OFF/TR-ON 01982000
- DC B'10110011' 800 BPI/ODD/CV-OFF/TR-OFF 01983000
- DC B'10101011' 800 BPI/EVEN/CV-OFF/TR-ON 01984000
- DC B'10100011' 800 BPI/EVEN/CV-OFF/TR-OFF 01985000
- DC B'01010011' 556 BPI/ ODD/CV- ON/TR-OFF 01986000
- DC B'01111011' '' 01987000
- DC B'01110011' '' 01988000
- DC B'01101011' " 01989000
- DC B'01100011' " 01990000
- DC B'00010011' 200BPI/ ODD/CV- ON/TR-OFF 01991000
- DC B'00111011' " 01992000
- DC B'00110011' " 01993000
- DC B'00101011' " 01994000
- DC B'00100011' " 01995000
- DC B'11000011' 1600 BPI/9TRACK 01996000
- DC B'11010011' 6250 BPI/9TRACK @V200414 01997000
- SPACE 3 01998000
- * THIS TABLE IS USED BY FILEDEF TO ASSIGN DISPLACEMENTS WITHIN 01999000
- * 'TRTCH' (ABOVE) FOR VARIOUS TAPE OPTIONS SPECIFIED BY THE USER 02000000
- * 02001000
- TRTAB DC C'O ',X'02' P1017 02002000
- DC C'OC ',X'00' P1017 02003000
- DC C'OT ',X'01' P1017 02004000
- DC C'E ',X'04' P1017 02005000
- TRTEND DC C'ET ',X'03' P1017 02006000
- OSTBL DC 256X'00' TRANSLATE TBL FOR DSNAME @V201105 02007000
- ORG OSTBL+C'.' @V201105 02008000
- DC X'01' @V201105 02009000
- ORG OSTBL+256 @V201105 02010000
- EJECT 02011000
- *********************************************************************** 02012000
- * 02013000
- * DSECTS AND DUMMY AREAS 02014000
- * 02015000
- *********************************************************************** 02016000
- * 02017000
- CMSCB 02018000
- FCBSIZ EQU FCBEND-FCBDSNAM @VA06191 02019000
- ADT @VA11278 02019100
- OSFST @VA11278 02019200
- * 02020000
- EJECT 02021000
- NUCON 02022000
- SVCSAVE 02023000
- REGEQU 02024000
- DMSFLD CSECT 02025000
- LTORG 02026000
- COPYLIST DS 0D START OF SAVE AREA 02027000
- END 02028000
ibm/vm370-lib/cms/dmsfld.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator