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