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