ibm:vm370-lib:cp:dmkcqy.assemble_src
Table of Contents
DMKCQY Source
References
- Fixes Applied : 5
- This Source Date : Wednesday, December 13, 1978
- Last Fix ID : [HRC108DK]
Source Listing
- DMKCQY.ASSEMBLE.txt
- CQY TITLE 'DMKCQY (CP) VM/370 - RELEASE 6' 00001000
- ISEQ 73,80 VALIDATE SEQUENCING OF INPUT @V407490 00002000
- *. 00003000
- * MODULE NAME - 00004000
- * 00005000
- * DMKCQY 00006000
- * 00007000
- * FUNCTION - 00008000
- * 00009000
- * TO HANDLE QUERY FUNCTIONS: TIME, LOGMSG, NAME, USERS, 00010000
- * PF, SASSIST, CPASSIST, CPUID... 00011000
- * 00012000
- * ATTRIBUTES - 00013000
- * 00014000
- * RE-ENTERABLE, PAGEABLE, CALLED VIA SVC 8 00015000
- * 00016000
- * ENTRY POINTS - 00017000
- * 00018000
- * DMKCQYEY - MAIN ENTRY POINT FROM DMKCFC 00019000
- * 00020000
- * ENTRY CONDITIONS - 00021000
- * 00022000
- * R9 - ADDRESS OF COMMAND LINE BUFFER 00023000
- * R11- ADDRESS OF VMBLOK 00024000
- * R12- BASE ADDRESS OF MODULE 00025000
- * R13- ADDRESS OF SAVEAREA 00026000
- * 00027000
- * EXIT CONDITIONS - 00028000
- * 00029000
- * NORMAL - R2 = 0 00030000
- * ERROR - R2 = ERROR MESSAGE NUMBER 00031000
- * 00032000
- * CALLS TO OTHER ROUTINES - 00033000
- * 00034000
- * DMKSCNFD - TO GET FIELDS FROM COMMAND BUFFER 00035000
- * DMKCVTBD - TO CONVERT BINARY TO DECIMAL 00036000
- * DMKCVTBH - TO CONVERT BINARY TO HEX 00037000
- * DMKCVTDT - TO GET DATE AND TIME 00038000
- * DMKCVTDB - TO CONVERT DEC TO BINARY 00039000
- * DMKACOTM - TO ISSUE USER ACCOUNTING MESSAGE 00040000
- * DMKSCNAU - TO SCAN FOR ACTIVE USER 00041000
- * DMKSCNRD - TO GET REAL DEVICE NAME 00042000
- * DMKERMSG - TO ISSUE ERROR MESSAGES 00043000
- * 00044000
- * EXTERNAL REFERENCES 00045000
- * 00046000
- * DMKSYSDW - DAY OF THE WEEK 00047000
- * DMKSYSTI - TIME ZONE 00048000
- * DMKSYSLG - SYSTEM LOGMSG START 00049000
- * DMKSYSND - NUMBER OF USERS DIALED 00050000
- * DMKSYSNM - NUMBER OF USERS LOGGED ON 00051000
- * 00052000
- * TABLES/WORKAREAS 00053000
- * 00054000
- * SAVEAREA WORK AREAS USED FOR SCRATCH DATA 00055000
- * BRANCH TABLE FOR FUNCTION AT GNVECTOR 00056000
- * INDEX INTO TABLE BY R6 SET IN DMKCFC 00057000
- * 00058000
- * REGISTER USAGE 00059000
- * 00060000
- * R0 - LENGTH OF FIELD 00061000
- * R1 - ADDRESS OF FIELDS 00062000
- * R2 - PARM PASSING 00063000
- * R3 - STACK LINKAGE 00064000
- * R4 - R9 WORK REGISTERS FOR BUFFERS AND DSECTS 00065000
- * R10 - VMBLOK FOR SEARCHES 00066000
- * R11 - VMBLOK OF CALLER 00067000
- * R12 - BASE OF MODULE 00068000
- * R13 - SAVEAREA 00069000
- * R14 R15 - LINKAGE REGISTERS 00070000
- * 00071000
- * NOTES - 00072000
- * 00073000
- * NONE 00074000
- * 00075000
- * OPERATION - 00076000
- * 00077000
- * THE QUERY FUNCTIONS ARE ENTERED BY A BRANCH TABLE INDEX 00078000
- * THAT IS SET UP BY THE CALLING MODULE DMKCFC 00079000
- * THE FUNCTIONS ARE SEPARATE AND RETURN TO THE CALLER 00080000
- * EACH FUNCTION IS DESCRIBED AT THE SECTION 00081000
- * 00082000
- *. 00083000
- EJECT 00084000
- DMKCQY START 0 @V407490 00085000
- USING PSA,R0 @V407490 00086000
- USING VMBLOK,R11 @V407490 00087000
- USING SAVEAREA,R13 @V407490 00088000
- EXTRN DMKSCNFD,DMKCVTBD,DMKCVTBH @V407490 00089000
- EXTRN DMKCVTDT,DMKACOTM,DMKSCNAU @V407490 00090000
- EXTRN DMKSYSDW,DMKSYSTI,DMKSYSLG @V407490 00091000
- EXTRN DMKSYSND,DMKSYSNM,DMKSCNRD @V407490 00092000
- EXTRN DMKCVTDB @V407490 00093000
- EXTRN DMKERMSG @V407490 00094000
- EXTRN DMKSYSID HRC108DK 00094100
- SPACE 00095000
- ENTRY DMKCQYEY @V407490 00096000
- EJECT 00097000
- * THIS ROUTINE IS CALLED BY DMKCFCQU. SINCE THERE IS NO NEED 00098000
- * TO RETURN TO DMKCFCQU, THE SAVEAREA POINTED TO BY REG 13 00099000
- * WILL BE RELEASED. THUS, WHEN THIS ROUTINE RETURNS IT WIL 00100000
- * GO DIRECTLY BACK TO CFM TO SCAN FOR THE NEXT COMMAND. 00101000
- * UPON ENTRY GPR6 HAS BEEN SET UP BY CFCQU TO INDEX INTO THE 00102000
- * LIST OF BRANCHES ACCORDING TO ARGUMENT FOUND,THEREFORE THE 00103000
- * ORDER OF BRANCHES MUST BE THE SAME AS THE LIST IN CFCQU. 00104000
- SPACE 2 00105000
- MODID DC CL8'DMKCQY' @V407490 00106000
- USING *,R12 @V407490 00107000
- DMKCQYEY SVC 16 GIVE UP SAVEAREA @V407490 00108000
- SL R12,=A(DMKCQYEY-DMKCQY) SET BASE @V407490 00109000
- USING DMKCQY,R12 @V407490 00110000
- STM R0,R1,SAVER0 SAVE REG 0-1 IN NEW SAVE AREA. @V407490 00111000
- MVC SAVEWRK1(4),ZEROES ZERO FLAG AREA @V407490 00112000
- B GNVECTOR(R6) R6 CONTAINS INDEX INTO TABLE @V407490 00113000
- * INDEX SET BY CFCQU 00114000
- SPACE 00115000
- GNVECTOR EQU * @V407490 00116000
- B QRYTIME Q TIME @V407490 00117000
- B QRYLMSG Q LOGMSG @V407490 00118000
- B QRYNAME Q NAME @V407490 00119000
- B QRYUSER Q USERS @V407490 00120000
- B QRYPF Q PF @V407490 00121000
- B QRYSAS Q SASSIST @V407490 00122000
- B QRYCPA Q CPASSIST @V407490 00123000
- B QRYCPUID Q CPUID @V407490 00124000
- B QRYUSRID Q USERID HRC107DK 00124100
- SPACE 2 00125000
- QRYWRIT CALL DMKQCNWT,PARM=NORET SEND THE RESPONSE @V407490 00126000
- QRYEXIT EXIT RETURN TO CFM @V407490 00127000
- EJECT 00128000
- *. 00129000
- * QUERY LOGMSG 00130000
- * 00131000
- * COMMAND FORMAT 00132000
- * 00133000
- * +-----------+--------------+ 00134000
- * | QUERY | LOGMSG | 00135000
- * +-----------+--------------+ 00136000
- * 00137000
- * 1. GET EACH LINE OF THE LOGMSG AND CALL DMKQCNWT 00138000
- * 00139000
- * RESPONSE 00140000
- * 00141000
- * LOGMSG TEXT 00142000
- * * LOGMSG TEXT ... 00143000
- * .... 00144000
- * 00145000
- *. 00146000
- SPACE 2 00147000
- QRYLMSG L R4,=A(DMKSYSLG) LOAD ADDRESS OF LOGMSG START @V407490 00148000
- QRYLNXT L R4,0(,R4) LOAD NEXT LINE ADDRESS @V407490 00149000
- LTR R4,R4 ARE THERE ANY MORE LINES ? @V407490 00150000
- BZ QRYEXIT RETURN IF NO @V407490 00151000
- LH R0,4(,R4) LOAD MESSAGE LENGTH @V407490 00152000
- LA R1,8(,R4) LOAD MESSAGE ADDRESS @V407490 00153000
- CALL DMKQCNWT,PARM=NORET @V407490 00154000
- B QRYLNXT NO - CONTINUE @V407490 00155000
- EJECT 00156000
- *. 00157000
- * QUERY NAMES 00158000
- * 00159000
- * COMMAND FORMAT 00160000
- * 00161000
- * +----------+-------------+ 00162000
- * | QUERY | NAMES | 00163000
- * +----------+-------------+ 00164000
- * 00165000
- * 1. USE SUBROUTINE QRYUSRN TO FORMAT EACH USER FIELD 00166000
- * 2. PLACE FIELD IN BUFFER FOUR TO A LINE 00167000
- * 3. STACK BUFFER WHEN FULL 00168000
- * 4. REPEAT FOR ALL ACTIVE USERS 00169000
- * 00170000
- * RESPONSE 00171000
- * 00172000
- * USERID - ADR, . . . 00173000
- * ... , . . . 00174000
- * 00175000
- *. 00176000
- SPACE 2 00177000
- QRYNAME LA R0,8 LOAD BUFFER SIZE @V407490 00178000
- CALL DMKFREE GET A BUFFER FOR THE RESPONSE @V407490 00179000
- ST R1,SAVEWRK1 SAVE THE BUFFER ADDRESS @V407490 00180000
- L R10,VMPNT GET NEXT VMBLOK ADDRESS @V407490 00181000
- DROP R11 @V407490 00182000
- USING VMBLOK,R10 @V407490 00183000
- QRYNEWL LA R4,16 ADDRESS INCREMENT @V407490 00184000
- L R2,SAVEWRK1 BUFFER START @V407490 00185000
- LA R5,48(R2) SET BUFFER END ADDRESS @V407490 00186000
- LR R3,R2 POINT R3 TO START OF BUFFER @V407490 00187000
- QRYNEXT BAL R9,QRYUSRN FORMAT USERID AND HIS TERMINAL @V407490 00188000
- BXLE R3,R4,QRYCHKEN IF BUFFER NOT FULL GO CHECK FOR @V407490 00189000
- * LAST NAME 00190000
- B QRYMSGL IF FULL---GO SEND IT @V407490 00191000
- QRYCHKEN CR R10,R11 BACK AT START ????? @V407490 00192000
- BE QRYMSGL YES - GO SEND IT @V407490 00193000
- L R10,VMPNT LOAD NEXT VMBLOK ADDRESS @V407490 00194000
- B QRYNEXT GO BUILD NEXT NAME @V407490 00195000
- QRYMSGL LR R0,R3 LOAD CURRENT LINE END @V407490 00196000
- LA R1,2(,R2) LOAD FIRST CHARACTER ADDRESS @V407490 00197000
- SR R0,R1 COMPUTE THE LINE LENGTH @V407490 00198000
- BAL R3,STACK STACK LINE FOR OUTPUT @V407490 00199000
- CR R10,R11 IS THE QUERY COMPLETE ? @V407490 00200000
- BE NAMETERM BRANCH IF FINISHED @V407490 00201000
- L R10,VMPNT LOAD NEXT VMBLOK ADDRESS @V407490 00202000
- B QRYNEWL GO SET UP FOR NEXT LINE @V407490 00203000
- NAMETERM LA R0,8 LOAD BUFFER SIZE @V407490 00204000
- L R1,SAVEWRK1 LOAD BUFFER ADDRESS @V407490 00205000
- CALL DMKFRET RETURN THE BUFFER TO FREE STORAGE@V407490 00206000
- B QRYEXIT @V407490 00207000
- EJECT 00208000
- QRYUSRN MVC 0(2,R3),=C', ' SEPARATE NAMES WITH A COMMA @V407490 00209000
- MVC 2(8,R3),VMUSER MOVE USERID TO MESSAGE @V407490 00210000
- TM VMOSTAT,VMDISC IS THIS USER DISCONNECTED ? @V407490 00211000
- BO QRYDISC BRANCH IF YES @V407490 00212000
- ICM R8,B'1111',VMTERM ANYTHING IN VMTERM ? @VA08121 00213000
- BZ QRYDISC NO....STILL LOGGING ON @VA08121 00214000
- CLI RDEVTYPC-RDEVBLOK(R8),CLASSPEC 3705 NCP ? @V407490 00215000
- BE QRYUSRS YES - DIFFERENT @V407490 00216000
- CLI RDEVTYPC-RDEVBLOK(R8),CLASTERM IS CLASS TERMINAL@V407490 00217000
- BNE *+12 NO, BYPASS TEST FOR BISYNC LINE @V407490 00218000
- CLI RDEVTYPE-RDEVBLOK(R8),TYPBSC IS THIS A LINE @V407490 00219000
- BE QRYUSRS YES, GET RESOURCE ID. @V407490 00220000
- TM RDEVADD-RDEVBLOK(R8),RDEVLDEV Is this an LDEV? HRC065DK 00220100
- BO QRYLDEV Yes HRC065DK 00220200
- CALL DMKSCNRD GET REAL DEV ADDRESS @V407490 00221000
- CALL DMKCVTBH CONVERT IT TO PRINTABLE @V407490 00222000
- ST R1,12(,R3) STORE DEVICE ADDRESS IN MESSAGE @V407490 00223000
- MVC 10(3,R3),=C' - ' @V407490 00224000
- BR R9 RETURN @V407490 00225000
- SPACE 00226000
- QRYLDEV EQU * HRC065DK 00226100
- LH R1,RDEVADD-RDEVBLOK(,R8) Get the LDEV address HRC065DK 00226200
- N R1,F4095 Keep only the dev num HRC065DK 00226300
- CALL DMKCVTBH Make it displayable HRC065DK 00226400
- ST R1,12(,R3) Put dev addr in message HRC065DK 00226500
- MVC 10(3,R3),=C' -L' Move in LDEV indicator HRC065DK 00226600
- BR R9 Return HRC065DK 00226700
- * 00226800
- QRYDISC MVC 13(3,R3),=C'DSC' INDICATE USER IS DISCONNECTED @V407490 00227000
- MVC 10(3,R3),=C' - ' @V407490 00228000
- BR R9 RETURN @V407490 00229000
- SPACE 00230000
- QRYUSRS LH R1,VMTRMID 370X NCP RESOURCE IDENTIFIER @V407490 00231000
- CALL DMKCVTBH CONVERT FOR PRINTING @V407490 00232000
- MVC 10(3,R3),=C' - ' MOVE THIS IN FIRST @V407490 00233000
- ST R1,12(,R3) FORMAT IT AS "USERIDXX -10A3", ET@V407490 00234000
- BR R9 RETURN @V407490 00235000
- DROP R10 @V407490 00236000
- USING VMBLOK,R11 @V407490 00237000
- EJECT 00238000
- *. 00239000
- * ROUTINE TO STACK OUTPUT LINES ON VMBLOK 00240000
- * THE LINES WILL BE PRINTED BY DMKCFM ON RETURN 00241000
- *. 00242000
- STACK LR R4,R0 GET SIZE OF DATA @V407490 00243000
- LR R5,R1 SET DATA ADDRESS @V407490 00244000
- LA R0,7(R4) ROUND UP TO DOUBLE WORD @V407490 00245000
- SRL R0,3 GET SIZE IN DOUBLE WORDS @V407490 00246000
- A R0,F1 ONE MORE FOR CHAINING @V407490 00247000
- CALL DMKFREE GET BUFFER @V407490 00248000
- STH R4,4(R1) SAVE LINE SIZE @V407490 00249000
- STH R0,6(R1) SAVE BUFFER SIZE @V407490 00250000
- BCTR R4,R0 DECREMENT FOR EXECUTE @V407490 00251000
- EX R4,MVCSTK MOVE DATA TO STACK @V407490 00252000
- SR R0,R0 CLEAR @V407490 00253000
- ST R0,0(R1) CLEAR POINTER @V407490 00254000
- LA R2,VMSTKO GET OUTPUT STACK POINTER @V407490 00255000
- STKLOOP L R4,0(R2) GET POINTER TO STACK BUFFER @V407490 00256000
- LTR R4,R4 TEST FOR END OF CHAIN @V407490 00257000
- BZ CHAIN FOUND END, CHAIN THIS BUFFER @V407490 00258000
- LR R2,R4 POINT TO THIS BUFFER @V407490 00259000
- B STKLOOP LOOP TO FIND END @V407490 00260000
- CHAIN ST R1,0(R2) CHAIN AT END @V407490 00261000
- BR R3 RETURN @V407490 00262000
- * 00263000
- MVCSTK MVC 8(*-*,R1),0(R5) EXECUTED FOR STACK BUFFER MOVE @V407490 00264000
- EJECT 00265000
- *. 00266000
- * QUERY TIME 00267000
- * 00268000
- * COMMAND FORMAT 00269000
- * 00270000
- * +----------+------------+ 00271000
- * | QUERY | TIME | 00272000
- * +----------+------------+ 00273000
- * 00274000
- * 1. GET A BUFFER 00275000
- * 2. GET CURRENT DATE TIME ETC. 00276000
- * 3. WRITE TIME MESSAGE 00277000
- * 4. CALL DMKACOTM TO PRINT VIRT ACCOUNTING DATA 00278000
- * 00279000
- * RESPONSE 00280000
- * 00281000
- * TIME IS HH:MM:SS TMZ WEEKDAY MM/DD/YY 00282000
- * CONNECT HH:MM:SS VIRTIME MMM:SS.HH TOTTIME MMM:SS.HH 00283000
- * 00284000
- *. 00285000
- SPACE 2 00286000
- QRYTIME EQU * @V407490 00287000
- SPACE 00288000
- LA R0,5 SET UP TO GET 5 DOUBLE WORDS @V407490 00289000
- CALL DMKFREE GO GET THE STORAGE FOR THE MSG @V407490 00290000
- LR R9,R1 SAVE THE POINTER TO THE MSG @V407490 00291000
- MVC 0(8,R9),=C'TIME IS ' BUILD THE TIME MSG @V407490 00292000
- LA R2,8(,R9) POINT TO THE TIME FOR DMKCVTDT @V407490 00293000
- MVC 16(7,R9),BLANKS * BLANK OUT THE ZONE @V407490 00294000
- MVC 23(8,R9),BLANKS * AND THE WEEK DAY @V407490 00295000
- L R1,=A(DMKSYSTI) POINT TO THE TIME ZONE ID @V407490 00296000
- MVC 17(3,R9),0(R1) AND MOVE IT INTO THE MSG @V407490 00297000
- L R1,=A(DMKSYSDW) POINT TO THE WEEK DAY IN SYSLOCS@V407490 00298000
- MVC 21(10,R9),2(R1) AND MOVE IT INTO THE MSG ALSO @V407490 00299000
- SR R3,R3 ZERO @V407490 00300000
- IC R3,1(,R1) GET THE LENGTH OF THE WEEK DAY @V407490 00301000
- LA R1,23(R3,R9) LET DMKCVTDT FILL IN THE DATE @V407490 00302000
- CALL DMKCVTDT CONVERT DATE AND TIME @V407490 00303000
- SPACE 00304000
- LA R0,8(,R1) * SET UP THE LENGTH OF THE MSG@V407490 00305000
- SR R0,R9 * @V407490 00306000
- LR R1,R9 POINT TO THE MSG BUFFER @V407490 00307000
- LA R2,DFRET+NORET SET UP THE PARMS FOR DMKCQNWT @V407490 00308000
- LA R3,5 RETURN 5 DOUBLE WORDS OF FREE @V407490 00309000
- CALL DMKQCNWT GO PRINT THE TIME MSG @V407490 00310000
- SPACE 00311000
- CALL DMKACOTM CALL TO PRINT THE CONNECT TIME @V407490 00312000
- B QRYEXIT @V407490 00313000
- EJECT 00314000
- MOVETO EQU * @V407490 00315000
- *. 00316000
- * 00317000
- * QUERY USERS 00318000
- * 00319000
- * COMMAND FORMAT 00320000
- * 00321000
- * +---------+----------------+ 00322000
- * | QUERY | USERS (USERID)| 00323000
- * +---------+----------------+ 00324000
- * 00325000
- * 1. CALL DMKSCNFD FOR USERID PARM IF ANY 00326000
- * 2. FORMAT USER AND DIALED RESPONSE 00327000
- * 3. WRITE RESPONSE 00328000
- * 00329000
- * RESPONSE 00330000
- * 00331000
- * USERS NNN, DIALED NNN 00332000
- * 00333000
- *. 00334000
- SPACE 2 00335000
- QRYUSER MVC SAVEWRK2(8),BLANKS CLEAR MSG AREA @V407490 00336000
- MVC SAVEWRK4(12),SAVEWRK2 . . @V407490 00337000
- CALL DMKSCNFD SEE IF USERID SPECIFIED @V407490 00338000
- BZ SAVEUSR USERID FOUND @V407490 00339000
- MVC SAVEWRK2+15(6),=C'DIALED' @V407490 00340000
- L R1,=A(DMKSYSND) NO OF USERS DIALED TO SYSTEM @V407490 00341000
- L R1,0(,R1) LOAD NUMBER OF USERS @V407490 00342000
- CALL DMKCVTBD CONVERT COUNT TO PRINTABLE @V407490 00343000
- STCM R1,7,SAVEWRK2+11 STORE IN MESSAGE. @V407490 00344000
- L R1,=A(DMKSYSNM) NO OF USERS CURRENTLY LOGGED ON @V407490 00345000
- QRYCNVT MVC SAVEWRK2+4(6),=C'USERS,' @V407490 00346000
- L R1,0(,R1) LOAD NUMBER OF USERS @V407490 00347000
- CALL DMKCVTBD CONVERT COUNT TO PRINTABLE @V407490 00348000
- STCM R1,7,SAVEWRK2 STORE IN MESSAGE @V407490 00349000
- LA R0,21 LOAD MESSAGE LENGTH @V407490 00350000
- LA R1,SAVEWRK2 LOAD MESSAGE ADDRESS @V407490 00351000
- B QRYWRIT SEND THE RESPONSE AND EXIT @V407490 00352000
- SPACE 00353000
- SAVEUSR STM R0,R1,SAVER0 SAVE LENGTH AND ADDRESS @V407490 00354000
- CL R0,F8 USERID OVER 8 CHARACTERS ???? @V407490 00355000
- BH CQY020 SEND ERROR MESSAGE IF IT IS @V407490 00356000
- CALL DMKSCNAU FIND ACTIVE USER @V407490 00357000
- BNZ CQY045 NOT LOGGED ON @V407490 00358000
- LR R10,R1 SET R10 TO VMBLOK @V407490 00359000
- LA R3,SAVEWRK2 SET BUFFER ADDRESS @V407490 00360000
- BAL R9,QRYUSRN GET USERID AND TERMINAL @V407490 00361000
- LA R1,SAVEWRK2+2 WRITE DATA ADDRESS @V407490 00362000
- LA R0,14 DATA SIZE @V407490 00363000
- B QRYWRIT WRITE IT @V407490 00364000
- SPACE 2 00365000
- EJECT 00366000
- *. 00367000
- * 00368000
- * QUERY PFNN 00369000
- * 00370000
- * COMMAND FORMAT 00371000
- * 00372000
- * +-----------+-------------+ 00373000
- * | QUERY | PF<NN> | 00374000
- * +-----------+-------------+ 00375000
- * 00376000
- * 1. IF FUNCTION NUMBER ENTERED, CONVERT IT TO BINARY. 00377000
- * 2. GET BUFFER FOR RESPONSE 00378000
- * 3. GET AND FORMAT PF DATA 00379000
- * 3.1. IF PF DATA INDICATES TAB, CONVERT BINARY DATA TO EBCDIC 00380000
- * 4. OUTPUT RESPONSE WITH STACK 00381000
- * 5. REPEAT FOR ALL 24 PF IF ALL REQUEST HRC029DK 00382490
- * 6. FRET BUFFER AND RETURN 00383000
- * 00384000
- * RESPONSE 00385000
- * 00386000
- * PFNN IMMED PFDATA ........... 00387000
- * DELAY 00388000
- * 00389000
- * PFNN NOT DEFINED 00390000
- * 00391000
- *. 00392000
- SPACE 00393000
- QRYPF MVI SAVEWRK1,X'00' CLEAR FLAG @V407490 00394000
- CL R0,F2 IS IT JUST PF ?? @V407490 00395000
- BE PFALL YES, DO ALL @V407490 00396000
- LA R1,2(R1) POINT AT NUMBER @V407490 00397000
- S R0,F2 SIZE FOR CONVERT @V407490 00398000
- CALL DMKCVTDB CONVERT TO BINARY @V407490 00399000
- BNZ CQY026 ERROR @V407490 00400000
- LR R8,R1 SAVE CONVERTED NUMBER @V407490 00401000
- PFREE LA R0,36 SIZE FOR BUFFER HRC029DK 00402490
- CALL DMKFREE GET BUFFER @V407490 00403000
- LR R7,R1 BUFFER ADDRESSING @V407490 00404000
- PFNXT MVI 0(R7),C' ' CLEAR BUFFER TO BLANKS @V407490 00405000
- MVC 1(143,R7),0(R7) ... @V407490 00406000
- LR R1,R8 GET FUNC NUMBER @V407490 00407000
- CALL DMKCVTBD CONVERT TO DEC @V407490 00408000
- STH R1,2(R7) SET FUNC NUMBER @V407490 00409000
- MVC 0(2,R7),=C'PF' DATA @V407490 00410000
- L R6,VMPFUNC GET USER FUNC TABLE @V407490 00411000
- LTR R6,R6 IS THERE ONE ?? @V407490 00412000
- BZ NOPF NO @V407490 00413000
- LR R2,R8 FUNC NUMBER TO GET @V407490 00414000
- BCTR R2,R0 LESS 1 FOR INDEX @V407490 00415000
- SLL R2,3 TIMES 8 FOR INDEX @V407490 00416000
- AR R6,R2 POINT TO TABLE ENTRY @V407490 00417000
- L R2,4(R6) GET FUNC DATA @V407490 00418000
- LTR R2,R2 IS THERE ONE ?? @V407490 00419000
- BZ NOPF NO @V407490 00420000
- LH R3,2(R6) GET FUNC DATA SIZE @V407490 00421000
- CH R3,=H'130' MAX WE CAN HANDLE @V407490 00422000
- BL *+8 OK @V407490 00423000
- LA R3,130 SET TO MAX @V407490 00424000
- LA R4,11(R7) DATA START @V407490 00425000
- LR R5,R3 DATA COUNT @V60A6B6 00426000
- CL R5,F4 COUNT LARGE ENOUGH FOR TAB? @V60A6B6 00427000
- BL PFMOVE NO, SKIP CHECK FOR IT @V60A6B6 00428000
- CLC 0(4,R2),=C'TAB ' IS IT TAB FUNCTION ? @V60A6B6 00429000
- BE PFTAB YES, MUST CONVERT DATA. @V60A6B6 00430000
- PFMOVE BCTR R3,R0 LESS 1 FOR EXECUTE @V60A6B6 00431000
- EX R3,MVCPFD MOVE DATA TO BUFFER @V60A6B6 00432000
- PFSC CLI 0(R4),X'15' IS IT A LCR ?? @V407490 00433000
- BNE PFSC1 NO, CONT @V407490 00434000
- IC R0,VMTLEND LOGICAL LINE END SYMBOL @V407490 00435000
- STC R0,0(R4) SET CHAR @V407490 00436000
- PFSC1 LA R4,1(R4) NEXT CHAR @V407490 00437000
- BCT R5,PFSC SCAN FOR ALL @V407490 00438000
- PFIMMED MVC 5(5,R7),=CL5'IMMED' ASSUME IMMED EXECUTION @V60A6B6 00439000
- TM 0(R6),X'80' IS IT IMMED ?? @V407490 00440000
- BO PFWRT YES @V407490 00441000
- MVC 5(5,R7),=CL5'DELAY' SET DELAY EXECUTION @V407490 00442000
- PFWRT LA R0,144 SET MAX COUNT @V407490 00443000
- PFWRTN LR R1,R7 DATA START @V407490 00444000
- BAL R3,STACK STACK RESPONSE @V407490 00445000
- PFTST TM SAVEWRK1,X'80' DO ALL ?? @V407490 00446000
- BZ PFEXIT NO, DONE @V407490 00447000
- CH R8,=H'24' ALL DONE NOW ?? HRC029DK 00448490
- BE PFEXIT YES @V407490 00449000
- LA R8,1(R8) NEXT FUNC @V407490 00450000
- B PFNXT DO IT @V407490 00451000
- SPACE 00452000
- NOPF MVC 5(11,R7),=CL11'UNDEFINED ' NO FUNC @V407490 00453000
- LA R0,20 SIZE @V407490 00454000
- B PFWRTN STACK IT @V407490 00455000
- SPACE 00456000
- PFEXIT LR R1,R7 BUFFER ADDRESS @V407490 00457000
- LA R0,36 SIZE HRC029DK 00458490
- CALL DMKFRET FRET @V407490 00459000
- B QRYEXIT @V407490 00460000
- SPACE 00461000
- PFALL MVI SAVEWRK1,X'80' FLAG TO DO ALL @V407490 00462000
- LA R8,1 START WITH FUNC 1 @V407490 00463000
- B PFREE GET BUFFER @V407490 00464000
- EJECT 00465000
- PFTAB MVC 0(4,R4),0(R2) MOVE TAB HEADER INTO OUTPUT @V60A6B6 00466000
- MVI 4(R4),XF1 INITIALIZE FIRST TAB POSITION @V60A6B6 00467000
- S R5,F4 DECREMENT COUNT BY HEADER SIZE @V60A6B6 00468000
- BNP PFIMMED IF NO TAB DATA, THEN ALL DONE @V60A6B6 00469000
- LA R2,4(,R2) POINT TO START OF TAB DATA @V60A6B6 00470000
- LA R4,6(,R4) POINT TO NEXT CHAR. POSITION @V60A6B6 00471000
- PFTABCVT SLR R1,R1 CLEAR TAB DATA REGISTER @V60A6B6 00472000
- IC R1,0(,R2) GET THE NEXT BYTE OF TAB DATA @V60A6B6 00473000
- LA R1,1(,R1) CHANGE ORIGIN FROM ZERO TO ONE @V60A6B6 00474000
- CALL DMKCVTBD GO CONVERT IT TO DECIMAL 00475000
- CLI 0(R2),D9 TAB GREATER THAN ONE DIGIT ? @V60A6B6 00476000
- BL PFTABONE NO, GO MOVE IN ONLY ONE CHAR. @V60A6B6 00477000
- CLI 0(R2),D99 TAB LARGER THAN TWO DIGITS ? @V60A6B6 00478000
- BL PFTABTWO NO, GO MOVE IN THE TWO CHARS. @V60A6B6 00479000
- STCM R1,B'0111',0(R4) MOVE IN THREE CHARACTERS @V60A6B6 00480000
- LA R4,4(,R4) ADDRESS NEXT CHAR. POSITION @V60A6B6 00481000
- B PFTABCT AND GO CHECK FOR MORE @V60A6B6 00482000
- SPACE 00483000
- PFTABTWO STCM R1,B'0011',0(R4) PUT IN THE TWO CHARACTERS @V60A6B6 00484000
- LA R4,3(,R4) ADDRESS NEW CHAR. POSITION @V60A6B6 00485000
- B PFTABCT AND CHECK FOR MORE @V60A6B6 00486000
- SPACE 00487000
- PFTABONE STC R1,0(,R4) PUT EBCDIC CHAR. IN OUTPUT LINE @V60A6B6 00488000
- LA R4,2(,R4) POINT TO NEXT PLACE IN LINE @V60A6B6 00489000
- PFTABCT LA R2,1(,R2) INCREMENT CURRENT TAB DATA ADDR @V60A6B6 00490000
- BCT R5,PFTABCVT DO UNTIL ALL TABS ARE CONVERTED @V60A6B6 00491000
- B PFIMMED CHECK IMMED/DELAY; STACK OUTPUT @V60A6B6 00492000
- SPACE 2 00493000
- D9 EQU 9 @V60A6B6 00494000
- D99 EQU 99 @V60A6B6 00495000
- XF1 EQU X'F1' @V60A6B6 00496000
- SPACE 00497000
- MVCPFD MVC 11(*-*,R7),0(R2) EXECUTED FOR DATA @V407490 00498000
- EJECT 00499000
- *. 00500000
- * QUERY SASSIST 00501000
- * 00502000
- * COMMAND FORMAT 00503000
- * +--------+-------------+ 00504000
- * | QUERY | SASSIST | 00505000
- * +--------+-------------+ 00506000
- * 00507000
- * 1. FORMAT RESPONSE. 00508000
- * 2. WRITE RESPONSE. 00509000
- * 00510000
- * 00511000
- * RESPONSE 00512000
- * 00513000
- * SASSIST ON|OFF (PROC XX, ON|OFF PROC YY) 00514000
- * 00515000
- * 00516000
- *. 00517000
- QRYSAS MVC SAVEWRK2(11),=C'SASSIST ON ' @V407490 00518000
- TM CPSTAT2,CPMICON IS VM ASSIST ON? @V407490 00519000
- BO ASSTON YES, BRANCH @V407490 00520000
- MVC SAVEWRK2+8(3),=C'OFF' NO, PUT 'OFF' IN MSG @V407490 00521000
- ASSTON EQU * @V4075A0 00522000
- TM APSTAT1,APUOPER DO WE HAVE ANOTHER PROCESSOR? @V4075A0 00523000
- BO SASAP YES, MORE MESSAGE CONTENT @V4075A0 00524000
- LA R0,11 MESSAGE LENGTH @V4075A0 00525000
- SASMSG LA R1,SAVEWRK2 MESSAGE LOC @V4075A0 00526000
- B QRYWRIT SEND THE RESPONSE AND EXIT @V407490 00527000
- SPACE 2 @V4075A0 00528000
- SASAP EQU * @V4075A0 00529000
- MVC SAVEWRK4+3(19),=C' PROC , ON PROC ' @V4075A0 00530000
- LH R1,IPUADDR PUT IN OUR PROC ADDR @V4075A0 00531000
- CALL DMKCVTBD @V4075A0 00532000
- STCM R1,B'0011',SAVEWRK6+1 @V4075A0 00533000
- LH R1,IPUADDRX PUT IN OTHER PROC ADDR @V4075A0 00534000
- CALL DMKCVTBD @V4075A0 00535000
- STCM R1,B'0011',SAVEWRK9+2 @V4075A0 00536000
- L R1,PREFIXB NOW LET'S INSPECT OTHER PROC @V4075A0 00537000
- TM CPSTAT2-PSA(R1),CPMICON DOES IT HAVE VM ASSIST @V4075A0 00538000
- BO SASLN @V4075A0 00539000
- MVC SAVEWRK7+1(3),=C'OFF' TELL THEM NO @V4075A0 00540000
- SASLN LA R0,32 OUTPUT EXPANDED MESSAGE @V4075A0 00541000
- B SASMSG @V4075A0 00542000
- EJECT 00543000
- *. 00544000
- * QUERY CPASSIST 00545000
- * 00546000
- * COMMAND FORMAT 00547000
- * +--------+-------------+ 00548000
- * | QUERY | CPASSIST | 00549000
- * +--------+-------------+ 00550000
- * 00551000
- * 1. FORMAT RESPONSE. 00552000
- * 2. WRITE RESPONSE. 00553000
- * 00554000
- * 00555000
- * RESPONSE 00556000
- * 00557000
- * CPASSIST ON|OFF (PROC XX ON|OFF PROC YY) 00558100
- * 00559000
- * 00560000
- *. 00561000
- QRYCPA MVC SAVEWRK2(12),=C'CPASSIST ON ' SET UP RESPONSE @V407490 00562000
- TM CPSTAT2,CPASTON IS IT REALLY "ON" ? @V407490 00563000
- BO CPAMSGOK DON'T DO IT. @V407490 00564000
- MVC SAVEWRK2+9(3),=C'OFF' REFORMAT RESPONSE @V407490 00565000
- CPAMSGOK EQU * @V5DAACD 00566100
- TM APSTAT1,APUOPER DO WE HAVE ANOTHER PROCESSOR? @V5DAACD 00566200
- BO CPAAP YES --- @V5DAACD 00566300
- LA R0,12 NO MSG LNG OF 12 @V5DAACD 00566400
- CPAMSG EQU * @V5DAACD 00566500
- LA R1,SAVEWRK2 AND ITS ADDRESS @V407490 00567000
- B QRYWRIT WRITE THE RESPONSE AND EXIT @V407490 00568000
- CPAAP EQU * CHECK BOTH PROCESSORS @V5DAACD 00568020
- MVC SAVEWRK5(19),=C' PROC ON PROC ' @V5DAACD 00568040
- LH R1,IPUADDR GET OUR PROC ADDRESS @V5DAACD 00568060
- CALL DMKCVTBD @V5DAACD 00568080
- STCM R1,B'0011',SAVEWRK6+2 @V5DAACD 00568100
- LH R1,IPUADDRX GET THE OTHER PROC ADDR. @V5DAACD 00568120
- CALL DMKCVTBD @V5DAACD 00568140
- STCM R1,B'0011',SAVEWRK9+2 @V5DAACD 00568160
- L R1,PREFIXB CHECK FOR ON/OFF OF OTHER PROC. @V5DAACD 00568180
- TM CPSTAT2-PSA(R1),CPASTON @V5DAACD 00568200
- BO CPALN YES ITS ON @V5DAACD 00568220
- MVC SAVEWRK7+1(3),=C'OFF' @V5DAACD 00568240
- CPALN EQU * @V5DAACD 00568260
- LA R0,32 SET MSG LNG TO 32 @V5DAACD 00568280
- B CPAMSG AND GO ISSUE MSG. @V5DAACD 00568300
- EJECT 00569000
- *. 00570000
- * QUERY CPUID 00571000
- * 00572000
- * COMMAND FORMAT 00573000
- * 00574000
- * +------------------------+ 00575000
- * | QUERY | CPUID | 00576000
- * +-----------+------------+ 00577000
- * 00578000
- * 1. FORMAT RESPONSE 00579000
- * 2. WRITE RESPONSE 00580000
- * 00581000
- * RESPONSE: 00582000
- * 00583000
- * CPUID = AABBBBBBCCCCDDDD 00584000
- * 00585000
- *. 00586000
- SPACE 00587000
- QRYCPUID EQU * @V407490 00588000
- MVC SAVEWRK2(L'CPUMSG),CPUMSG 'CPUID = FF' @V407490 00589000
- SLR R1,R1 CLEAR R1 @V407490 00590000
- ICM R1,B'0111',VMCPUID CPUID SERIAL FROM VMBLOK @V407490 00591000
- CALL DMKCVTBH CONVERT TO PRINTABLE HEXADECIMAL @V407490 00592000
- STCM R0,B'0011',SAVEWRK4+2 STORE 1ST PART OF SERIAL @V407490 00593000
- STCM R1,B'1111',SAVEWRK5 SEC. HALF CPU SERIAL @V407490 00594000
- SLR R1,R1 CLEAR R1 AGAIN @V407490 00595000
- ICM R1,B'0011',CPUID+4 MODEL NUMBER FROM PSA @V407490 00596000
- CALL DMKCVTBH CONVERT TO PRINTABLE HEXADECIMAL @V407490 00597000
- ST R1,SAVEWRK6 STORE MODEL IN RESPONSE @V407490 00598000
- MVC SAVEWRK7,=C'0000' MACHINE CHECK EXT. LOGOUT @V407490 00599000
- LA R1,SAVEWRK2 POINT TO MSG BUFFER @V407490 00600000
- LA R0,LCPUMSG LENGTH OF MESSAGE @V407490 00601000
- B QRYWRIT ISSUE RESPONSE AND EXIT @V407490 00602000
- EJECT 00603000
- CPUMSG DC C'CPUID = FF' @V407490 00604000
- LCPUMSG EQU 24 MESSAGE LENGTH @V407490 00605000
- SPACE 1 00606000
- CQY020 LA R2,20 ERROR CODE @V407490 00607000
- B NOPARM ERROR MESSAGE @V407490 00608000
- SPACE 00609000
- CQY026 LA R2,26 ERROR CODE @V407490 00610000
- B NOPARM ERROR MESSAGE @V407490 00611000
- SPACE 00612000
- CQY045 LA R2,45 ERROR CODE @V407490 00613000
- LM R0,R1,SAVER0 GET PARMS @V407490 00614000
- B CALLERM ERROR MESSAGE @V407490 00615000
- SPACE 00616000
- NOPARM SR R1,R1 NO ERROR PARMS @V407490 00617000
- CALLERM ICM R0,14,MODID+3 GET MODULE ID @V407490 00618000
- CALL DMKERMSG WRITE ERROR MESSAGE @V407490 00619000
- SPACE 00620000
- * DMKERMSG WILL EXIT AND NOT RETURN HERE .... 00621000
- * 00622000
- *. HRC107DK 00622010
- * QUERY USERID HRC107DK 00622020
- * HRC107DK 00622030
- * Command format HRC107DK 00622040
- * HRC107DK 00622050
- * +------------------------+ HRC107DK 00622060
- * X QUERY X USERID X HRC107DK 00622070
- * +-----------+------------+ HRC107DK 00622080
- * HRC107DK 00622090
- * 1. Format response HRC107DK 00622100
- * 2. Write response HRC107DK 00622110
- * HRC107DK 00622120
- * Response: HRC107DK 00622130
- * HRC107DK 00622140
- * USERID [AT SYSID] HRC108DK 00622155
- * HRC107DK 00622160
- *. HRC107DK 00622170
- SPACE 00622180
- QRYUSRID EQU * HRC107DK 00622190
- MVC SAVEWRK2(8),VMUSER Copy userid from VMBLOK HRC108DK 00622201
- LA R1,SAVEWRK2 Get address of response HRC108DK 00622211
- LA R0,8 Get length of just userid HRC108DK 00622221
- L R7,=A(DMKSYSID) Get address of SYSID HRC108DK 00622231
- CLC 0(8,R7),=CL8' ' Check for blank SYSID HRC108DK 00622241
- BE QRYWRIT Return just userid & exit HRC108DK 00622251
- LA R3,1(R1) Start at userid + 1 HRC108DK 00622261
- LA R4,1 Specify increment as 1 HRC108DK 00622271
- LA R5,7(R1) Finish at userid + 7 HRC108DK 00622281
- USRLOOP EQU * HRC108DK 00622291
- CLI 0(R3),C' ' Check for short userid HRC108DK 00622301
- BE USRIDEND Found short userid? HRC108DK 00622311
- BXLE R3,R4,USRLOOP Got to end of userid? HRC108DK 00622321
- USRIDEND EQU * HRC108DK 00622331
- MVC 0(4,R3),=C' AT ' Copy constant separator in HRC108DK 00622341
- MVC 4(8,R3),0(R7) Copy SYSID into response HRC108DK 00622351
- SR R3,R1 Get length of userid HRC108DK 00622361
- LA R0,12(R3) Add SYSID & const length HRC108DK 00622371
- B QRYWRIT Send the response and exit HRC108DK 00622381
- SPACE 1 HRC108DK 00622391
- LTORG @V407490 00623000
- SPACE 00624000
- EJECT 00625000
- PSA , @V407490 00626000
- COPY DEVTYPES @V407490 00627000
- COPY EQU @V407490 00628000
- COPY RBLOKS @V407490 00629000
- COPY SAVE @V407490 00630000
- COPY VMBLOK @V407490 00631000
- END DMKCQY 00632000
ibm/vm370-lib/cp/dmkcqy.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator