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 * > 00032000 * 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