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