ARE TITLE 'DMSARE (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * MODULE NAME: 00005000 * 00006000 * DMSARE (RELEASE) 00007000 * 00008000 * FUNCTION: 00009000 * 00010000 * TO RELEASE ALL RESIDENT TABLES PERTAINING TO A GIVEN 00011000 * DISK AND ASSOCIATE DIRECTORIES WHEN IT IS NO LONGER 00012000 * NEEDED. 00013000 * 00014000 * ATTRIBUTES: 00015000 * 00016000 * TRANSIENT; SERIALLY REUSABLE. 00017000 * 00018000 * ENTRY POINTS 00019000 * 00020000 * DMSARE 00021000 * 00022000 * ENTRY CONDITIONS: 00023000 * 00024000 * LA R1,PLIST 00025000 * SVC X'CA' 00026000 * DC AL4(ERROR) 00027000 * 00028000 * 00029000 * R1 MUST POINT TO THE PARAMETER LIST AS USUAL: 00030000 * 00031000 * DS 0F 00032000 * 00033000 * PLIST DC CL8'RELEASE' 00034000 * DC CL8'CCU'|'MODE' DISK ADDRESS, OR DISK MODE 00035000 * DC CL8'(' OPTION LIST DELIMETER 00036000 * DC CL8'DET' DETACH OPTION 00037000 * DC 8X'FF' ENDING FENCE 00038000 * 00039000 * EXIT CONDITIONS: 00040000 * 00041000 * NORMAL RETURN - 00042000 * 00043000 * R15 = 0 00044000 * 00045000 * ERROR RETURNS - 00046000 * 00047000 * R15 = 24: SYNTAX ERROR 00048000 * INVALID RELEASE PARAMETER LIST (DISK ADDRESS NOT 00049000 * HEX NUMBER UP TO FFF, DISK MODE NOT LETTER FROM A 00050000 * TO G,Y, OR Z, SPECIFIED OPTION IS NOT 'DET' OR 00051000 * EXCESS PARAMETER(S) ENCOUNTERED). 00052000 * 00053000 * R15 = 36: NOT ACCESSED 00054000 * THE PLIST SPECIFICATION DOES NOT CORRESPOND TO ANY 00055000 * DEVICE CURRENTLY ACCESSED. 00056000 * 00057000 * CALLS TO OTHER ROUTINES: 00058000 * 00059000 * DMSALU, DMSLAD, DMSERR 00060000 * 00061000 * EXTERNAL REFERENCES: 00062000 * 00063000 * ADT 00064000 * 00065000 * TABLES/WORK AREAS: 00066000 * 00067000 * NONE 00068000 * 00069000 * 00070000 * REGISTER USAGE 00071000 * 00072000 * R12 BASE 00073000 * REST WORK 00074000 * 00075000 * OPERATION: 00076000 * 00077000 * THE PARAMETER LIST IS CHECKED FOR ERRORS. THE 00078000 * DISK-ADDRESS MUST BE A HEX NUMBER (DIGITS 0-9, A-F, 00079000 * WITH A VALUE NO MORE THAN X'FFF'. NOTE: X'000' IS NOT 00080000 * VALID). THE DISK MODE MUST BE ALPHABETIC. IT IS NOT 00081000 * LEGAL TO RELEASE THE S-DISK. 00082000 * DMSLAD IS CALLED TO FIND THE ACTIVE DISK TABLE (ADT) 00083000 * BLOCK. IF THE BLOCK WAS FOUND AND A MODE LETTER HAD 00084000 * BEEN SPECIFIED, DMSALU IS CALLED FOR THIS 00085000 * DISK, AND THE ADTFRO AND ADTFRW READ-ONLY AND 00086000 * READ-WRITE FLAG BITS IN THE ADTFLG1 FLAG BYTE IN THE 00087000 * ADT BLOCK ARE ALSO CLEARED, TO SIGNAL THAT NO DISK IS 00088000 * REFERENCED BY THE ADT BLOCK. IF THE 'DET' OPTION 00089000 * WAS SPECIFIED THE DISK ADDRESS IS OBTAINED AND ALL 00090000 * ACCESSES TO THAT ADDRESS ARE RELEASED IN THE SAME 00091000 * FASHION AS IF THE CCU FORM HAD BEEN SPECIFIED. 00092000 * CONTROL RETURNS TO THE CALLER. 00093000 * 00094000 * OTHERWISE, IF A DEVICE ADDRESS IS SPECIFIED, DMSLAD 00095000 * IS CALLED FOR THE FIRST ADT BLOCK AND A CHECK IS MADE 00096000 * FOR THE SUPPLIED DEVICE ADDRESS. IF THERE IS NOT A 00097000 * MATCH, THE NEXT ADT BLOCK IS CHECKED, UNTIL ALL ADT 00098000 * BLOCKS HAVE BEEN CHECKED. PROCESSING FOR A DEVICE 00099000 * ADDRESS PROCEEDS AS WITH THE MODE SPECIFICATION - BUT 00100000 * CONTROL IS NOT RETURNED TO THE CALL ER UNTIL ALL ADT 00101000 * INSTANCES OF DEVICE ADDRESS HAVE BEEN VERIFIED AND 00102000 * RELEASED IF APPROPRIATE. 00103000 * 00104000 * IN EITHER CASE, IF THE PLIST SPECIFICATION IS NOT 00105000 * VERIFIED THE USER RECEIVES AN ERROR INDICATION. 00106000 * AFTER RELEASE PROCESSING IS COMPLETE, IF THE DETACH 00107000 * ('DET') OPTION WAS SPECIFED, A DIAGNOSE REQUEST IS 00108000 * PASSED TO CP TO DETACH THE DISK. 00109000 * RELEASE IS TREATED AS A COMMAND OR A FUNCTION ACCORDING TO THE 00110000 * HIGH-ORDER BYTE OF REGISTER 1 AT INPUT. IF THE BYTE IS LESS 00111000 * THAN X'0C' OR GREATER THAN X'0E', IT IS ASSUMED TO BE A 00112000 * FUNCTION, I.E., CALLED BY ANOTHER PROGRAM, AND NO ERROR 00113000 * MESSAGE IS ISSUED IF THE DISK IS NOT ACCESSED. 00114000 * 00115000 *. 00116000 EJECT 00117000 DMSARE START 00118000 RELEASE EQU * 00119000 EXTRN RELUFD 00120000 USING *,R12 00121000 USING NUCON,R0 00122000 LR R12,R15 SET UP A BASE REGISTER 00123000 LR R10,R14 SAVE THE RETURN REGISTER 00124000 CLI 8(R1),X'FF' ARE THERE ANY PARAMETERS AT ALL? 00125000 BE ERROR1 IF NOT, COMPLAIN. 00126000 LR R11,R1 REMEMBER R1 AT INPUT @V304332 00127000 LA R7,8(,R1) POINT AT THE FIRST ARGUMENT. 00128000 LR R3,R7 AND SETUP A WORK REGISTER. 00129000 CLI 3(R3),C' ' MORE THAN THREE CHARACTERS? 00130000 BNE ERROR2 ERROR IF SO. 00131000 MVC DIAGMSG+8(3),0(R3) MOVE IN DEV ADDR IN CASE @VA08082 00132000 * CCU FORM 00133000 MVI AREFLAG,ZERO CLEAR FLAGBYTE @VM03204 00134000 CLI 0(R3),C'0' IS IT NUMERIC? 00135000 BNL NUMOK YES. WORK ON IT. 00136000 CLI 1(R3),C' ' ONLY ONE CHARACTER? 00137000 BE CKMODE ASSUME IT IS A MODE-LETTER. 00138000 NUMOK SR R4,R4 EMPTY A WORK REGISTER. 00139000 SR R5,R5 ...AND ANOTHER. 00140000 B CKBYTE NOW, GO BUTCHER IT. 00141000 SPACE 00142000 TESTIT CLI 0(R3),C'A' MATCH IT WITH 'A'. 00143000 BL ERROR2 ERROR IF LOW. 00144000 CLI 0(R3),C'F' AND NOW WITH AN 'F'. 00145000 BH ERROR2 ERROR IF HIGH 00146000 IC R5,0(,R3) STUFF IT INTO A REGISTER. 00147000 SH R5,=XL2'00B7' BEND IT. 00148000 R5OK SLL R4,4 MAKE ROOM. 00149000 OR R4,R5 MARRY 00150000 GETBYTE LA R3,1(,R3) POINT TO THE NEXT CHARACTER. 00151000 CKBYTE CLI 0(R3),C'0' COMPARE WITH ZERO. 00152000 BL TESTA IF LOW, CAN BE ALPHA. 00153000 IC R5,0(,R3) STUFF IT INTO A REGISTER. 00154000 SH R5,=XL2'00F0' BEND IT. 00155000 CLI 0(R3),C'9' NUMERIC? 00156000 BNH R5OK ONLY IF NOT HIGH. 00157000 B ERROR2 NO GOOD AT ALL. 00158000 TESTA CLI 0(R3),C' ' DONE YET? 00159000 BNE TESTIT NOPE. 00160000 CLI 16(R1),X'FF' ANY EXTRAS? 00161000 LA R14,NOOPTS RETURN ADDRESS @V305038 00162000 OPCHK LA R6,* INDICATE NO DETACH OPTION, @V305038 00163000 * DEFAULT 00164000 BER R14 NO OPTIONS @V305038 00165000 CLI 16(R1),LTPAREN OPTIONS SPECIFIED? @V305032 00166000 BNE ERROR5 NOPE, SHOW ERROR @V305038 00167000 CLC 24(4,R1),=C'DET ' DETACH OPTION? @V305038 00168000 BNE ERROR5C NOPE, SHOW ERROR @V305032 00169000 CLI 32(R1),FF END? @V305032 00170000 BE SETOPT YUP, OK AS IS, BR @V305038 00171000 CLI 32(R1),RTPAREN CLOSE PAREN? @V305032 00172000 BNE ERROR5B NOPE, MORE OPTS, NOT ACCEPTABLE @V305032 00173000 CLI 40(R1),FF NOW THE END? @V305032 00174000 BNE ERROR5A NOPE, SHOW ERROR @V305032 00175000 SETOPT LA R6,DIAGMSG INDICATE DETACH OPTION TAKEN @V305038 00176000 BR R14 RETURN/NSI @V305038 00177000 SPACE 00178000 NOOPTS EQU * @V305038 00179000 C R4,MAXPOSS IS IT GREATER THAN X'FFF'? @VA04296 00180000 BH ERROR2 NO IT CAN'T. 00181000 LTR R4,R4 =X'000'? @VA01991 00182000 BZ ERROR2 ERROR IF SO @VA01991 00183000 DOALL SLR R2,R2 SET UP A SIGNAL @V305038 00184000 SR R1,R1 START AT TOP. 00185000 SCANLOOP L R15,VCADTNXT LOCATE ADTNXT @VM03093 00186000 BALR R14,R15 GO THERE. 00187000 BNZ DONE BRANCH IF NONE LEFT. 00188000 USING ADTSECT,R1 00189000 L R5,ADTDTA GET DEVICE-TABLE ADDRESS. 00190000 CH R4,DTAD(,R5) COMPARE ADDRESS WITH THAT SUPPLIED. 00191000 BNE SCANLOOP NOT YET. 00192000 TM ADTFLG1,ADTFRO+ADTFRW HAS IT BEEN ACCESSED? 00193000 BNZ TESTS CHECK FOR S-DISK @V201101 00194000 TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00195000 BZ ERROR3P NO ... POSSIBLE ERROR 3 @VM03204 00196000 TESTS EQU * @V201101 00197000 CLI ADTM,C'S' IS IT THE SYSTEM DISK? 00198000 BE CAREFULS YES - BE CAREFUL WITH S-DISK @VM03204 00199000 LA R2,SCANLOOP SET RETURN...(ALSO SIGNAL) 00200000 RELIT LR R9,R1 LET R9 POINT TO THE ADT @VA01696 00201000 USING ADTSECT,R9 ... @VA01696 00202000 * CLOSE ANY FILES WHICH MIGHT BE ACTIVE ON THIS DISK: 00203000 IC R1,ADTM PICK UP MODE LETTER, @VA01696 00204000 STC R1,THISDISK STORE IN 'FINISALL' P-LIST @VA01696 00205000 LA R1,FINISALL POINT TO 'FINIS * * X' PLIST @VA01696 00206000 L R15,AFINIS CLOSE ALL/ANY OPEN FILES @V305032 00207000 BALR R14,R15 ... @V305032 00208000 LR R0,R9 LET R0 POINT TO ACTIVE DISK TBL @V305032 00209000 LR R1,R9 DITTO R1 (FOR VARIOUS USE) @V305032 00210000 TM ADTFLG1,ADTFRW IS IT A CMS READ-WRITE DISK ? @V305032 00211000 BZ CLRELUFD NO - CALL RELUFD FORTHWITH @V305032 00212000 SR R15,R15 PERCHANCE NO FILES ? @V305032 00213000 C R15,ADTFSTC (E.G. ACCESS'D WITH ERASE OPT.) @V305032 00214000 BE CLRELUFD YES - DON'T UPDATE DIRECTORY. @V305032 00215000 CLM R11,B'1000',COMM ISSUED AS A FUNCTION CALL ? @V304332 00216000 BL CLRELUFD YES - OMIT SORT & UPDISK CALLS @V304332 00217000 CLM R11,B'1000',EXEC CHECK FURTHER ... @V304332 00218000 BH CLRELUFD BRANCH IF IT WAS A FUNCTION. @V304332 00219000 L R15,=V(SORTFST) NO - SORT ALL THE FST ENTRIES @V305032 00220000 BALR R14,R15 (VIA SUBROUTINE IN DMSALU) @V305032 00221000 OI ADTFLG3,ADTFNOAB SIGNAL "NO ABEND WANTED" @VM03177 00222000 L R15,AUPDISK AND CALL DMSAUD ("UPDISK") @V305032 00223000 BALR R14,R15 TO UPDATE THE (SORTED) DIRECTORY @V305032 00224000 DROP R9 NOTE: R0 STILL POINTS TO THE ADT @V305032 00225000 CLRELUFD L R15,ARELUFD NOW REALLY RELEASE THE DISK @V305032 00226000 BALR R14,R15 VIA THE "RELUFD" ROUTINE @V305032 00227000 OI AREFLAG,RELTHISD REMEMBER WE RELEASED THIS DISK @VM03204 00228000 L R8,ADTDTA GET THE DEVICE TABLE ADDRESS 00229000 SR R15,R15 00230000 ST R15,DTAD(,R8) AND ZERO IT OUT 00231000 BR R2 AND RETURN (POSSIBLY FOR MORE?). 00232000 SPACE 00233000 CAREFULS OI AREFLAG,RELSDISK SIGNAL DISK MATCHES S-DISK @VM03204 00234000 B SCANLOOP AND EXAMINE REMAINING ADT BLOCKS @VM03204 00235000 SPACE 00236000 DONE LTR R2,R2 DID WE FIND IT? 00237000 BNZ EXIT IF R2 NONZERO, WE'RE ALL DONE. @VM03204 00238000 TM AREFLAG,RELSDISK DID WE FIND S-DISK IN SEARCH? @VM03204 00239000 BO ERROR2 IF YES, MAKE THAT ERROR2 @VM03204 00240000 B ERROR3MS OTHERWISE, CHECK IF ERROR @VA04877 00241000 * MESSAGE NEEDED 00242000 SPACE 00243000 CKMODE CLI 0(R3),C'A' MODE LESS THAN 'A'? 00244000 BL ERROR4 YES, ERROR. 00245000 CLI 0(R3),C'Z' HIGHER THAN 'Z'? 00246000 BH ERROR4 YES, ALSO ERROR. 00247000 CLI 0(R3),C'S' IS IT THE SYSTEM-DISK? 00248000 BE ERROR4 ERROR FOR NOW. 00249000 CLI 16(R1),X'FF' ANY EXTRA PARAMETERS? 00250000 BAL R14,OPCHK GO CHECK FOR DETACH OPTION @V305038 00251000 LA R4,16 GET A HANDY CONSTANT. 00252000 SR R1,R4 ...TO BACK UP THE P-LIST POINTER. 00253000 L R15,VCADTLKP SEE IF IT IS KNOWN. @VM03093 00254000 BALR R14,R15 IS IT? 00255000 BNZ ERROR4 NO. 00256000 USING ADTSECT,R1 00257000 TM ADTFLG1,ADTFRO+ADTFRW IS IT ACCESSED? 00258000 BNZ FREEIT YES..BRANCH @V201101 00259000 TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00260000 BZ ERROR6 NO...ERROR @V201101 00261000 FREEIT EQU * @V201101 00262000 L R4,ADTDTA ADDR OF ACTIVE DISK TABLE @V305038 00263000 UNPK DIAGMSG+8(4),0(3,R4) CONVERT DEVICE ADDRESS @VA08082 00264000 TR DIAGMSG+8(3),HEXTAB-C'0' TO HEX @VA08082 00265000 CLI 0(R6),DETOPT DETACH OPTION SPECIFIED? @V305032 00266000 BNE ONLYONE NOPE, ONLY RELEASE SPECIFIED @V305038 00267000 * DEVICE 00268000 LH R4,DTAD(R4) IF DET, DO ALL DEVICES WITH @V305038 00269000 * SAME CCU 00270000 B DOALL ... @V305038 00271000 DROP R1 00272000 ONLYONE BAL R2,RELIT @V305038 00273000 EXIT CLI 0(R6),DETOPT WAS DETACH OPTION SPECIFIED? @V305032 00274000 BNE NODIAG NOPE, SKIP @V305038 00275000 TM AREFLAG,RELSDISK WAS THIS REALLY THE S-DISK ? @VM03204 00276000 BO NODIAG YES - IGNORE THE 'DET' OPTION. @VM03204 00277000 TM BATFLAGS,BATRUN+BATLOAD BATCH RUNNING @VA08082 00278000 BC 11,NOTBAT NO, SKIP BTP @VA08082 00279000 TM BATFLAGS,BATUSEX BATCH USER JOB @VA08082 00280000 BZ NOTBAT NO, SKIP BTP EXIT @VA08082 00281000 OI BATFLAGS,BATCPEX CP FUNCTION (CPF) CALL @VA08082 00282000 LA R1,CPDET POINT TO PLIST @VA08082 00283000 MVI DIAGMSG+11,X'40' PAD BLANK FOR BTP @VA08082 00284000 LR R2,R10 SAVE ACROSS CALL TO BTP @VA08082 00285000 L R15,ABATPROC BTP ADDRESS @VA08082 00286000 BALR R14,R15 CALL BTP @VA08082 00287000 LR R10,R2 RESTORE R10 @VA08082 00288000 LTR R15,R15 GOOD RETURN @VA08082 00289000 BNZ GETOUT NO, SAVE RETURN @VA08082 00290000 NOTBAT EQU * @VA08082 00291000 LA R1,=CL8'CONWAIT' SYNCHRONIZE CP DETACH MESSAGE @VM03214 00292000 SVC SVC202 ... @VM03214 00293000 LA R7,L'DIAGMSG-1 LENGTH OF MSG @V305038 00294000 DC X'83670008' ISSUE DETACH REQUEST @V305038 00295000 NODIAG SLR R15,R15 CLEAR AND EXIT @V305038 00296000 B GETOUT AND GETOUT. 00297000 EXIT1 LA R15,24 (MOST COMMON RETURN CODE). 00298000 GETOUT LR R14,R10 REMEMBER THE RETURN. 00299000 BR R14 LEAVE. 00300000 DS 0F @VA01696 00301000 FINISALL DC CL8'FINIS' CLOSE ALL... @VA01696 00302000 DC CL8'*' FILENAMES, @VA01696 00303000 DC CL8'*' FILETYPES, @VA01696 00304000 THISDISK DC CL2'X ' ON "THIS" DISK. @VA01696 00305000 SPACE 00306000 AREFLAG DC X'00' FLAGBYTE, USED AS FOLLOWS: @VM03204 00307000 RELTHISD EQU X'80' WE ALREADY RELEASED THIS DISK @VM03204 00308000 RELSDISK EQU X'40' S-DISK (AS ANOTHER) RELEASED @VM03204 00309000 SPACE 00310000 ZERO EQU X'00' (FOR CLEARING THE FLAG) @VM03204 00311000 SPACE 00312000 DC X'00' FOR ALIGNMENT/FUTURE USE @VM03204 00313000 SPACE 00314000 COMM DC X'0C' ISSUED AS A COMMAND @V304332 00315000 EXEC DC X'0E' ISSUED AS AN EXEC @V304332 00316000 EJECT 00317000 ERROR1 DMSERR NUM=28,LET=E,TEXT='NO DEVICE SPECIFIED' 00318000 B EXIT1 GETOUT 00319000 SPACE 00320000 ERROR2 DMSERR NUM=17,LET=E,SUB=(CHARA,(7)), X00321000 TEXT='INVALID DEVICE ADDRESS ''........''' 00322000 B EXIT1 GETOUT 00323000 SPACE 00324000 ERROR3P DS 0H POSSIBLE ERROR 3: @VM03204 00325000 TM AREFLAG,RELTHISD HAVE WE ALREADY RELEASED THIS? @VM03204 00326000 BO TESTS IF YES, FORGET IT. @VM03204 00327000 * NO - A TRUE ERROR 3; CONTINUE ... 00328000 ERROR3MS EQU * @VA04877 00329000 CLM R11,B'1000',COMM ISSUED AS A FUNCTION CALL? @VA04877 00330000 BL SET36 IF YES, BRANCH AND OMIT ERROR @VA04877 00331000 * MESSAGE 00332000 CLM R11,B'1000',EXEC CHECK FURTHER FOR FUNCTION CALL@VA04877 00333000 BH SET36 IF IT IS, OMIT ERROR MESSAGE @VA04877 00334000 ERROR3 DMSERR NUM=69,LET=E,SUB=(CHARA,(7)), P0814X00335000 TEXT='DISK ''...'' NOT ACCESSED' P0814 00336000 SET36 EQU * @VA04877 00337000 LA R15,36 00338000 B GETOUT SINCE WE SUPPLIED THE RETURN CODE. 00339000 SPACE 00340000 ERROR4 DMSERR NUM=48,LET=E,SUB=(CHARA,(7)), X00341000 TEXT='INVALID MODE ''..''' 00342000 B EXIT1 00343000 SPACE 00344000 ERROR5A LA R7,8(,R7) BUMP P-LIST PTR IF 40(R1) NG @V305032 00345000 ERROR5B LA R7,8(,R7) BUMP P-LIST PTR IF 32(R1) NG @V305032 00346000 ERROR5C LA R7,8(,R7) BUMP P-LIST PTR IF 24(R1) NG @V305032 00347000 ERROR5 LA R7,8(,R7) 00348000 DMSERR NUM=70,LET=E,SUB=(CHARA,(7)), X00349000 TEXT='INVALID PARAMETER ''........''' 00350000 B EXIT1 00351000 SPACE 00352000 ERROR6 DMSERR NUM=69,LET=E,SUB=(CHARA,(7)), X00353000 TEXT='DISK ''..'' NOT ACCESSED' 00354000 LA R15,36 00355000 B GETOUT SINCE WE HAVE THE RETURN CODE SET 00356000 SPACE 2 00357000 CPDET DS 0D PARM LIST FOR BTP @VA08082 00358000 DC CL8'CP' DUMMY HEADER @VA08082 00359000 DIAGMSG DC CL12'DETACH XXXY' DETACH (Y IS FOR UNPACK) @VA08082 00360000 DC CL4' ' PADDING @VA08082 00361000 HEXTAB DC C'0123456789ABCDEF' BINHEX CONVERT @V305038 00362000 ARELUFD DC A(RELUFD) 00363000 MAXPOSS DC XL4'FFF' MAXIMUM VIRTUAL DEVICE ADDRESS @VA04296 00364000 LTORG OTHER CONSTANTS... @VA01696 00365000 SPACE 00366000 * NEEDED EQUATES: 00367000 LTPAREN EQU C'(' LEFT PARENTHESIS @V305032 00368000 RTPAREN EQU C')' RIGHT PARENTHESIS @V305032 00369000 DETOPT EQU C'D' 'D' FOR 'DETACH' OPTION @V305032 00370000 FF EQU X'FF' INDICATES END OF P-LIST @V305032 00371000 SVC202 EQU 202 @VM03214 00372000 EJECT 00373000 NUCON 00374000 ADT 00375000 REGEQU 00376000 END 00377000