LLU TITLE 'DMSLLU (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME 00004000 * 00005000 * DMSLLU ( LISTIO ) 00006000 * 00007000 * FUNCTION 00008000 * 00009000 * PROVIDE THE FACILITY TO LIST I/O ASSIGNMENTS OF ONE, 00010000 * SOME, OR ALL LOGICAL UNITS IN THE CMS/DOS SUPPORT. 00011000 * OUTPUT OF THE COMMAND WILL BE DIRECTED TO THE USER'S 00012000 * CONSOLE, OR TO A CMS DISK FILE (EXEC) IF THE 'EXEC' 00013000 * OR 'APPEND' OPTION IS SPECIFIED. 00014000 * 00015000 * ATTRIBUTES 00016000 * 00017000 * DISK RESIDENT MODULE 00018000 * SERIALLY REUSABLE 00019000 * EXECUTES IN TRANSIENT AREA 00020000 * NOTE: LISTIO MUST BE GENMOD'D WITH THE SYSTEM OPTION 00021000 * 00022000 * ENTRY POINTS 00023000 * 00024000 * DMSLLU 00025000 * 00026000 * ENTRY CONDITIONS 00027000 * 00028000 * R1 = PARAMETER LIST 00029000 * 00030000 * DC CL8'LISTIO' COMMAND 00031000 * ONLY ONE MAY BE SPECIFIED... 00032000 * DC CL8'SYSNNN' LIST ONLY ONE LOGICAL UNIT 00033000 * DC CL8'SYS'|'PROG' LIST EITHER SYSTEM OR PROGMRS 00034000 * DC CL8'ALL'|' ' LIST ALL LOGICAL UNITS 00035000 * NONE SPECIFIED MEANS 'ALL' 00036000 * DC CL8'A'|'UA' LIST LOGICAL UNITS WHICH HAVE 00036100 * BEEN ASSIGNED (A) OR UNASSIGNED (UA) 00036200 * DC CL8'(' BEGIN OF OPTIONS IF ANY 00037000 * DC CL8'EXEC' OR 'APPEND' LAST ONE SPECIFIED IS USED 00038000 * DC CL8'STAT' IF DISK, SHOW IF R/O OR R/W 00039000 * 00040000 * OPTIONS 00041000 * 00042000 * EXEC - DIRECT OUTPUT TO CMS DISK WITH FILEID 00043000 * '$LISTIO EXEC A1'. THIS FILE REPLACES 00044000 * ANY OLD FILE BY THAT SAME NAME. 00045000 * 00046000 * THE CONTENTS OF THIS FILE ARE ALMOST 00047000 * THE SAME AS THE OUTPUT TO THE USER'S 00048000 * CONSOLE, EXCEPT THAT THE OUTPUT BUFFER 00049000 * WILL CONTAIN THE DUMMY ARGUMENTS '&1 &2' 00050000 * PRECEDING THE ORIGINAL CONTENTS OF THE 00051000 * BUFFER. 00052000 * 00053000 * APPEND - DIRECT OUTPUT TO AN EXISTING '$LISTIO 00054000 * EXEC A1' IF IT EXISTS, OR CREATES A NEW 00055000 * ONE IF IT DOES NOT EXIST. 00056000 * 00057000 * STAT - IF THE LOGICAL UNIT IS ASSIGNED TO DISK, 00058000 * SHOW IN THE OUTPUT BUFFER IF THE DISK IS 00059000 * ACCESSED R/O OR R/W. 00060000 * 00061000 * EXIT CONDITIONS 00062000 * 00063000 * RETURN TO CALLER WITH RETURN CODE IN R15 00064000 * 00065000 * RETURN CODES AND MESSAGES: 00066000 * 00067000 * 24 - INVALID OPTION SPECIFIED 00068000 * 24 - INVALID PARAMETER SPECIFIED 00069000 * 32 - CMS/DOS ENVIRONMENT NOT ACTIVE 00070000 * 36 - NO READ/WRITE 'A' DISK ACCESSED 00071000 * 100 - ERROR WRITING FILE '$LISTIO EXEC A1' TO DISK 00072000 * 00073000 * CALLS TO OTHER ROUTINES 00074000 * 00075000 * DMSLAD, DMSERR, DMSERS, DMSKEY 00076000 * DMSBWR, DMSCWR, DMSFNS 00077000 * 00078000 * EXTERNAL REFERENCES 00079000 * 00080000 * NUCON, BGCOM, ADT, MAPPUB 00081000 * 00082000 * TABLES/WORK AREAS 00083000 * 00084000 * NONE 00085000 * 00086000 * REGISTER USAGE 00087000 * 00088000 * R0 NUCON ADDRESSABILITY 00089000 * R1 BGCOM, ADT ADDRESSABILITY & PLIST(S) POINTER 00090000 * R2 COMMAND LINE POINTER & WORK 00091000 * R3 POINTER TO NICL TABLE 00092000 * R4 POINTER TO CURRENT UNIT TO BE LISTED 00093000 * R5 COUNTER OF NUMBER SYSTEM UNITS TO LIST 00094000 * R6 COUNTER OF NUMBER PROGMR UNITS TO LIST 00095000 * R7 WORK 00096000 * R8 WORK 00097000 * R9 NOT USED 00098000 * R10 INTERNAL LINKAGE 00099000 * R11 TEMPORARY RETURN CODE 00100000 * R12 DMSLLU ADDRESSABILITY 00101000 * R13 NOT USED 00102000 * R14 EXTERNAL LINKAGE 00103000 * R15 ADDRESS LINKING ROUTINE & RETURN CODE 00104000 * 00105000 * OPERATION 00106000 * 00107000 * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00108000 * THE RETURN REGISTER. ACQUIRE SUPERVISOR KEY 00109000 * AND INITIALIZE REUSABILITY FIELDS. VERIFY IF 00110000 * IN CMS/DOS ENVIRONMENT. 00111000 * 00112000 * 2. CHECK THE COMMAND LINE FOR VALID ARGUMENTS 00113000 * AND OPTIONS. ENSURE THAT IF AN ARGUMENT WAS 00114000 * SPECIFIED, IT IS EITHER 'SYS', 'PROG', 'ALL', 00115000 * OR 'SYSXXX'. IF NO ARGUMENT SPECIFIED, ASSUME 00116000 * 'ALL'. VERIFY THAT IF ANY OPTION IS SPECIFIED 00117000 * IT IS 'EXEC' OR 'APPEND'. 00118000 * 00119000 * 3. IF EITHER 'EXEC' OR 'APPEND' WAS SPECIFIED, CHECK 00120000 * THAT THE 'A' DISK IS READ/WRITE. IF 'EXEC' WAS 00121000 * SPECIFIED, AN ERASE OF ANY OLD '$LISTIO EXEC' ON 00122000 * THE 'A' DISK IS ATTEMPTED. 00123000 * 00124000 * 4. IF EITHER 'SYS' OR 'PROG' WAS SPECIFIED, THE NO. 00125000 * OF LOGICAL UNITS (SYSTEM OR PROGRMR) IS ACQUIRED 00126000 * FROM THE NICL TABLE. THEN, USING THE INFORMATION 00127000 * ON THE LUB AND PUB TABLES, THE OUTPUT BUFFER IS 00128000 * BUILT AND WRITTEN OUT. 00129000 * 00130000 * IF 'ALL' WAS SPECIFIED, THE TOTAL NUMBER OF UNITS 00131000 * (SYSTEM + PROGRMR) IS COMPUTED . 00132000 * 00133000 * IF 'SYSXXX' WAS SPECIFIED, ONLY THAT PARTICULAR 00134000 * LOGICAL UNIT IS LISTED. 00135000 * 00136000 * 5. WHEN ALL PROCESSING HAS BEEN DONE, THE '$LISTIO 00137000 * EXEC' FILE IS CLOSED (IF 'DISK' OR 'APPEND' WAS 00138000 * SPECIFIED. 00139000 * 00140000 * 6. A SWITCH TO PROBLEM PROGRAM KEY IS DONE, AND A 00141000 * RETURN TO THE CALLER IS MADE PASSING IN REG. 15 00142000 * THE RETURN CODE OF THE COMMAND. 00143000 *. 00144000 EJECT 00145000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00146000 * * 00147000 * INITIALIZATION - ESTABLISH BASE REG., SET UP NUCLEUS * 00148000 * ENVIRONMENT AND VERIFY CMS IS IN DOS ENVIRONMENT. * 00149000 * * 00150000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00151000 SPACE 2 00152000 DMSLLU CSECT @V305001 00153000 USING DMSLLU,R12 @V305001 00154000 USING NUCON,R0 @V305001 00155000 LR R12,R15 SET UP BASE REGISTER @V305001 00156000 ST R14,SAVE14 SAVE RETURN REGISTER @V305001 00157000 TM DOSFLAGS,DOSMODE ARE WE IN DOS MODE ? @V305001 00158000 BZ ERR099 NO, ERROR @V305001 00159000 XC REQSW(2),REQSW CLEAR REQSW AND LIOSW @VA04410 00160000 EJECT 00161000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00162000 * * 00163000 * SCAN THE COMMAND LINE FOR ERRORS. SET PROPER FLAGS TO * 00164000 * DETERMINE IS 'SYS', 'PROG', 'EXEC', OR 'APPEND' WHERE * 00165000 * SPECIFIED. 'EXEC' AND 'APPEND' ARE MUTUALLY EXCLUSIVE. * 00166000 * * 00167000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00168000 SPACE 2 00169000 LA R2,8(,R1) POINT TO 1ST. PARAM @V305001 00170000 CLI 0(R2),FENCE LISTIO WITH NO PARAMETERS ? @V305001 00171000 BE LIOALL YES, GO PROCESS ALL @V305001 00172000 CLI 0(R2),LPAR LISTIO WITH OPTIONS ONLY ? @V305001 00173000 BE CHKOPTS2 YES, GO PROCESS OPTIONS @V305001 00174000 ST R2,SAVEPTR SAVE PTR TO 1ST. PARAMETER @V305001 00175000 CLC ALL,0(R2) LISTIO ALL ? @V305001 00176000 BE CHKOPTS YES, BRANCH @V305001 00177000 CLC A,0(R2) LISTIO A (ASSIGNED) @VA04310 00177100 BE ASSIGNED YES, JUST LIST ASSIGNED LOG UNITS@VA04310 00177200 CLC UA,0(R2) LISTIO UA (UNASSIGNED) @VA04310 00177300 BE UNASGN YES, LIST UNASSIGNED LOG UNITS @VA04310 00177400 CLC SYS,0(R2) LISTIO SYS ? @V305001 00178000 BE LIOSYS YES, BRANCH @V305001 00179000 CLC PROG,0(R2) LISTIO PROG ? @V305001 00180000 BNE ERR070 NO, INVALID PARAMETER @V305001 00181000 OI LIOSW,PROGF SET PROG FLAG @V305001 00182000 B CHKOPTS GO CHECK OPTIONS @V305001 00183000 ASSIGNED OI LIOSW,ASSGN ASSIGNED @VA04310 00183100 B CHKOPTS CHECK IF ANY OPTIONS @VA04310 00183200 UNASGN OI LIOSW,NOTASGN UNASSIGNED @VA04310 00183300 B CHKOPTS CHECK IF ANY OPTIONS @VA04310 00183400 LIOSYS OI LIOSW,SYSF SET SYS FLAG @V305001 00184000 CHKOPTS LA R2,8(,R2) BUMP TO NEXT PARAM @V305001 00185000 CLI 0(R2),FENCE NO OPTIONS ? @V305001 00186000 BE LIOALL NO, DON'T CHECK ANYMORE @V305001 00187000 CLI 0(R2),LPAR IS IT LEFT PARENS ? @V305001 00188000 BNE ERR070 NO, ERROR @V305001 00189000 CHKOPTS2 LA R2,8(,R2) BUMP TO NEXT PARAM @V305001 00190000 CLC EXEC,0(R2) IS IT EXEC OPTION ? @V305001 00191000 BNE LIOAPPND NO, CHECK FOR APPEND @V305001 00192000 NI LIOSW,255-APPENDF CLEAR APPENDF IF ON @VM03227 00193000 OI LIOSW,EXECF SET EXEC FLAG @V305001 00194000 B LIONXT DO ONE MORE CHECK @V305001 00195000 LIOAPPND CLC APPEND,0(R2) IT IT APPEND OPTION ? @V305001 00196000 BNE LIOSTAT NO, CHECK FOR STAT @VM03227 00197000 NI LIOSW,255-EXECF CLEAR EXECF IF ON @VM03227 00198000 OI LIOSW,APPENDF SET APPEND FLAG @V305001 00199000 B LIONXT GO CHECK FOR MORE OPTIONS @VM03227 00200000 LIOSTAT CLC STAT,0(R2) IS IT STAT OPTION ? @VM03227 00201000 BNE ERR003 NO, INVALID OPTION @VM03227 00202000 OI LIOSW,STATF SET STAT FLAG @VM03227 00203000 LIONXT CLI 8(R2),RPAR IS IT RIGHT PARENS ? @VM03227 00204000 BE LIOALL YES, ALL DONE WITH LINE @VM03227 00205000 CLI 8(R2),FENCE IS IT FENCE THEN ? @VM03227 00206000 BNE CHKOPTS2 NO, CHECK AS OPTION @VM03227 00207000 EJECT 00208000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00209000 * * 00210000 * DETERMINE IF USER WANTS ALL SYSTEM UNITS, OR ALL PRO- * 00211000 * GRAMMER UNITS, OR A SPECIFIED SYSTEM OR PRGMR UNIT, OR * 00212000 * HE WANTS ALL UNITS. SET UP PROPER REGISTERS FOR USE BY * 00213000 * LIOCOM1 OR LIOCOM2 TO FIND LUB/PUB FOR UNIT AND THE * 00214000 * NUMBER OF UNITS THE USER WANTS LISTED. * 00215000 * * 00216000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00217000 SPACE 2 00218000 USING BGCOM,R1 @V305001 00219000 LIOALL L R1,ASYSREF GET COMM. REGION ADDR. @V305001 00220000 LH R2,LUBPT GET LUB TABLE ADDR. @V305001 00221000 LH R3,NICLPT POINT TO NICL TABLE @V305001 00222000 SR R4,R4 START FROM FIRST UNIT @V305001 00223000 SR R5,R5 ... @V305001 00224000 SR R6,R6 ... @V305001 00225000 TM LIOSW,PROGF+SYSF USER WANTS ALL UNITS ? @V305001 00226000 BNZ LIOPROG NO, BRANCH @V305001 00227000 IC R5,0(,R3) GET NUMBER SYSTEM UNITS @V305001 00228000 IC R6,1(,R3) GET NUMBER PROGMR UNITS @V305001 00229000 B LIOCOM1 START WITH SYSTEM UNITS @V305001 00230000 LIOPROG TM LIOSW,PROGF USER WANTS PROG UNITS ? @V305001 00231000 BNO LIOSYSU NO, BRANCH @V305001 00232000 IC R6,1(,R3) GET NUMBER PROGMR UNITS @V305001 00233000 B LIOCOM2 START WITH PROGMR UNITS @V305001 00234000 LIOSYSU L R8,SAVEPTR RESTORE PNTR 1ST. ARG @V305001 00235000 CLI 3(R8),BLANK SPECIFIED SYSXXX ? @V305001 00236000 BNE LIOSYSX YES, BRANCH @V305001 00237000 IC R5,0(,R3) GET NUMBER SYSTEM UNITS @V305001 00238000 B LIOCOM1 START WITH SYSTEM UNITS @V305001 00239000 EJECT 00240000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00241000 * * 00242000 * PROCESS A SPECIFIED SYSTEM OR PROGRAMMER LOGICAL UNIT. * 00243000 * USER MUST SPECIFY WHICH SYSXXX HE WANTS LISTED. * 00244000 * * 00245000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00246000 SPACE 2 00247000 LIOSYSX CLC 3(3,R8),=CL3'000' IS IT SYSTEM UNIT ? @V305001 00248000 BL SYSUNIT LOOKS LIKE IT, BRANCH @V305001 00249000 CLC 3(3,R8),=CL3'241' EXCEEDS MAX PROG UNIT ? @V305066 00250000 BNH PROGOK NO, BRANCH @V305001 00251000 LR R2,R8 MSG SUBSTITUTION REG @V305001 00252000 B ERR070 INVALID PARAMETER @V305001 00253000 PROGOK PACK WORK(8),3(3,R8) PACK THE UNIT NO. @V305001 00254000 CVB R4,WORK NOW CONVERT TO BINARY @V305001 00255000 LA R6,ONE JUST LIST THIS UNIT @V305066 00256000 B LIOCOM2 GO LIST PROG UNIT @V305001 00257000 SYSUNIT CLC SIN,3(R8) IS UNIT SYSIN ? @V305001 00258000 BE SYSIN YES, BRANCH @V305001 00259000 CLC SOUT,3(R8) IS UNIT SYSOUT ? @V305001 00260000 BNE SYSCOMM NO, BRANCH @V305001 00261000 LA R4,TWO POINT TO SYSPCH UNIT @V305066 00262000 SYSIN LA R5,TWO JUST LIST 2 UNITS @V305066 00263000 B LIOCOM1 GO LIST UNITS @V305001 00264000 SYSCOMM LA R7,SYSTAB POINT TO SYS UNITS @V305001 00265000 LA R5,LSYSTAB GET NUMBER ENTRIES @V305001 00266000 SYSLUP CLC 3(4,R8),0(R7) FOUND A MATCH ? @V305001 00267000 BE SYSOK YES, GET OUT OF LOOP @V305001 00268000 LA R4,1(,R4) POINT TO NEXT UNIT @V305001 00269000 LA R7,4(,R7) DITTO.... @V305001 00270000 BCT R5,SYSLUP KEEP LOOKING @V305001 00271000 LR R2,R8 IF HERE MUST BE NO MATCH @V305001 00272000 B ERR070 GO GIVE ERROR @V305001 00273000 SYSOK LA R5,ONE JUST LIST THIS UNIT @V305066 00274000 EJECT 00275000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00276000 * * 00277000 * PROCESS SYSTEM LOGICAL UNITS FROM LABEL LIOCOM1, OR PRO- * 00278000 * GRAMMER LOGICAL UNITS FROM LABEL LIOCOM2. BOTH ROUTINES * 00279000 * USE LIOCOM3 TO FIND THE PUB AND LIST THE SPECIFIED UNIT. * 00280000 * WHEN THE SPECIFIED UNITS ARE LISTED, THE $LISTIO EXEC * 00281000 * FILE IS CLOSED, AND LISTIO RETURNS TO ITS CALLER. * 00282000 * * 00283000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00284000 SPACE 2 00285000 LIOCOM1 LR R7,R4 SAVE STARTING UNIT @V305001 00286000 SLL R7,2 MULTIPLY BY 4 @V305001 00287000 LA R8,SYSTAB(R7) POINT TO PROPER SYS UNIT @V305001 00288000 MVC UNIT,0(R8) MOVE UNIT TO BUFFER @V305001 00289000 SRL R7,1 SET FOR LUB INDEX @V305001 00290000 BAL R10,LIOCOM3 GO FIND DEVICE AND DO I/O @V305001 00291000 LA R4,1(,R4) POINT TO NEXT UNIT @V305001 00292000 BCT R5,LIOCOM1 LOOP IF MORE UNITS @V305001 00293000 SR R4,R4 PREPARE JUST IN CASE ALL @V305001 00294000 SPACE 1 00295000 LIOCOM2 LTR R6,R6 ANY PROGMR UNITS @V305001 00296000 BZ LIODONE NO, ALL DONE @V305001 00297000 LIOCOM2A LR R7,R4 SAVE START UNIT @V305001 00298000 CVD R7,WORK CONVERT TO DECIMAL @V305001 00299000 UNPK UNIT(3),WORK(8) UNPACK TO BUFFER @V305001 00300000 OI UNIT+2,ZONE SET LAST ZONE @V305066 00301000 SR R8,R8 ... @V305001 00302000 IC R8,0(,R3) GET NUMBER SYS UNITS @V305001 00303000 AR R7,R8 PREPARE LUB INDEX @V305001 00304000 SLL R7,1 FOR PUB FIND @V305001 00305000 BAL R10,LIOCOM3 GO FIND DEVICE AND DO I/O @V305001 00306000 LA R4,1(,R4) POINT TO NEXT UNIT @V305001 00307000 BCT R6,LIOCOM2A LOOP IF MORE UNITS @V305001 00308000 LIODONE SR R11,R11 ZERO RETURN CODE @V305001 00309000 LIOEXIT TM LIOSW,EXECF+APPENDF EXEC OR APPEND SPECIFIED ? @V305001 00310000 BZ LIOOUT NO, JUST RETURN @V305001 00311000 TM LIOSW,ASSGN REQ FOR ASSIGN @VA04410 00312000 BO CHKSW YES, SEE IF 'EXEC' OPTION @VA04410 00312100 TM LIOSW,NOTASGN REQUEST FOR UNASSIGN? @VA04410 00312200 BO CHKSW YES, SEE IF 'EXEC' OPTION @VA04410 00312300 FINIS LA R1,DSKLST PREPARE TO CLOSE '$LISTIO EXEC' @VA04410 00312400 L R15,AFINIS GET DMSFNS ADDRESS @V305001 00313000 BALR R14,R15 GO FINIS OUR FILE @V305001 00314000 LIOOUT TM LIOSW,ASSGN+NOTASGN REQ FOR 'A' OR 'UA'? @VA04410 00315000 BZ LIOOUT2 CONTINUE EXIT @VA04410 00315100 TM REQSW,REQON ANY SYSXXX SATISFIED REQUEST? @VA04410 00315200 BO LIOOUT2 YES, GET OUT @VA04410 00315300 B ERR303 NO, INDICATE ERROR @VA04410 00315400 LIOOUT2 LR R15,R11 RETURN CODE TO R15 @VA04410 00315500 RETURN L R14,SAVE14 RESTORE R14 FOR EXIT @VA04410 00316000 BR R14 RETURN TO CALLER @V305001 00317000 CHKSW TM REQSW,REQON '$LISTIO EXEC' WRITTEN TO YET? @VA04410 00317100 BO FINIS YES, CLOSE EXEC FILE @VA04410 00317200 B ERR303 GO PRINT ERROR MSG @VA04410 00317300 EJECT 00318000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00319000 * * 00320000 * FIND PUB FOR SPECIFIED UNIT, PREPARE BUFFER FOR OUTPUT * 00321000 * AND EITHER CALL CMS'S TYPLIN OR WRBUF ROUTINES TO PERFORM * 00322000 * PROPER I/O. WRBUF IS CALLED IF EXEC OR APPEND HAVE BEEN * 00323000 * SPECIFIED BY THE USER. * 00324000 * * 00325000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00326000 SPACE 2 00327000 USING PUBADR,R7 @V305001 00328000 LIOCOM3 MVC DEVTYP(20),BLANKS BLANK SOME OF BUFFER @V305001 00329000 AH R7,LUBPT POINT TO PROPER LUB ENTRY @V305001 00330000 LA R8,UA JUST IN CASE UNASSIGNED @V305001 00331000 TM 0(R7),UNASSGN UNIT UNASSIGNED ? @V305066 00332000 BO LIOCOM4A UNASSIGNED @VA04310 00333000 LA R8,IGN JUST IN CASE IGN @V305001 00334000 TM 0(R7),IGNORE INIT ASSIGNED TO IGNORE ? @V305066 00335000 BO LIOCOM4 YES, BRANCH @V305001 00336000 TM LIOSW,NOTASGN UNASSGN REQUEST? @VA04410 00336100 BO CHKEXEC SEE IF 'EXEC' OPTION @VA04410 00336200 CONTINUE LH R7,0(,R7) LUB ENTRY TO R7 @VA04410 00337000 SRL R7,8 MOVE OUT LAST BYTE @V305001 00338000 SLL R7,3 MULTIPLY INDEX BY 8 @V305001 00339000 AH R7,PUBPT POINT TO PROPER LUB @V305001 00340000 SR R8,R8 CLEAR REG. @V305001 00341000 IC R8,PUBDEVT GET DEVICE TYPE CODE @V305001 00342000 SRL R8,4 SHIFT OUT LAST 4 BITS @V305001 00343000 CH R8,=H'6' WITHIN RANGE SUPPORTED ? @V305001 00344000 BH LIOUNK OUT OF RANGE, UNKNOWN UNIT @V305001 00345000 SLL R8,3 SET INDEX TO DEVICE TABLE @V305001 00346000 LA R8,DEVTAB(R8) POINT TO CORRECT DEVICE @V305001 00347000 LIOCOM4 MVC DEVTYP,0(R8) MOVE DEVICE TO BUFFER @V305001 00348000 CLC DEVTYP,DISK IS DEVICE DISK ? @V305001 00349000 BNE LIOTAP NO, BRANCH @V305001 00350000 MVC DEVTYP(1),PUBDSKM MOVE DISK MODE TO BUFFER @VM03227 00351000 MVC DEVTYP+1(3),BLANKS AND BLANK OUT REST OF DEVTYP@VM03227 00352000 TM LIOSW,STATF WAS STAT OPTION SPECIFIED ? @VM03227 00353000 BZ LIOCOM5 NO, GO PERFORM I/O @VM03227 00354000 MVC DEVID,=CL4'R/W' INITIALIZE DISK MODE TO R/W @VM03227 00355000 LA R1,DEVTYP-24 GET ADTLKP PLIST @VM03227 00356000 L R15,VCADTLKP GET DMSLAD ADDRESS @VM03227 00357000 BALR R14,R15 GET DISK ADT @VM03227 00358000 USING ADTSECT,R1 @VM03227 00359000 TM ADTFLG1,ADTFRW IS IT CMS DISK R/W ? @VM03227 00360000 BO LIOCOM5 YES, GO PERFORM I/O @VM03227 00361000 TM ADTFLG3,ADTFRWOS IS IT DOS/OS DISK R/W ? @VM03227 00362000 BO LIOCOM5 YES, GO PERFORM I/O @VM03227 00363000 MVC DEVID,=CL4'R/O' THEN INITIALIZE TO R/O @VM03227 00364000 B LIOCOM5 GO PERFORM I/O @V305001 00365000 LIOCOM4A MVC DEVTYP,0(R8) DEVTYPE TO BUFFER @VA04410 00365050 TM LIOSW,EXECF EXEC OPTION SPECIFIED? @VA04410 00365100 BO LIOCOM5 YES, KEEP GOING @VA04410 00365150 TM LIOSW,ASSGN REQUEST FOR ASSIGNED? @VA04410 00365200 BCR 1,R10 YES, RETURN TO CALLER @VA04410 00365250 B LIOCOM5 KEEP GOING @VA04410 00365300 CHKEXEC TM LIOSW,EXECF EXEC OPTION SPECIFIED? @VA04410 00365350 BO CONTINUE YES, KEEP GOING @VA04410 00365400 BR R10 RETURN TO CALLER @VA04410 00365450 LIOUNK LA R8,UNKNOWN SET UNKNOWN DEVICE @V305001 00366000 B LIOCOM4 BRANCH ABOVE @V305001 00367000 LIOTAP CLC DEVTYP,TAPE IS DEVICE TAPE ? @V305001 00368000 BNE LIOCOM5 NO, BRANCH @V305001 00369000 XC WORK,WORK ZERO WORK AREA @V305001 00370000 LH R8,PUBCUU GET DEVICE ADDRESS @V305001 00371000 SLL R8,4 MOVE ONE BYTE LEFT @V305001 00372000 ST R8,WORK+4 SAVE IN WORK AREA @V305001 00373000 OI WORK+7,SIGN SUPPLY A SIGN TO UNPACK @V305066 00374000 UNPK DEVTYP+3(1),WORK+7(1) UNPACK LAST BYTE CUU @VM03227 00375000 OI DEVTYP+3,ZONE AND ZONE THE DIGIT @VM03227 00376000 DROP R1,R7 @V305001 00377000 EJECT 00378000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00379000 * * 00380000 * DETRMINES IF TYPLIN OR WRBUF ROUTINE SHOULD BE CALLED. * 00381000 * IF EXEC OPTION SPECIFIED, ANY OLD $LISTIO EXEC FILE IS * 00382000 * ERASED FROM THE USER'S A DISK (USER'S A DISK MUST BE R/W). * 00383000 * IF APPEND OPTION SPECIFIED, ANY NEW RECORDS ARE APPENDED * 00384000 * TO THE END OF AN EXISTING $LISTIO EXEC. IF NO $LISTIO * 00385000 * EXEC EXISTS, A NEW $LISTIO EXEC IS CREATED. * 00386000 * * 00387000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00388000 SPACE 2 00389000 LIOCOM5 L R7,ASYSREF GET COMM. REGION ADDR. @VM03227 00390000 TM LIOSW,EXECF+APPENDF EXEC OR APPEND SPECIFIED ? @V305001 00391000 BNZ DISKIO YES, DO I/O TO DISK @V305001 00392000 TM LIOSW,ASSGN+NOTASGN REQ FOR 'A' OR 'UA'? @VA04410 00393100 BZ TYPELINE TYPE TO CONSOLE @VA04410 00393200 OI REQSW,REQON IND. REQUEST SATISFIED @VA04410 00393300 TYPELINE LA R1,TYPLST GET TYPLIN PLIST @VA04410 00393400 SVC 202 TYPE LINE TO CONSOLE @V305001 00394000 DC AL4(*+4) ... @V305001 00395000 LR R1,R7 RESTORE REG. 1 @V305001 00396000 BR R10 RETURN TO CALLER @V305001 00397000 SPACE 1 00398000 DISKIO TM LIOSW,PASS1 PAST INITIALIZATION ? @V305001 00399000 BO AORUA YES, BRANCH @VA04410 00400000 LA R1,MODE-24 GET ADTLKP PLIST @V305001 00401000 L R15,VCADTLKP GET DMSLAD ADDRESS @VM03093 00402000 BALR R14,R15 GET A-DISK ADT @V305001 00403000 USING ADTSECT,R1 @V305001 00404000 TM ADTFLG1,ADTFRW IS A-DISK R/W ? @V305001 00405000 BNO ERR006 NO, ERROR @V305001 00406000 DROP R1 @V305001 00407000 TM LIOSW,APPENDF APPEND SPECIFIED ? @V305001 00408000 BO SETPASS1 YES, BRANCH @V305001 00409000 LA R1,DSKLST GET ERASE PLIST @V305001 00410000 L R15,AERASE GET DMSERS ADDRESS @V305001 00411000 BALR R14,R15 ERASE ANY OLD FILE @V305001 00412000 SETPASS1 OI LIOSW,PASS1 SET 1ST. PASS FLAG @V305001 00413000 SPACE 1 00414000 AORUA TM LIOSW,ASSGN REQ FOR ASSIGNED? @VA04410 00415000 BO UAORIGN YES, MAKE SURE NOT UA OR IGN @VA04410 00415100 TM LIOSW,NOTASGN REQUEST FOR UNASSIGNED? @VA04410 00415200 BO CHKUA MAKE SURE LOG UNIT UA @VA04410 00415300 WRITEIT LA R1,DSKLST GET WRBUF PLIST @VA04410 00415400 L R15,AWRBUF GET DMSBWR ADDRESS @V305001 00416000 BALR R14,R15 GO WRITE BUFFER @V305001 00417000 LTR R15,R15 ANY ERRORS ? @V305001 00418000 BNZ ERR105 YES, BRANCH TO ERROR @V305001 00419000 LR R1,R7 RESTORE REG. 1 @V305001 00420000 BR R10 RETURN TO CALLER @V305001 00421000 UAORIGN CLC DEVTYP,UA LOG UNIT UNASSIGNED? @VA04410 00421050 BE NOPRINT DO NOT PUT TO '$LISTIO EXEC' @VA04410 00421100 CLC DEVTYP,IGN LOG UNIT 'IGN'? @VA04410 00421150 BE NOPRINT DO NOT PUT TO '$LISTIO EXEC' @VA04410 00421200 OI REQSW,REQON IND. WRITTEN TO '$LISTIO EXEC' @VA04410 00421250 B WRITEIT BRANCH TO WRITE TO '$LISTIO EXEC'@VA04410 00421300 NOPRINT LR R1,R7 RESTORE REG 1 @VA04410 00421350 BR R10 RETURN TO CALLER @VA04410 00421400 CHKUA CLC DEVTYP,UA LOG UNIT UNASSIGNED? @VA04410 00421450 BNE NOPRINT DO NOT PUT TO '$LISTIO EXEC' @VA04410 00421500 OI REQSW,REQON IND. WRITTEN TO '$LISTIO EXEC' @VA04410 00421550 B WRITEIT WRITE TO '$LISTIO EXEC' @VA04410 00421600 EJECT 00422000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00423000 * * 00424000 * EQUATES, SAVE AREAS, AND ARGUMENT/OPTIONS CONSTANTS. * 00425000 * * 00426000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00427000 SPACE 2 00428000 FENCE EQU X'FF' CMS PLIST FENCE @V305001 00429000 LPAR EQU C'(' LEFT PARENS @V305001 00430000 RPAR EQU C')' RIGHT PARENS @V305001 00431000 BLANK EQU C' ' BLANK CODE @V305001 00432000 UNASSGN EQU X'FF' UNIT UNASSIGNED @V305066 00433000 IGNORE EQU X'FE' UNIT ASSIGNED TO IGNORE @V305066 00434000 ZONE EQU X'F0' ZONE CODE @V305066 00435000 SIGN EQU X'0C' SIGN CODE @V305066 00436000 ONE EQU 1 CONSTANT @V305066 00437000 TWO EQU 2 CONSTANT @V305066 00438000 RC24 EQU 24 RETURN CODE @V305066 00439000 RC36 EQU 36 RETURN CODE @V305066 00440000 RC40 EQU 40 RETURN CODE @V305066 00441000 RC100 EQU 100 RETURN CODE @V305066 00442000 TWENTY8 EQU 28 @VA04410 00442100 * 00443000 WORK DS D CVD/UNPK WORK AREA @V305001 00444000 SAVE14 DS F SAVE RETURN REGISTER @V305001 00445000 SAVEPTR DS F SAVE PNTR 1ST. ARGUMENT @V305001 00446000 * 00446100 REQSW DS X INTERNAL SWITCH @VA04410 00446200 REQON EQU X'80' SOMETHG WRITTEN TO '$LISTIO EXEC'@V305001 00446300 * 00447000 LIOSW DS X INTERNAL SWITCH @V305001 00448000 * 00449000 * LIOSW FLAG SETTINGS 00450000 * 00451000 PROGF EQU X'80' PROG FLAG @V305001 00452000 SYSF EQU X'40' SYS FLAG @V305001 00453000 EXECF EQU X'20' EXEC FLAG @V305001 00454000 APPENDF EQU X'10' APPEND FLAG @V305001 00455000 PASS1 EQU X'08' @V305001 00456000 STATF EQU X'04' STAT FLAG @VM03227 00457000 ASSGN EQU X'02' ASSIGN FLAG @VA04310 00457100 NOTASGN EQU X'01' UNASSIGN FLAG @VA04310 00457200 * 00458000 SYS DC CL3'SYS' FUNCTION @V305001 00459000 ALL DC CL8'ALL' FUNCTION @V305001 00460000 PROG DC CL8'PROG' FUNCTION @V305001 00461000 EXEC DC CL8'EXEC' OPTION @V305001 00462000 APPEND DC CL8'APPEND' OPTION @V305001 00463000 STAT DC CL8'STAT' OPTION @VM03227 00464000 A DC CL8'A' FUNCTION @VA04310 00464100 EJECT 00465000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00466000 * * 00467000 * TABLES FOR SYSTEM LOGICAL UNITS (SYSTAB) AND FOR VALID * 00468000 * DEVICE TYPES (DEVTAB). * 00469000 * * 00470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00471000 SPACE 2 00472000 SYSTAB DS 0H @V305001 00473000 DC CL4'RDR' ... @V305001 00474000 DC CL4'IPT' ... @V305001 00475000 DC CL4'PCH' ... @V305001 00476000 DC CL4'LST' ... @V305001 00477000 DC CL4'LOG' ... @V305001 00478000 DC CL4'LNK' ... @V305001 00479000 DC CL4'RES' ... @V305001 00480000 DC CL4'SLB' ... @V305001 00481000 DC CL4'RLB' ... @V305001 00482000 DC CL4'USE' ... @V305001 00483000 DC CL4'REC' ... @V305001 00484000 DC CL4'CLB' ... @V305001 00485000 DC CL4'VIS' ... @V305001 00486000 DC CL4'CAT' ... @V305001 00487000 LSYSTAB EQU (*-SYSTAB)/4 NUMBER ITEM IN SYSTAB @V305001 00488000 SPACE 1 00489000 SIN DC CL4'IN' ... @V305001 00490000 SOUT DC CL4'OUT' ... @V305001 00491000 SPACE 1 00492000 DEVTAB DS 0H @V305001 00493000 DC CL8'TERMINAL' ... @V305001 00494000 DC CL8'READER' ... @V305001 00495000 DC CL8'PUNCH' ... @V305001 00496000 UNKNOWN DC CL8'UNKNOWN' ... @V305001 00497000 DC CL8'PRINTER' ... @V305001 00498000 TAPE DC CL8'TAPE' ... @V305001 00499000 DISK DC CL8'DISK' ... @V305001 00500000 SPACE 1 00501000 UA DC CL8'UA' ... @V305001 00502000 IGN DC CL8'IGN' ... @V305001 00503000 EJECT 00504000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00505000 * * 00506000 * OUTPUT BUFFER, TYPLIN PLIST AND WRBUF PLIST * 00507000 * * 00508000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00509000 SPACE 2 00510000 DS 0D @V305001 00511000 BUFF1 DC CL6' &&1 &&2' ONLY USED FOR EXEC/APPEND @V305001 00512000 BUFF2 DC CL4' SYS' SYS PREFIX OF LOGICAL UNIT @V305001 00513000 UNIT DC CL4' ' XXX PREFIX OF LOGICAL UNIT @V305001 00514000 DC CL1' ' ... @V305001 00515000 DEVTYP DC CL8' ' DEVICE TYPE IN EBCDIC @V305001 00516000 DC CL2' ' ... @V305001 00517000 DEVID DC CL4' ' R/O OR R/W (AS DISK ACCESSED) @VM03227 00518000 BLANKS DC CL57' ' BUFFER PAD @V305001 00519000 SPACE 1 00520000 DS 0D @V305001 00521000 TYPLST DC CL8'TYPLIN' COMMAND @V305001 00522000 DC AL1(1),AL3(BUFF2) FLAG AND BUFFER ADDR @V305001 00523000 DC CL1'B',AL3(80) FLAG AND BUFFER LEN @V305001 00524000 SPACE 1 00525000 DS 0D @V305001 00526000 DSKLST DC CL8' ' COMMAND @V305001 00527000 DC CL8'$LISTIO' FILE NAME @V305001 00528000 DC CL8'EXEC' FILE TYPE @V305001 00529000 MODE DC CL2'A1' FILE MODE @V305001 00530000 DC H'0' ITEM NUMBER @V305001 00531000 DC A(BUFF1) BUFFER ADDRESS @V305001 00532000 DC F'80' ITEM LENGTH @V305001 00533000 DC CL2'F' FIXED FORMAT CODE @V305001 00534000 DC H'1' NUMBER OF ITEMS @V305001 00535000 EJECT 00536000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00537000 * * 00538000 * ERROR MESSAGES * 00539000 * * 00540000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00541000 SPACE 2 00542000 ERR003 EQU * @V305001 00543000 DMSERR TEXT='INVALID OPTION ''........''',LET=E,NUM=003, *00544000 SUB=(CHARA,(R2)) @V305001 00545000 LA R11,RC24 RETURN CODE = 24 @V305066 00546000 B LIOOUT2 GET OUT @VA04410 00547000 SPACE 1 00548000 ERR006 EQU * @V305001 00549000 DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED',LET=E,NUM=006 00550000 LA R11,RC36 RETURN CODE = 36 @V305066 00551000 B LIOOUT2 GET OUT @VA04410 00552000 EJECT 00553000 ERR070 EQU * @V305001 00554000 DMSERR TEXT='INVALID PARAMETER ''........''',LET=E,NUM=070, *00555000 SUB=(CHARA,(R2)) @V305001 00556000 LA R11,RC24 RETURN CODE = 24 @V305066 00557000 B LIOOUT2 GET OUT @VA04410 00558000 SPACE 1 00559000 ERR105 LR R2,R15 ERROR CODE TO R2 @V305001 00560000 DMSERR TEXT='ERROR ''..'' WRITING FILE ''$LISTIO EXEC A1'' ON *00561000 DISK',LET=S,NUM=105,SUB=(DEC,(R2)) @V305001 00562000 LA R11,RC100 RETURN CODE = 100 @V305066 00563000 TM LIOSW,EXECF+APPENDF EXEC OR APPEND SPECIFIED? @VA04410 00564000 BZ LIOOUT2 GET OUT @VA04410 00564100 LA R1,DSKLST PREPARE TO FINIS FILE @VA04410 00564200 L R15,AFINIS CALL FINIS @VA04410 00564300 BALR R14,R15 BRANCH @VA04410 00564400 B LIOOUT2 GET OUT @VA04410 00564500 SPACE 1 00565000 ERR099 EQU * @V305001 00566000 DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',LET=E,NUM=099 00567000 LA R11,RC40 RETURN CODE = 40 @V305066 00568000 B LIOOUT2 GET OUT @VA04410 00569000 ERR303 EQU * @VA04410 00569100 DMSERR TEXT='NO SYSXXX SATISFIES REQUEST', @VA04410*00569200 NUM=303,LET=E @VA04410 00569300 LA R15,TWENTY8 RC = 28 @VA04410 00569400 B RETURN EXIT @VA04410 00569500 EJECT 00570000 NUCON @V305001 00571000 BGCOM @V305001 00572000 ADT @V305001 00573000 MAPPUB @V305001 00574000 REGEQU @V305001 00575000 END 00576000