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 | 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