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 *| > 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 (R9200, 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