ibm:vm370-lib:cms:dmsacc.assemble_src
Table of Contents
DMSACC Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC010DS]
Source Listing
- DMSACC.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsacc.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator