ACC TITLE 'DMSACC (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME: 00004000
* 00005000
* DMSACC (ACCESS) 00006000
* 00007000
* FUNCTION: 00008000
* 00009000
* TO BRING INTO CORE THE USER FILE DIRECTORY FOR A 00010000
* GIVEN DISK (E.G., 191, 192), SETTING UP THE NECESSARY 00011000
* INFORMATION IN THE ACTIVE DISK TABLE FOR THE GIVEN 00012000
* DISK MODE LETTER. 00013000
* 00014000
* ATTRIBUTES: 00015000
* 00016000
* TRANSIENT; SERIALLY REUSABLE. 00017100
* 00018000
* ENTRY POINTS: 00019000
* 00020000
* ACCESS 00021000
* 00022000
* ENTRY CONDITIONS: 00023000
* 00024000
* R1 = A(PLIST) 00025000
* 00026000
* DS 0F 00027000
* PLIST DC CL8'ACCESS' 00028000
* 00029000
* <DC CL8'CCU' 00030000
* DC CL8'MODE'|'MODE/EXT' 00031000
* <DC CL24'FILEID'>> 00032000
* <DC CL8'(' START OF OPTIONS, IF ANY 00033000
* DC CL8'NOPROFILE'|'ERASE'|'MODE0'> HRC010DS 00034490
* 00035000
* OR 00036000
* 00037000
* DC CL8'(' 00038000
* DC CL8'NODISK' 00039000
* 00040000
* DC X'FFFFFFFF' SIGNIFIES END OF P-LIST 00041000
* 00042000
* EXIT CONDITIONS: 00043000
* 00044000
* NORMAL RETURN 00045000
* 00046000
* R15 = 0 00047000
* 00048000
* ERROR RETURNS 00049000
* 00050000
* R15 DESCRIPTION 00051000
* 00052000
* 4 WARNING - INVALID OPTIONS FOR O/S DISK 00052100
* 00052200
* 24 INVALID PARAMETER LIST 00053000
* 00054000
* 28 SPECIFIED FILES TO BE ACCESSED WERE NOT FOUND 00055000
* ON THE SPECIFIED DISK 00056000
* 00057000
* 36 DEVICE ALREADY ACCESSDE AS READ WRITE 00058000
* 00059000
* 100 DEVICE ERROR, OR 00060000
* DEVICE NOT ATTACHED 00061000
* 00061100
* 104 INSUFFICIENT FREE STORAGE 00061200
* 00062000
* CALLS TO OTHER ROUTINES: 00063000
* 00064000
* DMSLAD, DMSLADN, DMSFREE, DMSFRET, DMSACF, DMSACM, 00065000
* DMSALU, DMSERR 00066000
* 00067000
* CALLED BY (WHERE KNOWN): 00068000
* 00069000
* DMSINT, OR USER (FROM TERMINAL OR EXEC FILE) 00070000
* 00071000
* EXTERNAL REFERENCES: 00072000
* 00073000
* ADTSECT, FVSECT 00074000
* 00075000
* TABLES/WORKAREAS: 00076000
* 00077000
* NONE 00078000
* 00079000
* REGISTER USAGE: 00080000
* 00081000
* R12 BASE 00082000
* R13 FVSECT 00083000
* R11 ADTSECT 00084000
* REST WORK 00085000
* 00086000
* OPERATION: 00087000
* 00088000
* DMSACC IS THE 00089000
* COMMAND WHICH IS USED TO BRING INTO STORAGE THE USER 00090000
* FILE DIRECTORY (UFD) FOR THE USER'S A-DISK OR ANY 00091000
* OTHER DISK (EXCEPT THE S-DISK, WHICH IS LOGGED IN 00092000
* EARLIER BY DMSING & DMSACF), ALSO TO READ THE LABEL & 00093100
* FORMAT 1 DSCB OF ANY O/S DISK BEING ACCESSED AND TO 00093200
* CREATE AN ACTIVE DISK TABLE FOR SUCH O/S DISK. 00093300
* 00094000
* IN THE CMS INTIALIZATION PROCESS, IF THE USER'S FIRST 00095000
* COMMAND IS NOT ACCESS OR FORMAT, 00096000
* DMSACC 00097000
* IS INVOKED AUTOMATICALLY TO LOG IN A USER'S FILES 00098000
* FROM HIS A-DISK. IF A PROFILE EXEC EXISTS IN THE 00099000
* USER'S DIRECTORY, THIS IS EXECUTED, FOLLOWED BY THE 00100000
* FIRST COMMAND TYPED IN. IF THE USER WISHES TO BYPASS 00101000
* THE AUTOMATIC CALL OF HIS PROFILE EXEC, HIS FIRST 00102000
* COMMAND MUST BE ACCESSWITH THE NO PROFILE OPTION SPECIFIED. 00103000
* THIS LOGS IN HIS FILES AS USUAL, BUT BYPASSES THE CALL TO THE 00104000
* PROFILE EXEC. 00105000
* 00106000
* IF AN ACCESS IS ISSUED AT A LATER TIME, FOR ANY DISK, 00107000
* NO SUCH AUTOMATIC CALL TO PROFILE EXEC IS MADE--IT IS 00108000
* EFFECTIVE ONLY ON THE FIRST COMMAND, AS DESCRIBED 00109000
* ABOVE. 00110000
* 00111000
* IF DESIRED, THE PROFILE EXEC ON A USER'S A-DISK CAN 00112000
* CONTAIN EXEC COMMANDS TO ACCESS OTHER DISKS. 00113000
* 00114000
* WHEN DMSACC IS INVOKED TO ACCESS AN O/S DISK, THE 00114100
* OPTIONS NODISK,NOPROF,ERASE AND THE FILEID PARAMETER 00114200
* ARE INVAILD AND A WARNING MESSAGE IS ISSUED TO NOTIFY 00114300
* THE USER. 00114400
* 00114500
* AFTER THE PARAMETER LIST HAS BEEN CHECKED FOR ERRORS AND 00115000
* SPECIAL OPTIONS, DMSACC PROCESSES THE REQUEST DEPENDING 00116000
* ON WHETHER OR NOT THE ERASE OPTION WAS SPECIFIED: 00117000
* 00118000
* 00119000
* CASE 1: ACCESS WITHOUT THE ERASE OPTION BRINGS IN 00120000
* THE DIRECTORY OF EXISTING FILES FOR THE GIVEN 00121000
* DISK. IF THE DISK IS READ-WRITE, THE DIRECTORY 00122000
* OF ALL EXISTING FILES IS BROUGHT INTO STORAGE 00123000
* (REGARDLESS OF ANY REMAINING OPERANDS IN THE 00124000
* PARAMETER LIST). IF THE DISK IS READ-ONLY, THE 00125000
* DIRECTORY OF ONLY THOSE FILES SPECIFIED AS 00126000
* OPERANDS IN THE P-LIST IS BROUGHT INTO STORAGE; 00127000
* IF NO SPECIFIC FILENAMES, FILETYPES, OR 00128000
* FILEMODES WERE SPECIFIED, THEN THE DIRECTORY OF 00129000
* ALL FILES (EXCEPT 0 FILES) IS BROUGHT IN. 00130000
* IF THE DISK IS AN O/S DISK, THE FORMAT 1 DSCB IS 00130100
* READ AND THE ACTIVE DISK TABLE IS COMPLETED TO 00130200
* CONTAIN THE LABEL,UPPER AND LOWER EXTENTS OF THE 00130300
* VTOC AND THE O/S FLAG IN ADTFLG2 IS SET. 00130400
* 00131000
* 00132000
* 1. DMSALU IS CALLED TO CLEAR 00133000
* ALL PERTINENT INFORMATION IN THE OLD ACTIVE DISK 00134000
* TABLE. 00135000
* 00136000
* 2. IF THE DISK TO BE LOGGED IN WILL BE A READ-ONLY 00137000
* EXTENSION OF ANOTHER (OR OF ITSELF), THE READ-ONLY 00138000
* | FLAG-BIT IN ADTFLG3 IS THEN SET TO FORCE THE DISK 00139000
* TO BE READ-ONLY. 00140000
* 00141000
* 3. DMSACF IS THEN CALLED TO BRING 00142000
* IN THE ENTIRE OR PARTIAL DIRECTORY OF THE DISK. 00143000
* 00144000
* 4. IF THIS DISK WAS READ-ONLY (EITHER FROM SETTING 00145000
* THE FLAG-BIT FROM ABOVE OR FROM OBTAINING AN ERROR 00146000
* 4 FROM 00147000
* DMSACF, 00148000
* A CHECK IS MADE MADE TO SEE IF ANY FILES AT ALL 00149000
* WERE ACCESSED; IF NOT, AN ERROR CODE IS SET, DMSALU 00150000
* IS CALLED TO CLEAR THE ACTIVE DISK TABLE (ADT) 00151000
* ENTRY, AND THE DISK IS NOT LOGGED IN. IF 00152000
* READ-ONLY AND AT LEAST ONE FILE IS ACCESSIBLE, 00153000
* THEN THE READ-ONLY RESPONSE IS GIVEN. 00154000
* 00155000
* 5. IF THE DISK IS TO BE A READ-ONLY EXTENSION OF 00156000
* ANOTHER, THE EXTENSION-MODE-LETTER IS STORED IN 00157000
* THE ADTMX SLOT IN THE ADT BLOCK FOR THE DISK JUST 00158000
* LOGGED IN. ALSO, ANOTHER BIT (ADTROX) IS SET IN 00159000
* THE ADTFLG1 FLAGBYTE OF THE ADT FOR THE OTHER 00160000
* DISK, TO INDICATE THAT IT HAS AT LEAST ONE 00161000
* READ-ONLY EXTENSION. 00162000
* 00163000
* 6. A CHECK IS MADE TO SEE IF THE DISK JUST LOGGED IN 00164000
* IS ALSO LOGGED IN AS ANY OTHER DISK(S). IF YES, 00165000
* AND THE NEWLY LOGGED IN DISK IS READ-WRITE, THE 00166000
* OTHER DISK(S) ARE RELEASED VIA DMSALU 00167000
* AND A MESSAGE IS TYPED 00168000
* TO INDICATE THE RELEASE OF THE CCU AS 00169000
* THE OTHER DISK(S). IF YES, AND THE NEWLY, LOGGED 00170000
* IN DISK IS READ-ONLY A MESSAGE IS TYPED 00171000
* INDICATING THAT THE CCU IS ALSO 00172000
* LOGGED IN AS THE OTHER MODE LETTER. 00173000
* 00174000
* ACCESS FOR CASE 1 IS FINISHED. THE DISK IS LOGGED 00175000
* IN, AN EXTENSION-MODE-LETTER STORED IF APPROPRITATE, 00176000
* INFORMATIVE MESSAGES (IF ANY) HAVE BEEN TYPED, AND 00177000
* THE DISK IS READY TO USE. 00178000
* 00179000
* CASE 2: ACCESS WITH THE ERASE OPTION BRINGS IN THE NECESSARY 00180000
* FILE DIRECTORY INFORMATION FROM THE 00181000
* DISK-RESIDENT FILE DIRECTORY, BUT OMITS THE FST 00182000
* ENTRIES OF THE PRE-EXISTING FILES. ALL 00183000
* NECESSARY TABLES AND DISK COUNTERS ARE CLEARED, 00184000
* GIVING THE USER A CLEAN DIRECTORY FOR THE GIVEN 00185000
* DISK AS IF HE HAD CALLED FORMAT OR HAD ERASED 00186000
* ALL FILES. ERASE OR EQUIVALENT IS VALID ONLY 00187000
* FOR A READ-WRITE DISK, AND THE 'CUU' MUST BE 00188000
* SPECIFIED. IF BOTH CONDITIONS DO NOT EXIST, 00189000
* ERASE IS CONSIDERED AS AN INVALID 00190000
* OPTION. 00191000
* 00192000
* DMSACC CHECKS THE PARAMETER LIST FOR THE EXISTENCE OF 00193000
* A CCU DISK ADDRESS AND A POSIBLE MODE LETTER. 00194000
* 00195000
* IF THE CCU IS PROVIDED, THE VALUE OF THE HEXADECIMAL 00196000
* NUMBER IS COMPUTED; LEADING ZEROES ARE PERMISSIBLE, 00197000
* BUT THE COMPUTED VALUE MUST BE NONZERO AND LESS THAN 00198000
* X'FFF'. IF PROVIDED AND LEGITIMATE, ITS VALUE IS 00199000
* USED IN PLACE OF THE DEFAULT DISK-ADDRESS (I.E., 191) 00200000
* IN THE DEVICE TABLE. 00201000
* 00202000
* IF A DISK MODE IS GIVEN, DMSLAD IS 00203000
* CALLED TO FIND THE MATCHING ACTIVE DISK TABLE FOR THE 00204000
* GIVEN LETTER. (IF THE DISKMODE IS OMITTED, THE 00205000
* A-DISK IS USED AS A DEFAULT.) IF A READ-ONLY 00206000
* EXTENSION IS ALSO GIVEN 00207000
* DMSLAD IS AGAIN CALLED, TO ENSURE 00208000
* THAT AN ACTIVE DISK TABLE EXISTS FOR THE DISK GIVEN 00209000
* BY THE EXTENSION-MODE-LETTER. 00210000
* 00211000
* IF A DISK TO BE LOGGED IN WILL REPLACE ANOTHER DISK 00212000
* WHICH IS CURRENTLY LOGGED IN, THEN A MESSAGE 00213000
* INDICATING THAT THIS WILL OCCUR IS TYPED. 00214000
* 00215000
* 00216000
* 1. DMSALU IS CALLED TO CLEAR 00217000
* ALL PERTINENT INFORMATION IN THE OLD ACTIVE DISK 00218000
* TABLE. 00219000
* 00220000
* 2. THEN DMSACM IS CALLED TO 00221000
* BRING IN ALL PERTINENT INFORMATION ON THE DISK 00222000
* EXCEPT THE FST HYPERBLOCKS CONTAINING THE FST 00223000
* ENTRIES (WHICH WOULD HAVE BEEN BROUGHT 00224000
* IN IF DMSACF HAD BEEN CALLED). 00225000
* 00226000
* 3. IF AN ERROR IS RETURNED BY DMSACM 00227000
* IT IS RETURNED TO THE CALLER WITH THE ERROR 00228000
* PROPER ERROR CODE. NOTE THAT IF THE DISK IS 00229000
* READ-ONLY, THIS IS TREATED AS AN ERROR CONDITION. 00230000
* 00231000
* 4. UPON SUCCESSFUL RETURN FROM DMSACM, IF THE DISK 00232100
* IS AN O/S DISK, CONTROL IS RETURNED TO THE CALLER, 00232200
* OTHERWISE DMSACC 00232300
* OBTAINS AN 816-BYTE BLOCK FROM FREE STORAGE FOR 00233000
* THE FIRST FST HYPERBLOCK, CLEARS IT, AND 00234000
* INITIALIZES THE ADTRES RESERVE-COUNT AND ALL OTHER 00235000
* NECESSARY POINTERS AND COUNTERS IN THE ADT. 00236000
* 00237000
* 5. THE QMSK BROUGHT IN BY DMSACM 00238000
* IS NOW CLEARED, AND THE APPROPRIATE DISK COUNTS 00239000
* RECOMPUTED AND STORED TO REFLECT A CLEAN DISK. 00240000
* 00241000
* THE QQMSK BROUGHT IN BY DMSACM IS ALSO CLEARED. 00242000
* 00243000
* CAUTION: ACCESS WITH THE ERASE OPTION SHOULD ONLY BE USED 00244000
* WHEN ALL OLD FILES ON A DISK (IF ANY) ARE TO BE 00245000
* DISCARDED. IT IS EQIVALENT, IN EFFECT, TO FORMAT'ING 00246000
* THE DISK, OR ERASING ALL FILES THEREON, BUT IS MUCH 00247000
* FASTER AND MORE EFFICIENT. NOTE, HOWEVER, THAT IF A 00248000
* USER ISSUES THIS OPTION BY MISTAKE, THE FILE 00249000
* DIRECTORY ON THE GIVEN DISK HAS PURPOSELY NOT BEEN 00250000
* UPDATED BY DMSACC (NO CALL TO DMSAUD IS MADE); 00251000
* AND THEREFORE THE USER CAN RECOVER HIS FILES BY 00252000
* IMMEDIATELY ISSUING AN ACCESS COMMAND FOR THE DISK 00253000
* WITHOUT THE ERASE OPTION. 00254000
* 00255000
* NOTES: 00256000
* 00257000
* 1. IF ANY DISK IS LOGGED IN AS A CMS R/O DISK, FOR 00258100
* WHATEVER REASON, ONLY FILES HAVING A MODE-NUMBER 00259000
* OF 1-6 ARE ACCESSED. FOR A READ-WRITE DISK, ALL 00260000
* FILES ARE ACCESSIBLE, FROM MODE NUMBERS 0-6. 00261000
* THEREFORE, 0 FILES ON ANY DISK CAN BE CONSIDERED 00262000
* "PRIVATE" TO THE USER WHO HAS READ-WRITE ACCESS TO 00263000
* THE DISK, AND NO ONE HAVING READ-ONLY ACCESS TO 00264000
* THE DISK CAN REFERENCE THEM. 00265000
* 00266000
* 2. IF THE FIRST USER COMMAND IS ACCESS, THEN DMSINT 00267000
* AND DMSACC (WHICH WORK TOGETHER ON THE FIRST COMMAND 00268000
* ISSUED AT THE TERMINAL) ACCEPT THAT FIRST COMMAND AS IS, 00269000
* AND DO NOT ISSUE ANY IMPLIED AUTOMATIC ACCESS OF 00270000
* THE USER'S NORMAL A-DISK (191). THEREFORE, IF THE 00271000
* USER WISHES TO ACCESS HIS A-DISK AND THEN 00272000
* IMMEDIATELY ACCESS ANOTHER DISK IN ADDITION, HE 00273000
* SHOULD ISSUE A SPECIFIC ACCESS COMMAND FOR HIS 00274000
* A-DISK FIRST, AND THEN THE OTHER COMMAND. 00275000
* 00276000
* IF THE USER DOES NOT WISH TO ACCESS ANY USER DISKS 00277000
* AT ALL WITH HIS FIRST COMMAND, THIS CAN BE 00278000
* ACCOMPLISHED BY ISSUING THE COMMAND WITH THE 'NODISK' 00279000
* OPTION. THIS IS EFFECTIVELY HANDLED AS A NO-OPERATION BY 00280000
* DMSACC WHEN CALLED BY DMSINT 00281000
* TO HANDLE TO FIRST USER COMMAND. 00282000
* 00283000
*. 00284000
EJECT 00285000
********************************************************************** 00286000
* 00287000
* ACCESS 00288000
* 00289000
********************************************************************** 00290000
* 00291000
MACRO 00292000
&LABEL TRHEX &MSG 00293000
&LABEL LA R15,&MSG 00294000
BAL R14,TRHEXIT 00295000
MEND 00296000
* 00297000
ACCESS START 0 TRANSIENT DISK-RESIDENT 00298000
* 00299000
EXTRN READFST,READMFD,RELUFD *INCL WITH "ACCESS" MOD*@V305032 00300000
* 00301000
USING NUCON,R0 00302000
LR BASE,R15 SET UP BASE REGISTER (R2) 00303000
USING ACCESS,BASE ... 00304000
* | NOTE: ALREADY HAS NUCLEUS PROTECT KEY 00305100
LR R12,R13 USE WORKING-STORAGE PROVIDED BY INTSVC 00306000
USING WORKING,R12 FOR AS MUCH WORKING STORAGE AS FEASIBLE. 00307000
LR R3,R1 SAVE PLIST PTR IN R3 00308000
SR R15,R15 CLEAR R15 (WILL BE RETURN-CODE LATER) 00313000
STM R13,R15,R13SAVE SAVE R13-R14-R15 FOR EXIT TIME 00314000
STH R15,OPTBYTE CLEAR OPTBYTE & FRSTFLG 00315000
ST R15,REPREG AND CLEAR "REPLACE" INDICATORS 00316000
MVI XLETTER,C' ' EXTENSION-MODE-LETTER = BLANK 00317000
MVC MSG3CMP(7),MSG3BLD INITIALIZE P-LIST ERROR MSG 00318000
L R13,AFVS ACCESS 'FVS' INFORMATION 00319000
USING FVSECT,R13 ... 00320000
OI UFDBUSY,WRBIT SET 'OUR' BIT IN UFDBUSY FLAG, 00321000
LA R10,ERROR6 SET R10 TO BRANCH FOR P-LIST ERRORS 00322000
L R11,IADT 00323000
USING ADTSECT,R11 ... 00324000
L R9,ADTDTA REFERENCE DEVICE IN NUCON 00325000
MVI MSG6MOD,C'A' INITIATE R/O MODE P3034 00326000
* 00327000
CLI 8(R3),X'FE' SPECIAL FLAG FROM INIT = 'FIRST TIME' ? 00328000
BE FCODE GO TO ONCE-ONLY CODE FOR INITIALIZING 00329000
* 00330000
LOGREG EQU * PERFORM REGULAR 'ACCESS' LOGIC: @V305032 00331000
CLI 8(R3),X'FF' IS ANYTHING SPECIFIED 00332000
BNE GOTPARM IF SO CONTINUE CHECKING 00333000
LA R4,DEFLTDEV LOAD REG WITH DEFAULT DEVICE 00334000
B R11OK PROCESS AS A-DISK 00335000
GOTPARM EQU * 00336000
LR R4,R3 LET R4 POINT TO ACCESS P-LIST @V305032 00337000
CLI 8(R4),C'(' 00338000
BNE CKFF 00339000
OI OPTBYTE,OPTNORMR HRC010DS 00340490
LA R4,8(,R4) 00341000
CKFF CLI 8(R4),X'FF' 00342000
BE CONT 00343000
TM OPTBYTE,OPTNORMR HRC010DS 00344490
BNO DISKNUM 00345000
LA R15,8(R4) GET ADDR OF OPTION 00346000
NI OPTBYTE,X'FF'-OPTNORMR OFF OPT FOR RET TO R11OK HRC010DS 00347040
SR R5,R5 CLEAN R5 @VA05466 00347100
LH R5,DTAD(,R9) SAVE OLD DEVICE IN CASE OF ERROR @VA13896 00347500
B WHICHOPT CHECK IT OUT 00348000
DISKNUM EQU * 00349000
LA R7,DEVNME SET ELEMENT NAME PTR 00350000
LA R8,8(R3) SET ITEM PTR 00351000
LA R6,DEVID SET MSG ID 00352000
MVC MSG3CMP(7),=CL7'ADDRESS' SET ADDITIONAL FIELD IN MSG. 00353000
CLI 11(R3),C' ' MUST BE AT LEAST ONE BLANK AFTER DISK-NO. 00358000
BCR 7,R10 "BNE ERROR6" IF NOT. 00359000
SR R4,R4 CLEAR A REGISTER 00361000
SR R5,R5 AND ANOTHER 00362000
LA R1,8(R3) GET ADDR OF ELEMENT IN P-LIST 00363000
B CKBYTE NOW, GO BUTCHER IT. 00364000
SPACE 00365000
TESTIT CLI 0(R1),C'A' MATCH IT WITH 'A'. 00366000
BL ERROR6 ERROR IF LOW. 00367000
CLI 0(R1),C'F' AND NOW WITH AN 'F'. 00368000
BH ERROR6 ERROR IF HIGH 00369000
IC R5,0(,R1) STUFF IT INTO A REGISTER. 00370000
SH R5,=XL2'00B7' BEND IT. 00371000
R5OK SLL R4,4 MAKE ROOM. 00372000
OR R4,R5 MARRY 00373000
GETBYTE LA R1,1(,R1) POINT TO THE NEXT CHARACTER. 00374000
CKBYTE CLI 0(R1),C'0' COMPARE WITH ZERO. 00375000
BL TESTA IF LOW, CAN BE ALPHA. 00376000
IC R5,0(,R1) STUFF IT INTO A REGISTER. 00377000
SH R5,=XL2'00F0' BEND IT. 00378000
CLI 0(R1),C'9' NUMERIC? 00379000
BNH R5OK ONLY IF NOT HIGH. 00380000
B ERROR6 NO GOOD AT ALL. 00381000
TESTA CLI 0(R1),C' ' DONE YET? 00382000
BNE TESTIT NOPE. 00383000
C R4,MAXPOSS IS IT GREATER THAN X'FFF'? @VA04296 00384000
BH ERROR6 ERROR IF SO @VA01991 00385100
LTR R4,R4 =X'000'? @VA01991 00385200
BNZ STRNEWP IF NOT THEN IT'S OK @VA01991 00385300
ERROR6 EQU * 00386000
MVC MSG3NME,0(R7) MOVE IN THE ELEMENT 00387000
MVC MSG3ITEM(8),0(R8) MOVE IN THE COMMAND LINE ELEMENT 00388000
CLC MSG3ITEM(4),=X'FFFFFFFF' PLIST END INSERTED? @VA04876 00388100
BNE ERRORLST NO, NO PROBLEM @VA04876 00388300
MVI MSG3ITEM,C' ' OTHERWISE PREPARE TO BLANK FIELD @VA04876 00388500
MVC MSG3ITEM+1(7),MSG3ITEM WE DONT WANT FFS IN MSG @VA04876 00388700
ERRORLST DMSERR MF=(E,ERLIST),NUM=(R6),LET=E,TEXTA=MSG3,DOT=NO @VA04876 00389500
MVI ERRCODE,MSG3RC SET RETURN CODE 00390000
B REST14 GO TO EXIT 00391000
* 00392000
STRNEWP EQU * 00393000
MVC MSG3CMP(7),MSG3BLD BLANK OUT UNNEEDED VERBAGE 00394000
LA R7,MODENME SET ELEMENT NAME PTR 00395000
LA R8,16(R3) SET ITEM PTR 00396000
LA R6,MODEID SET MODE I. D. 00397000
CLI 19(R3),C' ' ENSURE THREE CHAR. MAX MODE COMBO 00402000
BCR 7,R10 IF MORE THAN THREE IT'S NO GOOD 00403000
MVC MSG3CMP(7),MSG3BLD BLANK OUT UNNEEDED VERBAGE 00404000
CLI 16(R3),C'A' DISK-MODE MUST BE A TO Z 00405000
BLR R10 COMMENT @VA05161 00406100
CLI 16(R3),C'Z' OR 00407000
BCR 2,R10 "BH ERROR6" IF > A 00408000
CLI 16(R3),C'S' HOPEFULLY NOT THE S-DISK, 00409000
BCR 8,R10 "BE ERROR6" (BAD SHOW) IF YES. 00410000
LR R1,R3 LET R1 POINT TO MODE-LETTER LESS 24, 00411000
SH R1,=H'8' 00412000
L R15,VCADTLKP CALL ADTLKP, @VM03093 00413100
BALR R14,R15 ... 00414000
BCR 7,R10 BNE ERROR6 IF NO MATCHING MODE-LETTER FOUND 00415000
LR R11,R1 ACCESS ACTIVE-DISK-TABLE IF FOUND. 00416000
CLI 17(R3),C' ' BYTE AFTER DISKMODE = BLANK ? 00417000
BE R11OK BE IF YES. 00418000
CLI 17(R3),C'/' MUST BE SLASH IF NOT BLANK 00419000
BCR 7,R10 "BNE ERROR6" IF NEITHER BLANK NOR COMMA 00420000
CLI 18(R3),C'A' DISK-MODE MUST BE A TO Z 00421000
BCR 4,R10 "BL ERROR6" IF < A 00422000
CLI 18(R3),C'Z' OR 00423000
BCR 2,R10 "BH ERROR6" IF > Z 00424000
CLC ADTM(1),18(R3) 00425000
BCR 4,R10 00426000
LA R1,2(,R3) LET R1 POINT TO 00427000
SH R1,=H'8' EXTENSION-MODE LETTER LESS 24 00428000
L R15,VCADTLKP MAKE SURE DISK CORRESPONDING TO @VM03093 00429100
BALR R14,R15 EXTENSION-MODE-LETTER EXISTS 00430000
BCR 7,R10 "BNZ ERROR6" IF IT DOESN'T 00431000
DROP R11 00432000
USING ADTSECT,R1 00433000
TM ADTFLG1,ADTFRO+ADTFRW 00434000
BNZ TESTOK 00435000
TM ADTFLG2,ADTFROS IS THIS AN OS DISK @V201101 00435100
BO TESTOK OKAY, THEN CONTINUE @V201101 00435200
CLC ADTM(1),16(R3) 00436000
BCR 7,R10 00437000
TESTOK MVC XLETTER(1),18(R3) SAVE EXTENSION MODE LETTER 00438000
R11OK EQU * MAKE SURE THIS DISK ISN'T LOGGED IN AS ANOTHER... 00439000
SR R1,R1 START WITH FIRST ACTIVE-DISK... 00440000
LOGIN2 L R15,VCADTNXT ACCESS 'NEXT' ACTIVE DISK, @VM03093 00441100
BALR R14,R15 ... 00442000
BNZ LOGIN4 IF ERROR, THAT'S ALL THERE ARE. 00443000
CR R1,R11 DON'T TEST 'THIS' DISK 00444000
BE LOGIN2 ... 00445000
TM ADTFLG1,ADTFRW IS IT A READ-WRITE DISK LOGGED IN ? 00446000
BZ LOGIN2 BZ IF NOT (IGNORE IT) 00447000
L R9,ADTDTA LOOK AT DEVICE-ADDRESS IN NUCON, 00448000
CH R4,DTAD(,R9) IS 'THIS' DISK THE SAME NUMBER ? 00449000
BNE LOGIN2 BNE IF NOT (IGNORE IT) 00450000
CLI XLETTER,C' ' 00451000
BNE RDEXT @VA04015 00452100
LR R15,R1 @VA04015 00452200
BAL R14,FINISDSK FINIS OLD DISK @VA04015 00452300
B LOGIN4 CONTINUE @VA04015 00452400
* ERROR 7 (WITH MESSAGE 9) IF 'THIS' DISK 00453000
* MATCHES ANOTHER DISK-TABLE WITH SAME NUMBER 00454000
* ALREADY LOGGED IN AS A READ-WRITE DISK... 00455000
RDEXT MVC MSG9MODE(1),ADTM SET MODE IN MESSAGE @VA04015 00456000
TRHEX MSG9DEV 00457000
DMSERR MF=(E,ERLIST),NUM=MSG9ID,LET=E,TEXTA=MSG9,DOT=NO 00458000
MVI ERRCODE,MSG9RC SET ERROR CODE 00459000
B REST14 GO EXIT. 00460000
DROP R1 00461000
* 00462000
LOGIN3 CLI 16(R3),C'(' 00463000
BCR 7,R10 00464000
SH R3,EIGHT P-LIST PTR TO POINT 8 BELOW PLIST@V305032 00465000
B R11OK GO TO COMMON LOGIC. IT WILL PROC. 00466000
* THE OPTIONS AFTER DEVICE IS CHECKED 00467000
* 00468000
USING ADTSECT,R11 00469000
LOGIN4 MVC MSG6A(1),ADTM PUT THE NEW MODE IN THE RESPONSE @VA04015 00470000
L R9,ADTDTA AND REFERENCE DEVICE IN NUCON 00471000
LH R5,DTAD(,R9) SAVE OLD DEVICE IN CASE OF ERROR 00472000
TM ADTFLG1,ADTFRO+ADTFRW ANYTHING ACTUALLY LOGGED IN ? 00475000
BNZ REPMSG BNZ IF YES, SET REPLACE MSG @V201101 00476100
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00476200
BZ LOGIN6 BZ IF NOT, FORGET IT @V201101 00476300
REPMSG EQU * @V201101 00476400
MVC MSG7MODE(1),ADTM SET MODE IN MSG 00477000
TRHEX MSG7RPEE 00478000
STH R4,DTAD(,R9) SET UP TO DEV. ADDR FOR TRANSLATION 00479000
TRHEX MSG7RPER 00480000
LA R0,MSG7L GET LENGTH OF MSG FOR LATER TEST 00481000
LA R1,MSG7 . 00482000
STM R0,R1,REPREG SAVE FOR LATER AFTER CHECKING COMPLETED. 00483000
LOGIN6 STH R4,DTAD(,R9) 00484000
CLI 8(R3),X'FF' WAS CCU & MODE SPECIFIED? 00485000
BE CONT NOPE ! 00486000
TM PONLY,X'01' CHECK IF ONLY OPTIONS SPEC'ED 00487000
MVI PONLY,X'00' REINIT SWITCH 00488000
BO CONT IF ON FORGET THE REST OF THE CHECKS 00489000
LA R4,16(,R3) PT TO PARAM. AFTER MODE 00490000
CLI XLETTER,C' ' CHECK IF READ ONLY EXTENSION 00491000
BNE EXTDISK IF SO THEN FILEID SPEC OK 00492000
LA R14,SETLAST IF NOT, SET BRANCH TO REJECT FILEID 00493000
B SET BYPASS SETTING FOR GOOD CONDITIONS 00494000
EXTDISK EQU * 00495000
LA R14,FILEN 00496000
SET CLI 8(R4),X'FF' NO MORE PARAMETERS? 00497000
BE CONT THEN CONTINUE 00498000
CLI 8(R4),C'(' OPTIONS? 00499000
BCR 7,R14 NO, FILENAME 00500000
OI OPTBYTE,OPTNORMR OPTION BYTE FOR NORMAL RETURNHRC010DS 00501490
LA R15,8(,R4) POINT REG AT LEFT PAREN. 00502000
B CKOPTION CHECK OPTION(INCLUDING FENCE) 00503000
SPACE 00504000
FILEN EQU * 00505000
MVI FSTFTYPE,X'FF' INIT FILE TYPE AND FILE MODE 00506000
MVC FSTFTYPE+1(9),FSTFTYPE TO X'FF'S 00507000
OI OPTBYTE,OPTNAMEF TURN NAME FLAG ON HRC010DS 00508490
MVC FSTFNAME(8),8(R4) SAVE NAME FOR READFST 00509000
LA R4,8(,R4) 00510000
BAL R14,SET 00511000
MVC FSTFTYPE(8),8(R4) SAVE TYPE FOR READFST 00512000
LA R4,8(,R4) 00513000
BAL R14,SET 00514000
* IF AN INVALID MODE IS DETECTED, THE 00515000
* THE ELEMENT WILL BE HANDLED 00516000
* BY END OF LIST PROCESSING 00517000
VERMODE EQU * VERIFY THE MODE 00518000
CLI 9(R4),C' ' CHECK FOR ONE CHAR. SPECIFIED 00519000
BNE CHKTWO IF NOT, CHECK LIMIT FOR TWO 00520000
CLI 8(R4),C'*' IF ONLY ONE, IT HAS TO BE AN ASTERISK 00521000
BE MODEOK BRING IN ALL MODES 00522000
B SETLAST FLUSH ITEM SINCE IT'S NOT A MODE 00523000
CHKTWO CLI 10(R4),C' ' MAKE SURE THAT ONLY TWO ARE HERE 00524000
BNE SETLAST IF NOT TWO, IT'S NOT A VALID MODE 00525000
CLC 16(1,R3),8(R4) MAKE SURE LINE IS CONSISTENT 00526000
BNE SETLAST IF MODE TO BE ACC. NE FMODE SPEC'ED FLUSH 00527000
CLI 8(R4),C'S' CHECK LETTER 'S' HRC002DS 00528490
BE SETLAST IF NOT, IT'S NO GOOD('S' IN N.G.)HRC002DS 00528980
CLI 8(R4),C'A' IS THIS AN 'A' HRC002DS 00529470
BL SETLAST LESS THAN AN 'A' HRC002DS 00529960
CLI 8(R4),C'Z' IS THIS AN 'Z' HRC002DS 00530450
BH SETLAST GREATER THAN A 'Z' HRC002DS 00530940
CKMODNO EQU * 00532000
TM OPTBYTE,OPTMODE0 HRC010DS 00532100
BNO CHKMODE1 HRC010DS 00532200
CLI 9(R4),C'0' CHECK LOW END ACCEPTABLE MODE NO.HRC010DS 00532300
BE MODEOK RANGE IS '0' THRU '5' HRC010DS 00532400
CHKMODE1 EQU * HRC010DS 00532500
CLI 9(R4),C'1' CHECK LOW END ACCEPTABLE MODE NO. 00533000
BL SETLAST RANGE IS '1' THRU '5' 00534000
CLI 9(R4),C'5' CHECK HIGH END 00535000
BH SETLAST TREAT AS BAD PARAM 00536000
MODEOK EQU * 00537000
MVC FSTFMODE(2),8(R4) SAVE MODE FOR READFST 00538000
LA R4,8(,R4) 00539000
SETLAST EQU * 00540000
LA R14,RESET RESET DEVICE ADDR ONLY AS LAST RESORT 00541000
LA R7,PARMNME SET ELEMENT NAME PTR 00542000
LA R8,8(R4) SET ITEM PTR 00543000
LA R6,PARMID SET PARAMETER I. D. 00544000
B SET GO THROUGH LOOP FOR LAST TIME 00545000
RESET EQU * @VA05466 00546100
STH R5,DTAD(,R9) RESTORE ORIGINAL DEVICE @VA05466 00546400
RESETA BR R10 GO TO ERROR ROUTINE @VA05466 00546500
SPACE 00549000
CKOPTION LA R15,8(,R15) 00550000
CLI 0(R15),X'FF' 00551000
BE OPTEND 00552000
CLI 0(R15),C')' 00553000
BNE WHICHOPT 00554000
OPTEND TM OPTBYTE,OPTNORMR HRC010DS 00555490
BO CONT 00556000
LA R4,DEFLTDEV SET REG TO INDICATE DEFAULT DEVICE 00557000
OI PONLY,X'01' SET SW TO INDICATE OPTIONS ONLY 00558000
* NO DEVICE SPECIFIED INDICATED BY X'80' BIT NOT SET 00559000
TM OPTBYTE,OPTERASE CHK IF ERASE OPTION WITH NO DEVHRC010DS 00560490
BZ R11OK IF NOT IT'S OK 00561000
LH R5,DTAD(,R9) GET DEVICE ADDRESS @VA04732 00561500
LA R8,ERASE SET ITEM POINTER 00562000
MVI PONLY,X'00' RESET SW FOR NEXT TIME 00563000
B ITEMSET GO TO SET UP REST OF MSG 00564000
WHICHOPT EQU * DETERMINE WHICH OPTIONS 00565000
CLC 0(8,R15),MODE0 IS MODE0 R/O REQUESTED ? HRC010DS 00565100
BNE OPT20 HRC010DS 00565200
OI OPTBYTE,OPTMODE0 HRC010DS 00565300
B CKOPTION AND CHECK FOR ADDITIONAL OPTIONS HRC010DS 00565400
OPT20 EQU * HRC010DS 00565500
CLC 0(8,R15),NOPROFIL IS THE OPTION FOR NOPROFILE? 00566000
BNE OPT2 IF NOT, CHECK NEXT 00567000
OI OPTBYTE,OPTNOPRO IF SO, SET ON FLAG HRC010DS 00568490
B CKOPTION AND CHECK FOR ADDITIONAL OPTIONS 00569000
OPT2 CLC 0(8,R15),ERASE IS THE OPTION FOR ERASE 00570000
BE OPTGD O.K. 00571000
OPTNG EQU * 00572000
LR R8,R15 SET ITEM POINTER 00573000
ITEMSET LA R7,OPTNME SET ELEMENT NAME POINTER 00574000
LA R6,OPTID SET OPTION I. D. 00575000
B RESET BRANCH TO RESET THEN ERROR @VA02348 00576000
OPTGD EQU * 00577000
OI OPTBYTE,OPTERASE SIGNAL: NO-UFD WANTED HRC010DS 00578490
CLI XLETTER,C' ' BUT CAN'T BE AN EXTENSION OF ANYTHING 00579000
BE CKOPTION OK (RETURN) IF XLETTER = BLANK 00580000
B OPTNG THE OPTION IS NOT VALID WITH THIS 00581000
SPACE 2 00582000
CONT LM R0,R1,REPREG SET UP TO DO 'REPLACE' MESSAGE 00583000
LTR R0,R0 SHOULD WE ? 00584000
BZ CONT1 TRF IF NOT (FORGET IT) 00585000
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00585100
BZ NOTOS BZ IF NOT, USE REGULAR MSG @V201101 00585200
LA R15,MSG7L+L'MSG7OS GET NEW LENGTH OF MSG @V201101 00585300
BCTR R15,0 ADJUST LENGTH FOR PLIST @V305101 00585310
STC R15,MSG7 SAVE IN REPLACE MSG LIST @V201101 00585400
MVC MSG7OS+2(L'OSL),OSL INITIALIZE AS O/S DISK @V305101 00585420
TM ADTFLG2,ADTFDOS IS IT DOS DISK ? @V305101 00585440
BZ NOTOS NO, TYPE MESSAGE AS OF NOW @V305101 00585460
MVC MSG7OS+2(L'DOSL),DOSL SET DOS DISK LITERAL @V305101 00585480
NOTOS EQU * @V201101 00585500
LR R15,R1 LET ADDR OF MSG IN R15 00586000
DMSERR MF=(E,ERLIST),NUM=MSG7ID,LET=I,TEXTA=(R15),DOT=NO 00587000
BCTR R0,R0 SUBTRACT ONE FOR LENGTH BYTE @V201122 00587100
STC R0,MSG7 RESTORE OLD LENGTH IN MSG @V201101 00587200
CONT1 TM OPTBYTE,OPTERASE IS NOUFD BIT ON? HRC010DS 00588490
BO NOUFD IF SO, GO DO "ACCESS ERASE" @V305032 00589000
TM OPTBYTE,OPTNAMEF WANT ONLY SPECIFIED FILES? HRC010DS 00590490
BNO UFD NO, GO ACCESS ALL @V305032 00591000
LA R1,FSTPLIST-8 YES, PT TO FST'S PLIST 00592000
B UFD01 GO ACCESS PARTIAL DISK @V305032 00593000
EJECT 00594000
*********************************************************************** 00595000
* 00596000
* "ACCESS" GIVEN DISK (WITH SOME/ALL FILES)... 00597000
* 00598000
*********************************************************************** 00599000
SPACE 00600000
UFD LA R1,FENCE-8 SET R1 TO ACCESS ALL FILES @V305032 00601000
* 00602000
UFD01 TRHEX MSG6DEV GET DEVICE ADDR READY FOR PRINTING 00603000
LH R4,DTAD(,R9) SAVE NEW DISK ADDRESS @VA04796 00603030
STH R5,DTAD(,R9) AND STORE OLD DISK ADDRESS @VA04796 00603060
LR R15,R11 POINT TO ACTIVE DISK TABLE, @VA04015 00603100
BAL R14,FINISDSK AND "FINIS" ANY OPEN CMS FILES @VA04015 00603200
STH R4,DTAD(,R9) STORE NEW DISK ADDRESS @VA04796 00603600
LR R0,R11 R0 POINTS TO ACTIVE-DISK-TABLE, 00604000
L R15,ARELUFD CALL 'RELUFD' TO RELEASE 'OLD' UFD 00605000
BALR R14,R15 IN CORE (IF ANY) 00606000
TM OPTBYTE,OPTMODE0 IS THIS FOR MODE ZERO R/O ? HRC010DS 00606200
BNO UFD011 NO, CONTINUE HRC010DS 00606400
OI ADTFLG3,ADTFZERO TELL READFST ABOUT IT HRC010DS 00606600
UFD011 EQU * HRC010DS 00606800
CLI XLETTER,C' ' WILL THIS BE A READONLY EXTENSION ? 00607000
BE UFD02 BE IF NOT (EXTENSION-LETTER IS BLANK) 00608000
OI ADTFLG3,ADTFORCE YES - FORCE THE DISK READ-ONLY @V305032 00609100
CLC ADTM,XLETTER IS THIS DISK AN EXTENSION OF ITSELF ? 00610000
BE UFD02 IF YES, LEAVE WELL ENOUGH ALONE. 00611000
MVC ADTMX,XLETTER STORE ADTMX NOW, FOR READFST/READMFD JS 00612000
UFD02 L R15,AREADFST CALL 'READFST' TO ACCESS FROM @V305032 00613000
BALR R14,R15 DESIRED DISK 00614000
BZ UFD02A NO BASIC ERRORS. PROCEED @VA04381 00614100
CH R15,=H'4' WAS IT ERROR 4? @VA04381 00614200
BE TRDONLY YES. DISK WAS READ-ONLY @VA04381 00614300
CH R15,=H'5' WAS IT ERROR 5? @VA04381 00614400
BE NOSTORE YES. NOT ENOUGH FREE STORAGE @VA04381 00614500
STC R15,ERRCODE SAVE WHATEVER ERROR CODE IT IS @VA04381 00614600
B DSKERROR ... AND SEND APPROPRIATE MESSAGE @VA04381 00614700
UFD02A EQU * @VA04381 00614800
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00615100
BO OSDSK YES..DON'T DO ACCESS STUFF @V305032 00615200
TM ADTFLG1,ADTFRO IS IT A READ-ONLY DISK ? 00616000
BZ LOGIN7 IF CLEAR, NO PROBLEM. 00617000
TRDONLY EQU * TYPE 'READ-ONLY' MESSAGE TO INFORM USER.. 00618000
* 00619000
DMSERR MF=(E,ERLIST),NUM=MSG6ID,LET=I,TEXTA=MSG6,DOT=NO 00623000
LOGIN7 MVC ADTMX(1),XLETTER STORE BLANK OR EXTENSION-MODE-LETTER 00624000
MVC SAVEFLG1,ADTFLG1 SAVE FLAG-BYTE FOR LOGGED-IN DISK JS 00625000
LH R4,DTAD(,R9) GET DISK NUMBER, 00626000
SR R1,R1 START WITH FIRST DISK-TABLE, 00627000
LOGIN8 L R15,VCADTNXT LOOK AT AN ACTIVE-DISK-TABLE @VM03093 00628100
BALR R14,R15 ... 00629000
BNZ LOGIN14 GO EXIT (WE'RE ALL DONE) IF NONE ARE LEFT 00630000
CR R1,R11 IS IT 'THIS TABLE' 00631000
BE LOGIN8 BE IF YES (PASS OVER IT) 00632000
DROP R11 00633000
USING ADTSECT,R1 (REFERENCE THE TABLE) 00634000
TM ADTFLG1,ADTFRO+ADTFRW ANYTHING LOGGED IN THERE ? 00635000
BZ LOGIN8 BZ IF NOT (IGNORE IT) 00636000
L R9,ADTDTA POINT TO DEVICE, 00637000
CH R4,DTAD(,R9) DOES OUR DEVICE MATCH OTHER ONE ? 00638000
BNE LOGIN8 BNE IF NOT (FORGET IT) 00639000
LR R3,R1 IF YES, SAVE R1, 00640000
TM SAVEFLG1,ADTFRO IS LOGGED-IN DISK READ-ONLY ? JS 00641000
BO LOGIN10 TRF IF YES, TYPE "ALSO" MESSAGE. JS 00642000
TM ADTFLG1,ADTFFSTV IS OTHER DISK ACTUALLY = S-DISK ? JS 00643000
BO LOGIN10 TRF IF YES (NOT PRACTICAL TO RELEASE IT) 00644000
MVC MSG13DEV(3),MSG6DEV SET UP DEVICE 00645000
MVC MSG13MOD(3),MSG13MOD-1 INITIALIZE DELIM AND EXT 00646000
MVC MSG13MOD(1),ADTM SET MODE 00647000
CLI ADTMX,C' ' ANY EXTENSION-MODE-LETTER ? JS 00648000
BE LOGIN9 TRF IF NOT. JS 00649000
CLC ADTM(1),ADTMX IF YES, IS IT EXTENSION OF ITSELF ? 00650000
BE LOGIN9 TRF IF YES. JS 00651000
MVI MSG13DEL,C'/' SET UP SLASH 00652000
MVC MSG13EXT(1),ADTMX PUT IN EXTENSION MODE 00653000
LOGIN9 EQU * 00654000
LR R9,R1 SAVE BASE OF ADT DSECT 00655000
DMSERR MF=(E,ERLIST),NUM=MSG13ID,LET=I,TEXTA=MSG13,DOT=NO 00656000
LR R1,R9 RESTORE BASE OF ADT 00657000
LR R15,R9 POINT TO ACTIVE DISK TABLE, @VA04015 00657100
BAL R14,FINISDSK AND "FINIS" ANY OPEN CMS FILES @VA04015 00657200
LR R0,R9 SET ADDR OF ADT FOR RELEASE 00658000
L R15,ARELUFD GET ADDR OF RELEASE ROUTINE 00659000
BALR R14,R15 GO AND RELEASE IT 00660000
L R15,ADTDTA GET DEVICE TABLE OFFSET 00661000
XC DTAD(2,R15),DTAD(R15) CLEAR DEVICE ADDRESS @VA04381 00662100
LR R1,R3 RESTORE PREVIOUS ADT POINTER @VA04381 00662200
B LOGIN8 NOW, CONTINUE SEARCH @VA04381 00662300
LOGIN10 EQU * 00664000
MVC MSG8DEV(3),MSG6DEV MOVE IN DEVICE 00665000
MVC MSG8MOD(1),ADTM MOVE IN MODE 00666000
DMSERR MF=(E,ERLIST),NUM=MSG8ID,LET=I,TEXTA=MSG8,DOT=NO 00667000
LR R1,R3 RESTORE FROM LAST ADTNXT 00669000
B LOGIN8 AND KEEP LOOKING (COULD BE MORE OF THEM) 00670000
USING ADTSECT,R11 (RESTORE NORMAL DSECT ADDRESSABILITY) 00671000
* 00672000
LOGIN14 CLI FRSTFLG,00 'FIRST TIME' FOR INIT ? 00673000
BE REST14 TRF IF NOT - FORGET IT. 00674000
TM OPTBYTE,OPTNOPRO NOPROF FLAG ON? HRC010DS 00675490
BO REST14 YES, GO HERE 00676000
L R15,VCFSTLKP NO, CALL FSTLKP @VM03093 00677100
MVC FSTFNAME,=CL8'PROFILE' NAME = 'PROFILE' 00678000
MVC FSTFTYPE,=CL8'EXEC' TYPE = 'EXEC' 00679000
MVC FSTFMODE(1),ADTM PUT IN CORRECT MODE-LETTER 00680000
MVI FSTFMODE+1,C' ' WITH A BLANK AFTERWARDS. 00681000
LA R1,FSTPLIST-8 VERIFY EXISTENCE OF 00682000
BALR R14,R15 'PROFILE EXEC' ON GIVEN DISK 00683000
BNZ NOPROF NO PROFILE, GO HERE 00684000
MVI R1SAVE,X'80' TELL "INIT" THERE IS ONE 00685000
B REST14 CONTINUE 00686000
NOPROF MVI R1SAVE,X'00' TELL "INIT" THERE IS NO PROFILE EXEC 00687000
* 00688000
REST14 KXCHK WRBIT CHECK FOR 'KX' WANTED 00689000
L R13,CURRSAVE POINT TO SYSTEM SAVE AREA 00690000
USING SSAVE,R13 00691000
CLI FRSTFLG,00 IS THIS 'FIRST' CALL TO ACCESS? 00692000
BE *+10 SKIP IF NOT 00693000
MVC EGPR0(8),R0SAVE IF SO, CHANGE INIT'S R0-R1 00694000
LM R13,R15,R13SAVE SET REGS 13-15 00696000
BR R14 RETURN TO CALLER 00697000
SPACE 1 00698100
DSKERROR EQU * 00705000
LA R6,MSG2ID INIT MSG I.D. FOR ATTACH ERROR 00706000
MVC MSG2MODE(6),MSG6A SET UP MODE AND DEVICE ADDR 00707000
MVC MSG2TEXT,MSG2TXT SET UP MSG 2 TEXT @VA07737 00707500
CLI ERRCODE,02 IF ERROR CODE '2', DEVICE NOT ATT. 00708000
BE MSGFIN SO MSG IS OK AS IS 00709000
CLI ERRCODE,01 DEVICE ERROR CODE ? @V201101 00710100
BE DEVERROR YES..SET UP DEVICE ERROR MSG @V201101 00710200
CLI ERRCODE,03 UNKNOWN ERROR CODE ? @V201101 00710300
BNE CLRUFD NO..MUST BE O/S CODE..MSG TYPED @V201101 00710400
DEVERROR EQU * @VA07737 00710500
MVC MSG2TEXT,MSG1TXT SET UP DEVICE ERROR @VA07737 00710600
LA R6,MSG1ID SET TO INDICATE DEVICE ERROR MSG 00711000
MSGFIN EQU * 00712000
MVI ERRCODE,MSG2RC SET RETURN CODE 00713000
DMSERR MF=(E,ERLIST),NUM=(R6),LET=S,TEXTA=MSG2,DOT=NO @V305032 00714000
CLRUFD EQU * 00715000
LR R15,R11 POINT TO ACTIVE DISK TABLE, @VA04015 00715100
BAL R14,FINISDSK AND "FINIS" ANY OPEN CMS FILES @VA04015 00715200
CLRADT EQU * @VA04381 00716000
LR R0,R11 PLACE POINTER TO ADT IN R0, @VA04381 00716500
L R15,ARELUFD AND CALL 'RELUFD' TO CLEAR 00717000
BALR R14,R15 EVERYTHING IN SIGHT 00718000
L R15,ADTDTA GET DEVICE TABLE OFFSET 00719000
SR R14,R14 CLEAR ... @V305032 00720100
STH R14,DTAD(,R15) DEVICE-TABLE-ADDRESS @V305032 00720600
B REST14 GO EXIT (ERROR-CODE SET UP PREVIOUSLY) 00721000
* 00722000
ERROR8 EQU * 00723000
MVC MSG10QT1(22),MSG10QT1-1 BLANK OUT MSG 00724000
TM OPTBYTE,OPTNAMEF CHECK IF FILES SPECIFIED HRC010DS 00725490
BNO MODESET IF NOT, LEAVE BLANK 00726000
MVI MSG10QT1,C'''' SET OPENING QUOTE 00727000
MVC MSG10NME(8),FSTFNAME SET FILE NAME SPECIFIED 00728000
MVI MSG10QT2,C'''' SET CLOSING QUOTE 00729000
CLI FSTFTYPE,X'FF' CHECK IF FILE TYPE SPECIFIED 00730000
BE MODESET IF NOT,LEAVE IT BLANK 00731000
MVC MSG10TYP(8),FSTFTYPE MOVE IN FILE TYPE 00732000
CLI FSTFMODE,X'FF' CHECK IF MODE SPECIFIED 00733000
BE MODESET IF NOT, LEAVE BLANK 00734000
MVC MSG10MOD(2),FSTFMODE MOVE IN MODE 00735000
MODESET EQU * 00736000
MVC MSG10MD2(6),MSG6A MOVE IN MODE AND DEVICE ADDR 00737000
DMSERR MF=(E,ERLIST),NUM=MSG10ID,LET=E,TEXTA=MSG10,DOT=NO 00738000
MVI ERRCODE,MSG10RC SET RETURN CODE TO CALLER 00739000
B CLRUFD GO TO CLEAR UFD 00740000
* 00741000
NOSTORE DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED', *00741100
LET=S,NUM=109 00741200
MVI ERRCODE,104 SET THE PROPER RETURN CODE @VA04381 00741300
B CLRADT REMOVE RESIDUAL FLAGS @VA04381 00741400
SPACE 1 00741500
* SUBROUTINE TO CONVERT TO PRINTABLE HEX: 00742000
TRHEXIT UNPK SCRATCH(5),DTAD(3,R9) 00743000
TR SCRATCH(4),HEXTBL-C'0' 00744000
MVC 0(3,R15),SCRATCH+1 FINISHED XXX TO CALLER'S BUFFER 00745000
BR R14 AND EXIT. 00746000
EJECT 00747000
*********************************************************************** 00748000
* 00749000
* 'ACCESS ERASE' DOES THE FOLLOWING: 00750000
* 00751000
* CALLS 'RELUFD' TO CLEAR ALL IN-CORE TABLES FOR GIVEN DISK 00752000
* BRINGS IN 'USER FILE DIRECTORY' USING 'READMFD' 00753000
* CLEARS 'PSTAT' 00754000
* CLEARS 'PQQMSK' 00755000
* CLEARS 'PQMSK' (EXCEPT FOR FIRST 4 BITS) 00756000
* INITIALIZES VARIOUS DISK-COUNTS (NUMTRKS, ETC.) 00757000
* NOTE - USER-FILE-DIRECTORY (UFD) IN CORE IS "CLEAN" 00758000
* BUT THE UFD ON DISK IS PURPOSELY NOT UPDATED, 00759000
* SO A USER CAN RECOVER BY ANOTHER 'ACCESS' IF 00760000
* HE ACCIDENTALLY SPECIFIES 'ERASE' 00761000
* (TO GIVE HIM A CHANCE TO RECOVER FROM HIS OWN ERROR) 00762000
* 00763000
*********************************************************************** 00764000
SPACE 00765000
NOUFD DS 0H ACCESS 'ERASE' FROM GIVEN DISK @V305032 00766000
TRHEX MSG6DEV GET DEVICE ADDR READY FOR @VA03005 00766100
* PRINTING 00766200
LR R15,R11 POINT TO ACTIVE DISK TABLE, @VA04015 00766300
BAL R14,FINISDSK AND "FINIS" ANY OPEN CMS FILES @VA04015 00766400
LR R0,R11 R0 MUST POINT TO ACTIVE-DISK-TABLE, 00767000
L R15,ARELUFD CALL 'RELUFD' TO 00768000
BALR R14,R15 CLEAR OLD TABLES ETC. 00769000
L R15,AREADMFD CALL 'READMFD' TO ACCESS FROM @V305032 00770000
BALR R14,R15 DISK (BUT WITHOUT FST TABLES) 00771000
STC R15,ERRCODE SAVE RETURN-CODE FROM READMFD 00772000
BZ NOUFD0 BZ IF NO ERRORS (ALL OK) 00773000
L R15,ARELUFD GET ADDR OF RELEASE ROUTINE P3034 00775000
BALR R14,R15 REL. USER FILE DIRECTORY P3034 00776000
LR R1,R11 GET ADDR OF ACTIVE DISK TABLE P3034 00777000
L R15,ADTDTA GET ADDR OF DEVICE TABLE P3034 00778000
XC DTAD(2,R15),DTAD(R15) CLEAR DEVICE ADDRESS @VA04381 00779100
CLI ERRCODE,5 WAS IT ERROR 5? @VA04381 00779200
BE NOSTORE YES. NOT ENOUGH FREE STORAGE @VA04381 00779300
CLI ERRCODE,04 ERROR 4 (R/O), OR REAL DISK ERROR ? 00780000
BNE DSKERROR REAL DISK-ERR SAME AS REG ACCESS @V305032 00781000
DMSERR MF=(E,ERLIST),NUM=MSG6ID,LET=I,TEXTA=MSG6,DOT=NO 00782000
LA R7,OPTNME SET ITEM NAME PTR 00783000
LA R8,ERASE SET ITEM PTR 00784000
LA R6,OPTID SET MSG I. D. PTR 00785000
B ERROR6 WRITE OUT MSG AND TERMINATE 00786000
* 00787000
* IF SUCCESSFUL RETURN FROM 'READMFD' (R15 = 0) ... 00788000
NOUFD0 TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00789100
BO OSDSK YES..SKIP NO-UFD STUFF @V201101 00789200
LA R14,1 SET FST HYPERBLOCK COUNT @V201101 00789300
ST R14,ADTHBCT TO 1, 00790000
A R14,ADTPQM2 ADD 'PQMNUM', 00791000
A R14,ADTPQM2 ADD ADTPQM2 AGAIN FOR WORST POSS. CASE 00792000
LA R14,1(,R14) ADD 1 FOR POSSIBLE ADDED HYPERBLOCK 00793000
STH R14,ADTRES STORE RESERVE-COUNT. 00794000
OI ADTFLG2,ADTFALUF FLAG 'ALL UFD IN CORE' (THOUGH NULL) 00795000
C R15,ADTFDA DO WE HAVE A 1ST FST HYPERBLOCK ? 00796000
BNE NOUFD1 BNE IF ADTFDA NONZERO (WE HAVE ONE) 00797000
* GET FIRST FST HYPERBLOCK FROM FREE STORAGE 00798000
LA R0,102 INDICATE SIZE OF BLOCK NEEDED @VA04381 00799100
DMSFREE DWORDS=(0),TYPE=NUCLEUS,ERR=NOSTORE, @VA04381*00799200
TYPCALL=BALR @VA04381 00799300
LA R14,40 40 = 'WIDTH', 00800000
LA R15,800 800 = 'LENGTH', 00801000
STM R14,R15,0(R1) STORE FIRST TWO WORDS, 00802000
ST R1,ADTFDA STORE THE ADDRESS 00803000
OI ADTFLG1,ADTFFSTF AND SET FREE STORAGE FLAG-BIT 00804000
* CONTINUE (NOTE - WILL CLEAR FIRST 800 BYTES SHORTLY) ... 00805000
* 00806000
NOUFD1 LM R0,R1,ADTMFDN GET 'OLD' MFD IN CORE, 00807000
LTR R1,R1 (IF ANY) 00808000
BZ NOUFD3 BZ IF NOTHING THERE 00809000
* RETURN IT IF IT WAS THERE 00810000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00811100
XC ADTMFDN(8),ADTMFDN CLEAR THE TWO WORDS THERE 00812000
NOUFD3 L R4,ADTFDA ACCESS 'PSTAT' OR EQUIVALENT, 00813000
LTR R4,R4 IS THERE ANY AT ALL ? 00814000
BNP NOUFD5 BNP IF NOT. 00815000
LA R4,8(,R4) SKIP OVER PRELIMINARY WORDS 00816000
TM ADTFLG1,ADTFMIN MINIMUM-SIZE ACTIVE-DISK-TABLE ? 00817000
BO NOUFD4 BO IF YES (DON'T STORE INFO NOT THERE) 00818000
ST R4,ADTLHBA STORE ADDRESS OF 'LAST' FST HYPERBLOCK 00819000
NOUFD4 XC 0(208,R4),0(R4) CLEAR FIRST 208 BYTES (AFTER POINTERS) 00820000
MVC 208(200,R4),0(R4) NEXT 200 BYTES ... 00821000
MVC 408(200,R4),0(R4) ... 00822000
MVC 608(200,R4),0(R4) LAST 200 BYTES. 00823000
NOUFD5 TM ADTFLG1,ADTFMIN IS THIS A MINIMUM-SIZE ACTIVE-DISK-TBL 00824000
BO UPCNTS BO IF YES, DON'T ACCESS INFO NOT THERE. 00825000
LM R5,R6,ADTMSK A(PQMSK) TO R5, A(PQQMSK) TO R6, 00826000
LTR R6,R6 IS PQQMSK THERE ? 00827000
BNP LTR45 BNP IF NOT. 00828000
XC 0(200,R6),0(R6) CLEAR IT. 00829000
LTR45 LTR R4,R5 IF PQMSK NOT PRESENT, DON'T TRY 00830000
BNP UPCNTS TO CLEAR IT. 00831000
L R6,ADTPQM3 NO. DBL-WORDS IN PQMSK INTO R6, 00832000
LTR R6,R6 THIS SHOULD BE PLUS 00833000
BNP UPCNTS VERY STRANGE IF IT ISN'T... 00834000
LA R7,8 R7 = 8, 00835000
SR R14,R14 CLEAR R14 & R15 00836000
SR R15,R15 ... 00837000
LA R8,CLRLP (FOR 'BCTR' BELOW) 00838000
CLRLP STM R14,R15,0(R5) CLEAR A DBL-WORD IN PQMSK, 00839000
AR R5,R7 BUMP BY 8, 00840000
BCTR R6,R8 AND ITERATE LOOP UNTIL PQMSK ALL CLEAR 00841000
MVI 0(R4),X'F0' FINALLY, SET FIRST 4 BITS BACK TO X'F0' 00842000
UPCNTS LM R5,R8,ADTNUM GET NUMTRKS COUNTERS, 00843000
LA R6,4 FOUR TRACKS IN USE 00844000
LR R7,R5 COMPUTE 00845000
SR R7,R6 THE NUMBER LEFT 00846000
SR R8,R8 'LASTRK' = 0. 00847000
STM R6,R8,ADTUSED STORE NEW COUNTS (NUMTRKS UNCHANGED) 00848000
ST R8,ADT1ST ALSO CLEAR 'ADT1ST' COUNT 00849000
* 00850000
* DO NOT UPDATE UFD ON DISK. IF IT WERE TO BE DONE, 00851000
* HOWEVER, THE CODE WOULD BE AS FOLLOWS: 00852000
*** LR R0,R11 R0 MUST POINT TO ACTIVE-DISK-TABLE 00853000
*** LR R1,R0 R1 MUST = PLUS SOMETHING 00854000
*** L R15,AUPDISK UPDATE UFD 00855000
*** BALR R14,R15 ON DISK. 00856000
* 00857000
B LOGIN7 SEE IF DISK ACCESSED AS ANOTHER @VA03005 00858050
* 00858100
OSDSK TM OPTBYTE,OPTNAMEF+OPTMODE0+OPTERASE+OPTNOPRO ? HRC010DS 00858240
BZ REST14 NO..JUST RETURN @V201101 00858300
DMSERR TEXT='O/S DISK - FILEID/OPTIONS ARE IGNORED', *00858450
LET=W,NUM=230 HRC010DS 00858500
MVI ERRCODE,4 SET WARNING RETURN CODE @V201101 00858600
B REST14 RETURN @V201101 00858700
EJECT 00859000
* FINISDSK = SUBROUTINE TO "FINIS" ANY OPEN CMS FILES ON A DISK 00859100
* ENTRY CONDITIONS: 00859150
* R14 = RETURN REGISTER 00859200
* R15 = ADDRESS OF ACTIVE DISK TABLE. 00859250
* EXIT CONDITIONS: 00859300
* ANY CMS FILES ON SPECIFIED DISK HAVE BEEN CLOSED. 00859350
* R1 THRU R14 PRESERVED; 00859400
* R0 AND R15 NOT PRESERVED. 00859450
SPACE 00859500
USING ADTSECT,R15 R15 MUST REFERENCE CORRECT ADT @VA04015 00859550
FINISDSK TM ADTFLG1,ADTFRO+ADTFRW SOME CMS DISK ACCESSED ? @VA04015 00859600
BZR R14 NO - RETURN FORTHWITH. @VA04015 00859650
* YES - CLOSE ANY CMS FILES WHICH MIGHT BE ACTIVE ON THIS DISK: 00859700
ST R14,FINISR14 PRESERVE RETURN REGISTER @VA04015 00859750
LR R0,R1 AND PRESERVE R1 IN R0; @VA04015 00859800
IC R1,ADTM PICK UP MODE LETTER, @VA04015 00859850
STC R1,THISDISK STORE IN 'FINISALL' P-LIST @VA04015 00859900
LA R1,FINISALL POINT TO 'FINIS * * X' PLIST @VA04015 00859950
DROP R15 THEN ... @VA04015 00860000
L R15,AFINIS CLOSE ALL/ANY OPEN CMS FILES @VA04015 00860050
BALR R14,R15 ... @VA04015 00860100
LR R1,R0 RECOVER R1 @VA04015 00860150
L R14,FINISR14 AND RETURN REGISTER @VA04015 00860200
BR R14 THEN RETURN TO CALLER. @VA04015 00860250
FINISR14 DC F'0' R14 SAVED HERE. @VA04015 00860300
SPACE 00860350
**************************************************************** 00861000
* 00862000
* FCODE HANDLES THE FIRST COMMAND AFTER A USER HAS IPL'ED 00863000
* BEFORE ACCESSING 191 A, IT EXAMINES THE FIRST COMMAND 00864000
* IF THE COMMAND IS 'FORMAT' IT DOES THIS FIRST, 00865000
* IF THE COMMAND IS 'ACCESS', IT USES THE OPTIONS SPECIFIED 00866000
* IF THERE IS NO COMMAND, OR IT IS ANOTHER COMMAND, 00867000
* 191 A IS ACCESSED, AND CONTROL RETURNED TO INIT TO 00868000
* EITHER ISSUE A READ TO THE TERMINAL (NULL LINE), 00869000
* OR EXECUTE THE FIRST COMMAND SPECIFIED 00870000
* 00871000
**************************************************************** 00872000
SPACE 00873000
FCODE MVI FRSTFLG,X'FF' SET 'FIRST-TIME' FLAG 00874000
LA R15,UFD SET R15 TO TRF TO CODE AT 'UFD'. 00875000
XC R0SAVE(8),R0SAVE TENTATIVELY CLEAR R0-R1 TO RETURN 00876000
LTR R3,R0 ORIG. PLIST (IF ANY) INTO R3 00877000
BCR 8,R15 'BZ UFD' IF NOTHING - JUST ACCESS@V305032 00878000
CLI 0(R3),X'FF' BLANK LINE FOR FIRST COMMAND ? 00879000
BCR 8,R15 'BE UFD' IF YES - GO ACCESS. @V305032 00880000
CLI 0(R3),C'*' OR AN ASTERISK ? 00881000
BCR 8,R15 'BE UFD' (SAME TREATMENT) IF YES. 00882000
SR R5,R5 ZAP REG TO ACCUM COUNT 00883000
LA R4,8 GET FULL LENGTH OF POS. COMMAND 00884000
COMLOOP EQU * 00885000
CLI 0(R3),C' ' CHECK FOR A BLANK 00886000
BE COMEND GOT THE LENGTH OF COMMAND ENTERED 00887000
LA R3,1(,R3) BUMP TO NEXT CHAR. 00888000
LA R5,1(,R5) ACCOUNT FOR NON-BLANK 00889000
BCT R4,COMLOOP CHECK UP TO 8 CHAR. 00890000
COMEND EQU * 00891000
LR R3,R0 RESTORE COMMAND LINE PTR 00892000
LTR R5,R5 WAS ANYTHING ENTERED 00893000
BZ SAVECOM IF FIRST CHAR. BLANK, FORGET IT 00894000
LA R4,2 GET MINIMUM ABREV, LTH. FOR ACCESS 00895000
CR R4,R5 CHECK FOR LESS THAN MIN. ABREV. 00896000
BH SAVECOM DON'T EVEN CHECK IF LESS 00897000
BCTR R5,0 REDUCE LENGTH FOR COMPARE 00898000
EX R5,CKCOM CHECK FOR THE FULL LENGTH 00899000
BE TRYNOD IF THE SAME, SEE IF NODISK OPTION 00900000
SAVECOM EQU * 00901000
ST R3,R0SAVE SAVE FIRST COMMAND FOR 00902000
ST R3,R1SAVE RETURN TO INIT 00903000
BR R15 ...GO ACCESS @V305032 00904000
TRYNOD EQU * 00905000
CLI 8(R3),C'(' IS OPTION ONLY SPECIFIED 00906000
BNE LOGREG NO, THEN IT CAN'T BE NODISK 00907000
CLC NODISK,16(R3) MAYBE 'ACCESS NODISK' ? @V305032 00908000
BNE LOGREG NOPE - JUST A REGULAR ACCESS. @V305032 00909000
CLI 24(R3),X'FF' IS THERE ANYTHING ELSE 00910000
BE NOEXCESS IF FENCE, IT'S END OF LINE 00911000
CLI 24(R3),C')' ALSO IF IT'S A RIGHT PAREN 00912000
BE NOEXCESS IT'S OK 00913000
LA R8,24(R3) OTHERWISE, GET ADDR OF ITEM 00914000
LA R10,ERROR6 SET ADDR OF ERROR ROUTINE 00915000
B ITEMSET PUT OUT ERROR MSG 00916000
NOEXCESS EQU * 00917000
OI MISFLAGS,X'04' SO D DISK WON'T BE ACCESSED V0743 00917100
B REST14 EXIT FORTHWITH IF 'NODISK'. @V305032 00918000
CKCOM CLC 0(1,R3),0(R1) EXECUTED TO CHECK 1ST COMMAND FOR ACCESS 00919000
EJECT 00920000
********************************************************************* 00921000
* 00922000
* CONSTANT SECTION 00923000
* 00924000
********************************************************************* 00925000
DEFLTDEV EQU X'191' DEFAULT DEVICE TYPE WHEN NOT SPECIFIED 00926000
* HALF-WORD CONSTANTS 00927000
CA DC H'183' CHARACTER 'A' (193) TO X'A' (10) 00928000
EIGHT DC H'8' @V305032 00928100
* 00929000
AREADFST DC A(READFST) INCLUDE WITH 'ACCESS' MODULE 00930000
AREADMFD DC A(READMFD) 00931000
ARELUFD DC A(RELUFD) END LIST 00932000
FENCE DC 8X'FF' FENCE 00933000
PONLY DC X'00' OPTIONS ONLY SWITCH 00934000
* 00935000
HEXTBL DC C'0123456789ABCDEF' FOR BINARY-HEX CONVERSION 00936000
NODISK DC CL8'NODISK' OPTION FOR COMMAND LINE 00937000
NOPROFIL DC CL8'NOPROF' NOPROFILE OPTION OF COMMAND LINE 00938000
ERASE DC CL8'ERASE' ERASE OPTION OF THE COMMAND LINE 00939000
MODE0 DC CL8'MODE0' MODE0 OPTION OF THE COMMAND LINE HRC010DS 00939500
* 00940000
MAXPOSS DS 0F HIGHEST ALLOWABLE DEVICE ADDR 00941000
DC XL4'FFF' MAXIMUM VIRTUAL DEVICE ADDRESS @VA04296 00942000
* 00943000
MSG1TXT DC CL12'DEVICE ERROR' TEXT TO MODIFY MSG2 TO MSG1 00944000
* 00945000
MSG2TXT DC CL12'NOT ATTACHED' MESSAGE 2 TEXT @VA07737 00945500
* 00946000
* 00947000
MSG2 DC AL1(MSG2L-1) LENGTH OF MSG 00948000
DC CL1'''' 00949000
MSG2MODE DC CL1' ' MODE 00950000
DC CL2' (' 00951000
MSG2DEV DC CL3' ' 00952000
DC CL4') '' ' 00953000
MSG2TEXT DC CL12' ' SPACE FOR MSG 1 OR 2 TEXT @VA07737 00954000
MSG2END DS 0CL1 00955000
MSG2L EQU (MSG2END-MSG2) LENGTH OF MSG 00956000
MSG2ID EQU 113 MSG I. D. NO. 00957000
MSG2RC EQU 100 COMMON RETURN CODE FOR MSGS. 00958000
MSG1ID EQU 112 MSG I. D. FOR DEVICE ERROR 00959000
* 00960000
MSG3 DC AL1(MSG3L-1) LENGTH OF MSG 00961000
DC CL8'INVALID' 00962000
MSG3NME DC CL9'OPTION' VARIABLE ELEMENT NAME IN MSG 00963000
MSG3BLD DC CL1' ' BLANK DELIMITER USED TO INIT NEXT FLD. 00964000
MSG3CMP DC CL7' ' ADDITIONAL FIELD FOR DEVICE MSG. 00965000
DC CL3' '' ' 00966000
MSG3ITEM DC CL8' ' ITEM IN P-LIST 00967000
DC CL1'''' 00968000
MSG3END DS 0CL1 00969000
MSG3L EQU (MSG3END-MSG3) LENGTH OF MSG 3 00970000
MSG3ID EQU 3 STD. I. D. CODE (FOR 'OPTION') 00971000
MSG3RC EQU 24 RETURN CODE FOR ERROR 00972000
* INSERTS FOR ABOVE MSG 00973000
DEVNME DC CL9'DEVICE' INSERTS FOR ERROR MSG 00974000
MODENME DC CL9'MODE' IBID 00975000
PARMNME DC CL9'PARAMETER' AGAIN 00976000
OPTNME DC CL9'OPTION' LAST ONE 00977000
OPTID EQU 3 MSGID FOR INVALID OPTION 00978000
DEVID EQU 17 MSGID FOR INVALID DEVICE ADDR 00979000
MODEID EQU 48 MSGID FOR INVALID MODE 00980000
PARMID EQU 70 MSG ID FOR INVALID PARAMETER 00981000
* 00982000
MSG6 DC AL1(MSG6L-1) LENGTH BYTE 00983000
MSG6A DS 0CL6 REF. PT. FOR FULL MODE AND DEV. ADDR 00984000
MSG6MOD DC CL1' ' MODE 00985000
DC CL2' (' 00986000
MSG6DEV DC CL3' ' 00987000
DC CL5') R/O' 00988000
MSG6END DS 0CL1 00989000
MSG6L EQU (MSG6END-MSG6) LENGTH OF MSG 00990000
MSG6ID EQU 723 MSG I. D. NO. 00991000
* 00992000
MSG7 DC AL1(MSG7L-1) LENGTH BYTE 00993000
DC CL1'''' 00994000
MSG7RPER DC CL3' ' REPLACING DEVICE 00995000
DC CL13''' REPLACES '' ' 00996000
MSG7MODE DC CL1' ' MODE REPLACED 00997000
DC CL2' (' 00998000
MSG7RPEE DC CL3' ' DEVICE REPLACED 00999000
DC CL3') ''' 01000000
MSG7END DS 0CL1 01001000
MSG7L EQU (MSG7END-MSG7) LENGTH OF MSG 01002000
MSG7ID EQU 724 MSG I. D. NO. 01003000
MSG7OS DC C'- ???' APPEND FOR OS/DOS DISK @V305101 01003110
OSL DC CL3'OS' O/S DISK LITERAL @V305101 01003120
DOSL DC CL3'DOS' DOS DISK LITERAL @V305101 01003130
* 01004000
MSG8 DC AL1(MSG8L-1) LENGTH BYTE 01005000
MSG8DEV DC CL3' ' DEVICE ADDR 01006000
DC CL8' ALSO = ' 01007000
MSG8MOD DC CL1' ' 01008000
DC CL5'-DISK' 01009000
MSG8END DS 0CL1 01010000
MSG8L EQU (MSG8END-MSG8) LENGTH OF MSG 01011000
MSG8ID EQU 725 MSG I. D. 01012000
* 01013000
MSG9 DC AL1(MSG9L-1) LENGTH BYTE 01014000
DC CL1'''' 01015000
MSG9DEV DC CL3' ' DEVICE ADDR 01016000
DC CL35''' ALREADY ACCESSED AS READ/WRITE ''' 01017000
MSG9MODE DC CL1' ' MODE 01018000
DC CL6''' DISK' 01019000
MSG9END DS 0CL1 01020000
MSG9L EQU (MSG9END-MSG9) LENGTH OF MSG 01021000
MSG9ID EQU 59 MSG I. D. NO. 01022000
MSG9RC EQU 36 RETURN CODE FOR ERROR 01023000
* 01024000
MSG10 DC AL1(MSG10L-1) LENGTH BYTE 01025000
DC CL5'FILE ' 01026000
MSG10QT1 DC CL1' ' OPENING QUOTE 01027000
MSG10NME DC CL8' ' FILE NAME 01028000
DC CL1' ' 01029000
MSG10TYP DC CL8' ' FILE TYPE 01030000
DC CL1' ' 01031000
MSG10MOD DC CL2' ' FILE MODE 01032000
MSG10QT2 DC CL1' ' CLOSING QUOTE 01033000
DC CL19' NOT FOUND. DISK '' ' 01034000
MSG10MD2 DC CL1' ' DISK MODE 01035000
DC CL2' (' 01036000
MSG10DEV DC CL3' ' DEVICE ADDR 01037000
DC CL24') '' WILL NOT BE ACCESSED' 01038000
MSG10EN DS 0CL1 01039000
MSG10L EQU (MSG10EN-MSG10) LENGTH OF MSG 01040000
MSG10ID EQU 60 MSG I. D. NO. 01041000
MSG10RC EQU 28 RETURN CODE FOR ERROR 01042000
* 01043000
MSG13 DC AL1(MSG13L-1) LENGTH BYTE 01044000
DC CL1'''' 01045000
MSG13DEV DC CL3' ' DEVICE ADDR RELEASED 01046000
DC CL1' ' 01047000
MSG13MOD DC CL1' ' MODE 01048000
MSG13DEL DC CL1' ' DELIMITER FOR EXTENSION IF ANY 01049000
MSG13EXT DC CL1' ' EXTENSION MODE 01050000
DC CL10''' RELEASED' 01051000
MSG13EN DS 0CL1 01052000
MSG13L EQU (MSG13EN-MSG13) LENGTH OF MSG 01053000
MSG13ID EQU 726 MSG I. D. NO. 01054000
* 01055000
ERLIST DMSERR MF=L 01056000
* 01057000
DS 0F @VA01696 01057100
FINISALL DC CL8'FINIS' CLOSE ALL... @VA01696 01057200
DC CL8'*' FILENAMES, @VA01696 01057300
DC CL8'*' FILETYPES, @VA01696 01057400
THISDISK DC CL2'X ' ON "THIS" DISK. @VA01696 01057500
* 01057600
LTORG OTHER CONSTANTS... @VA01696 01057700
EJECT 01058000
* WORKING STORAGE (USING FREE STORAGE PROVIDED BY INTSVC IN R13) 01059000
* 01060000
WORKING DSECT IN R12 AS WE USE IT. 01061000
* 01062000
R13SAVE DC F'0' (R13)-96 POINTS TO CALLER'S REGS. 01063000
R14SAVE DC F'0' CALLER'S R14 01064000
R15SAVE DC F'0' RETURN-CODE 01065000
R0SAVE DC F'0' REG. FOR RETURN TO INIT 01066000
R1SAVE DC F'0' REG. FOR RETURN TO INIT 01067000
* 01068000
ERRCODE EQU R15SAVE+3 RETURN-CODE AS A BYTE 01069000
* 01070000
REPREG DC 2F'0' "REPLACE" INDICATORS 01071000
SPACE , HRC010DS 01072490
OPTBYTE DC X'00' OPTIONS FLAG BYTE 01073000
OPTNORMR EQU X'80' NORMAL RETURN HRC010DS 01073100
OPTMODE0 EQU X'08' MODE0 FILES ON R/O HRC010DS 01073200
OPTNAMEF EQU X'04' FILES SPECIFIED HRC010DS 01073300
OPTERASE EQU X'02' ERASE REQUESTED HRC010DS 01073400
OPTNOPRO EQU X'01' NOPROFILE REQUESTED HRC010DS 01073500
SPACE , HRC010DS 01073600
FRSTFLG DC X'00' FIRST-TIME-FLAG (NONZERO = "FIRST TIME") 01074000
* 01075000
XLETTER DC C' ' BLANK OR EXTENSION-MODE-LETTER 01076000
* 01077000
SAVEFLG1 DC X'00' ADTFLG1 FOR LOGGED-IN DISK SAVE HERE 01078000
* 01079000
FSTPLIST DS 0F P-LIST FOR PASSING TO READFST OR FSTLKP: 01080000
FSTFNAME DC CL8' ' NAME (IF ANY) 01081000
FSTFTYPE DC CL8' ' TYPE (IF ANY) 01082000
FSTFMODE DC CL2' ' MODE (IF ANY) 01083000
* 01084000
SCRATCH DS 6C SCRATCH-BYTES FOR BINARY-HEX TRANSLATION 01085000
* 01086000
* ROOM FOR A COUPLE OF MESSAGES HERE: 01087000
* 01088000
* 01089000
DS 0C NOTE: WHERE WE ARE NOW MUST NOT EXEEED 'FRLIMIT': 01090000
FRLIMIT EQU 96 LIMIT = 12 DBL-WRDS = 24 FULL WORDS = 96 BYTES 01091000
EJECT 01092000
NUCON 01093000
FVS 01094000
* 01095000
EJECT 01096000
ADT 01097000
CMSAVE 01098000
REGEQU 01099000
* 01100000
BASE EQU R2 01101000
* 01102000
END 01103000