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