CQR TITLE 'DMKCQR (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMKCQR 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* TO HANDLE QUERY FUNCTIONS: FILES, SET, DUMP, PAGING, 00010000
* HOLD, PRIORITY, TERMINAL, AFFINITY,..... @V4075A0 00011000
* 00012000
* ATTRIBUTES - 00013000
* 00014000
* RE-ENTERABLE, PAGEABLE, CALLED VIA SVC 8 00015000
* 00016000
* ENTRY POINTS - 00017000
* 00018000
* DMKCQREY - MAIN ENTRY POINT FROM DMKCFC 00019000
* DMKCQRFI - TO GIVE MESSAGE FOR NUMBER OF SPOOL FILES 00020000
* DMKCQRWS - SAVE AREA FOR THE PAGE WAIT TIME FOR THE ATTACHED 00020100
* PROCESSOR 00020200
* 00021000
* ENTRY CONDITIONS - 00022000
* 00023000
* R9 - ADDRESS OF COMMAND LINE BUFFER 00024000
* R11- ADDRESS OF VMBLOK 00025000
* R12- BASE ADDRESS OF MODULE 00026000
* R13- ADDRESS OF SAVEAREA 00027000
* 00028000
* EXIT CONDITIONS - 00029000
* 00030000
* NORMAL - R2 = 0 00031000
* ERROR - R2 = ERROR MESSAGE NUMBER 00032000
* 00033000
* CALLS TO OTHER ROUTINES - 00034000
* 00035000
* DMKSCNFD - TO GET FIELDS FROM COMMAND BUFFER 00036000
* DMKCVTBD - TO CONVERT BINARY TO DECIMAL 00037000
* DMKCVTBH - TO CONVERT BINARY TO HEX 00038000
* DMKSCNAU - TO SCAN FOR ACTIVE USER 00039000
* DMKSCNRD - TO GET REAL DEVICE NAME 00040000
* DMKSCNRU - TO FIND THE REAL BLOCKS FOR A CCU 00041000
* DMKERMSG - TO ISSUE ERROR MESSAGES 00042000
* 00043000
* EXTERNAL REFERENCES 00044000
* 00045000
* DMKDMPDV - DUMP DEVICE 00046000
* DMKDMPSW - DUMP INDICATOR 00047000
* DMKRSPRD - READER SPOOL FILE CHAIN 00048000
* DMKRSPPR - PRINTER SPOOL FILE CHAIN 00049000
* DMKRSPPU - PUNCH SPOOL FILE CHAIN 00050000
* DMKRSPHQ - HOLD USER CHAIN 00051000
* DMKRIOPR - SYSTEM PRINTER ADDRESS 00052000
* DMKPAGQR - PAGE I/O SINCE LAST QUERY COMMAND 00053000
* DMKSCHPG - SYSTEM PAGING DATA 00054000
* 00055000
* TABLES/WORKAREAS 00056000
* 00057000
* SAVEAREA WORK AREAS USED FOR SCRATCH DATA 00058000
* BRANCH TABLE FOR FUNCTION AT GNVECTOR 00059000
* INDEX INTO TABLE BY R6 SET IN DMKCFC 00060000
* 00061000
* REGISTER USAGE 00062000
* 00063000
* R0 - LENGTH OF FIELD 00064000
* R1 - ADDRESS OF FIELDS 00065000
* R2 - PARM PASSING 00066000
* R3 - STACK LINKAGE 00067000
* R4 - R9 WORK REGISTERS FOR BUFFERS AND DSECTS 00068000
* R10 - VMBLOK FOR SEARCHES 00069000
* R11 - VMBLOK OF CALLER 00070000
* R12 - BASE OF MODULE 00071000
* R13 - SAVEAREA 00072000
* R14 R15 - LINKAGE REGISTERS 00073000
* 00074000
* NOTES - 00075000
* 00076000
* NONE 00077000
* 00078000
* OPERATION - 00079000
* 00080000
* THE QUERY FUNCTIONS ARE ENTERED BY A BRANCH TABLE INDEX 00081000
* THAT IS SET UP BY THE CALLING MODULE DMKCFC 00082000
* THE FUNCTIONS ARE SEPARATE AND RETURN TO THE CALLER 00083000
* EACH FUNCTION IS DESCRIBED AT THE SECTION 00084000
* 00085000
* 00086000
* ERROR MESSAGES 00087000
* 00088000
* DMKCQR020E USERID MISSING OR INVALID 00089000
* DMKCQR026E OPERAND MISSING OR INVALID 00090000
* DMKCQR028E CLASS MISSING OR INVALID 00091000
* DMKCQR045E $USERID$ NOT LOGGED ON 00092000
* 00093000
*********************************************************************** 00094000
EJECT 00095000
DMKCQR START 0 @V200930 00096000
USING PSA,R0 @V200930 00097000
USING VMBLOK,R11 @V200930 00098000
USING SAVEAREA,R13 @V200930 00099000
EXTRN DMKSCNFD,DMKCVTBD,DMKCVTBH @V200930 00100000
EXTRN DMKSCNAU @V407490 00101000
EXTRN DMKPAGQR @VA08859 00102000
EXTRN DMKSCNRU @V407438 00103000
EXTRN DMKSCNRD @V407490 00104000
EXTRN DMKDMPDV,DMKRSPPR,DMKRSPPU @V200930 00105000
EXTRN DMKRSPRD,DMKRSPHQ,DMKERMSG @V200930 00106000
EXTRN DMKDMPSW,DMKRIOPR,DMKSCHPG @V200930 00107000
EXTRN DMKCVTAB @VA04301 00108000
SPACE 00109000
ENTRY DMKCQREY @V200930 00110000
ENTRY DMKCQRWS @VMH0012 00110100
EJECT 00111000
* THIS ROUTINE IS CALLED BY DMKCFCQU. SINCE THERE IS NO NEED 00112000
* TO RETURN TO DMKCFCQU, THE SAVEAREA POINTED TO BY REG 13 00113000
* WILL BE RELEASED. THUS, WHEN THIS ROUTINE RETURNS IT WIL 00114000
* GO DIRECTLY BACK TO CFM TO SCAN FOR THE NEXT COMMAND. 00115000
* UPON ENTRY GPR6 HAS BEEN SET UP BY CFCQU TO INDEX INTO THE 00116000
* LIST OF BRANCHES ACCORDING TO ARGUMENT FOUND,THEREFORE THE 00117000
* ORDER OF BRANCHES MUST BE THE SAME AS THE LIST IN CFCQU. 00118000
SPACE 2 00119000
MODID DC CL8'DMKCQR' @V200930 00120000
USING *,R12 @V200930 00121000
DMKCQREY SVC 16 GIVE UP SAVEAREA @V200930 00122000
SL R12,=A(DMKCQREY-DMKCQR) SET BASE @V200930 00123000
USING DMKCQR,R12 @V200930 00124000
STM R0,R1,SAVER0 SAVE REG 0-1 IN NEW SAVE AREA. @V200930 00125000
MVC SAVEWRK1(4),ZEROES ZERO FLAG AREA @V200930 00126000
B GNVECTOR(R6) R6 CONTAINS INDEX INTO TABLE @V200930 00127000
* INDEX SET BY CFCQU 00128000
SPACE 00129000
GNVECTOR EQU * @V200930 00130000
B QRYFILE Q FILES @V200930 00131000
B QRYSET Q SET @V200930 00132000
B QRYDUMP Q DUMP @V200930 00133000
B QRYPAGE Q PAGING @V200930 00134000
B QRYHOLD Q HOLD @V200930 00135000
B QRYPRIOR Q PRIORITY @V200930 00136000
B QRYTERM Q TERMINAL @V200930 00137000
B QRYAFF AFFINITY @V4075A0 00138000
SPACE 2 00139000
QRYWRIT CALL DMKQCNWT,PARM=NORET SEND THE RESPONSE @V200930 00140000
QRYEXIT EXIT RETURN TO CFM @V200930 00141000
EJECT 00142000
*. 00143000
* QUERY FILES 00144000
* 00145000
* COMMAND FORMAT 00146000
* 00147000
* +----------+--------------------------------+ 00148000
* | QUERY | FILES (CLASS A) (USERID) | 00149000
* +----------+--------------------------------+ 00150000
* 00151000
* 00152000
* 1. CALL DMKSCNFD TO GET OPTIONAL FIELDS CLASS OR USERID 00153000
* 2. VALIDATE THE FIELD IF PRESENT AND SETUP FOR 00154000
* SCAN BY CLASS OR USERID OR BOTH 00155000
* 3. SCAN READER, PRINTER AND PUNCH CHAINS AND COUNT 00156000
* FILES BY CLASS OR USERID OR BOTH 00157000
* 4. FORMAT RESPONSE AND STACK OR RETURN RESPONSE 00158000
* 5. RETURN TO CALLER 00159000
* 00160000
* RESPONSE 00161000
* 00162000
* FILES: NNN RDR, NNN PRT, NNN PUN 00163000
* 00164000
*. 00165000
SPACE 2 00166000
DMKCQRFI RELOC QUERY NUMBER OF RDR, PRT, AND PUN FILES@V200930 00167000
MVI SAVEWRK1+1,X'00' CLEAR CLASS FLAG @V200930 00168000
MVI SAVEWRK1,X'80' INITIALIZE TO CALL ENTRY @VA05491 00169000
LTR R2,R2 CALL FROM DMKCPI OR DMKLOG @VM08732 00170000
BZ *+8 ZERO - (DMKCPI) QUERY ALL FILES @VM08732 00171000
OI SAVEWRK1,X'40' QUERY USERS OWN FILES (DMKLOG) @VM08732 00172000
QRYFILE DS 0H @V200930 00173000
SR R4,R4 ZERO TOTAL COUNT @V200930 00174000
LA R5,1 LOAD INCREMENT REGISTER @V200930 00175000
MVC SAVEWRK2(8),VMUSER SET USERID TO SEARCH @V200930 00176000
TM SAVEWRK1,X'C0' CALL ENTRY FROM LOG? @VA02254 00177000
BO SETCHK GO DO THIS USER @VA02254 00178000
TM SAVEWRK1,X'80' CALL ENTRY FROM CPI? @VA02254 00179000
BO SETALL GO DO ALL OF THEM @VA02254 00180000
CALL DMKSCNFD FIND A FIELD @VA02254 00181000
BZ CKPARMS GO CHECK IT @VA02254 00182000
TSTD TM VMCLEVEL,VMCLASSD CLASS D USER? @VA02254 00183000
BO SETALL YES, DO ALL USERS @VA02254 00184000
B SETCHK JUST DO HIS @VA02254 00185000
CKPARMS EQU * @VA02254 00186000
LR R3,R0 GET SIZE @VA02307 00187000
BCTR R3,R0 LESS ONE FOR EXECUTE @VA02307 00188000
CL R0,F2 IS IT LESS THAN 2 ?? @V200930 00189000
BL CKSTAR1 NOT CLASS, TEST FOR CLASS D @VA02254 00190000
B CKCLASS GO TEST CLASS @VA02254 00191000
CKSTAR1 TM VMCLEVEL,VMCLASSD CLASS D USER? @VA02254 00192000
BO CKSTAR YES, CHECK FOR SELF @VA02254 00193000
B CQR020 INVALID USERID @VA02254 00194000
CKCLASS EQU * @VA02254 00195000
EX R3,CLCLS TEST FOR CLASS @V200930 00196000
BNE TSTD1 NO, TEST FOR CLASS D @V200930 00197000
CALL DMKSCNFD GET CLASS @V200930 00198000
BNZ CQR028 ERROR, NOT THERE @V200930 00199000
CL R0,F1 IS IT ONE CHAR @V200930 00200000
BNE CQR028 NO, ERROR @V200930 00201000
MVC SAVEWRK1+1(1),0(R1) SET CLASS FOR SCAN @V200930 00202000
CALL DMKSCNFD LOOK FOR USERID PARM @V200930 00203000
BNZ TSTD NO USERID, CHECK CLASS @VA02254 00204000
TSTD1 TM VMCLEVEL,VMCLASSD CLASS D USER? @VA02254 00205000
BZ CQR020 USERID INVALID @VA02254 00206000
CKNAME LR R3,R0 GET SIZE @VA02254 00207000
BCTR R3,R0 SET FOR EXECUTE @VA02254 00208000
C R0,F8 IS IT VALID LENGTH? @VA02254 00209000
BH CQR020 NO, ERROR MSG @V200930 00210000
CL R0,F1 IS IT ONE BYTE ?? @V200930 00211000
BNE SETBLK NO, PREP FIELD @V200930 00212000
CKSTAR CLI 0(R1),C'*' IS IT SELF? @VA02254 00213000
BE SETCHK1 YES, SAVEWRK2 IS SET @VA02254 00214000
SETBLK MVC SAVEWRK2(8),BLANKS PREP FIELD @V200930 00215000
EX R3,SETUSR MOVE USERID FOR SEARCH @V200930 00216000
SETCHK1 CALL DMKSCNFD ANY MORE PARMS? @VA02254 00217000
BZ CQR026 SHOULDN'T BE ANY @VA02254 00218000
SETCHK LA R9,QRYFCHK LOOP CONTROL FOR CHECK @V200930 00219000
B QRYFRDR START LOOP @V200930 00220000
SETALL LA R9,QRYFALL START LOOP FOR ALL @V200930 00221000
QRYFRDR L R1,ARSPRD LOAD ADDRESS OF READER FILE CHAIN@V200930 00222000
BAL R10,QRYFCNT COUNT THE READER FILES @V200930 00223000
STCM R1,15,FILRDR SET COUNT @V200930 00224000
L R1,ARSPPR LOAD ADDRESS OF PRINTER FILE @V200930 00225000
BAL R10,QRYFCNT COUNT THE PRINTER FILES @V200930 00226000
STCM R1,15,FILPRT SET COUNT @V200930 00227000
L R1,ARSPPU LOAD ADDRESS OF PUNCH FILE CHAIN @V200930 00228000
BAL R10,QRYFCNT COUNT THE PUNCH FILES @V200930 00229000
STCM R1,15,FILPUN SET COUNT @V200930 00230000
LTR R4,R4 ARE THERE ANY FILES ? @V200930 00231000
BNZ QRYFWRT BRANCH IF YES @V200930 00232000
CR R2,R4 SEND IT ANYWAY ? @V200930 00233000
BNE QRYEXIT RETURN IF NO @V200930 00234000
QRYFWRT LA R0,32 LOAD MESSAGE LENGTH @V200930 00235000
LA R1,FILEMSG SET DATA ADDRESS @V200930 00236000
B QRYWRIT SEND THE REPLY AND EXIT @V200930 00237000
SPACE 2 00238000
QRYFCNT SR R3,R3 ZERO FILE COUNT @V200930 00239000
B QRYFNXT CONTINUE @V200930 00240000
USING SFBLOK,R1 @V200930 00241000
QRYFCHK CLC SFBUSER,SAVEWRK2 IS FILE FOR THIS USER ?? @V200930 00242000
BNE QRYFNXT BRANCH IF NO @V200930 00243000
QRYFALL TM SFBFLAG,SFBINUSE IS FILE BEING READ ?? @V200930 00244000
BO QRYFNXT YES, SKIP @V200930 00245000
CLI SAVEWRK1+1,X'00' IS CLASS SPECIFIED ?? @V200930 00246000
BE QRYCNT NO, COUNT ALL @V200930 00247000
CLC SFBCLAS,SAVEWRK1+1 TEST FOR MATCHING CLASS @V200930 00248000
BNE QRYFNXT NO, FIND NEXT FILE @V200930 00249000
QRYCNT AR R3,R5 ADD 1 TO FILE COUNT @V200930 00250000
AR R4,R5 ADD 1 TO TOTAL COUNT @V200930 00251000
QRYFNXT L R1,SFBPNT LOAD NEXT FILE ADDRESS @V200930 00252000
LTR R1,R1 ANY MORE FILES ? @V200930 00253000
BCR 7,R9 BRANCH IF YES @V200930 00254000
DROP R1 @V200930 00255000
LTR R1,R3 ANY FILES FOUND ? @V200930 00256000
BNZ FILCVT NO, CONVERT @V200930 00257000
L R1,=C' NO' SET NO FILES @V200930 00258000
BR R10 RETURN @V200930 00259000
FILCVT DS 0H @V200930 00260000
CALL DMKCVTBD CONVERT COUNT TO DECIMAL @V200930 00261000
ST R1,SAVEWRK8 SAVE COUNT @V200930 00262000
CLI SAVEWRK8,C'0' HI ORDER ZERO ?? @V200930 00263000
BNE *+8 NO, CONT @V200930 00264000
MVI SAVEWRK8,C' ' BLANK IT OUT @V200930 00265000
L R1,SAVEWRK8 SET COUNT @V200930 00266000
BR R10 RETURN @V200930 00267000
SPACE 00268000
FILEMSG DC C'FILES:' @V200930 00269000
FILRDR DC C' NO RDR,' @V200930 00270000
FILPRT DC C' NO PRT,' @V200930 00271000
FILPUN DC C' NO PUN' @V200930 00272000
DS 0F @V200930 00273000
SPACE 2 00274000
SETUSR MVC SAVEWRK2(0),0(R1) EXECUTED TO MOVE USERID @V200930 00275000
CLCLS CLC 0(0,R1),=CL6'CLASS ' EXECUTED FOR CLASS TEST @V200930 00276000
EJECT 00277000
*. 00278000
* ROUTINE TO STACK OUTPUT LINES ON VMBLOK 00279000
* THE LINES WILL BE PRINTED BY DMKCFM ON RETURN 00280000
*. 00281000
STACK LR R4,R0 GET SIZE OF DATA @V200930 00282000
LR R5,R1 SET DATA ADDRESS @V200930 00283000
LA R0,7(R4) ROUND UP TO DOUBLE WORD @V200930 00284000
SRL R0,3 GET SIZE IN DOUBLE WORDS @V200930 00285000
A R0,F1 ONE MORE FOR CHAINING @V200930 00286000
CALL DMKFREE GET BUFFER @V200930 00287000
STH R4,4(R1) SAVE LINE SIZE @V200930 00288000
STH R0,6(R1) SAVE BUFFER SIZE @V200930 00289000
BCTR R4,R0 DECREMENT FOR EXECUTE @V200930 00290000
EX R4,MVCSTK MOVE DATA TO STACK @V200930 00291000
SR R0,R0 CLEAR @V200930 00292000
ST R0,0(R1) CLEAR POINTER @V200930 00293000
LA R2,VMSTKO GET OUTPUT STACK POINTER @V200930 00294000
STKLOOP L R4,0(R2) GET POINTER TO STACK BUFFER @V200930 00295000
LTR R4,R4 TEST FOR END OF CHAIN @V200930 00296000
BZ CHAIN FOUND END, CHAIN THIS BUFFER @V200930 00297000
LR R2,R4 POINT TO THIS BUFFER @V200930 00298000
B STKLOOP LOOP TO FIND END @V200930 00299000
CHAIN ST R1,0(R2) CHAIN AT END @V200930 00300000
BR R3 RETURN @V200930 00301000
* 00302000
MVCSTK MVC 8(*-*,R1),0(R5) EXECUTED FOR STACK BUFFER MOVE @V200930 00303000
EJECT 00304000
*. 00305000
* 00306000
* QUERY SET 00307000
* 00308000
* COMMAND FORMAT 00309000
* 00310000
* +---------+-----------+ 00311000
* | QUERY | SET | 00312000
* +---------+-----------+ 00313000
* 00314000
* 1. GET BUFFER 00315000
* 2. FORMAT RESPONSE 00316000
* 3. WRITE RESPONSE 00317000
* 00318000
* RESPONSE 00319000
* 00320000
* MSG XXX, WNG XXX, EMSG XXXX, ACNT XXX, RUN XXX 00321000
* LINEDIT XXX, TIMER XXXX, ISAM XXX, ECMODE XXX 00322000
* ASSIST XXXXXXXX XXXXX, PAGEX XXX, AUTOPOLL XXX 00323000
* IMSG XXX, SMSG XXX, AFFINITY XXXX YY, NOTRANS XXX 00324000
* 00325000
*. 00326000
SPACE 2 00327000
QRYSET LA R0,7 STORAGE SIZE OF BUFFER @V201537 00328000
CALL DMKFREE @V200930 00329000
LR R4,R1 BUFFER ADDRESS IN R4 @V200930 00330000
USING SETHDR,R4 ADDRESSABILITY @V200930 00331000
MVC SETHDR(L'HDRSET1),HDRSET1 MOVE IN FIRST-LINE@V200820 00332000
L R5,=C' OFF' LOAD CONSTANT INTO R5 @V200930 00333000
TM VMMLEVEL,VMMSGON IS USER RECEIVING MESSAGES ? @V200930 00334000
BO *+8 YES, BRANCH @V200930 00335000
STCM R5,7,SETHDR+4 @V200930 00336000
TM VMMLEVEL,VMWNGON IS USER RECEIVING "WARNING" @V200930 00337000
BO *+8 YES, BRANCH @V200930 00338000
STCM R5,7,SETHDR+13 STORE OFF @V200930 00339000
TM VMMLEVEL,VMMCODE+VMMTEXT RECEIVING ALL ERROR @V200930 00340000
BO ACNTCK YES @V200930 00341000
BZ ERROFF BRANCH IF BOTH BITS ARE OFF @V200930 00342000
MVC SETHDR+23(4),=C'CODE' @V200930 00343000
TM VMMLEVEL,VMMCODE IS IT CODE ? @V200930 00344000
BO ACNTCK IF YES, TAKE THE BRANCH @V200930 00345000
MVC SETHDR+23(4),=C'TEXT' MUST BE TEXT ONLY @V200930 00346000
B ACNTCK @V200930 00347000
ERROFF STCM R5,7,SETHDR+23 MAKE IT "OFF" @V200930 00348000
ACNTCK TM VMMLEVEL,VMMACCON ACCOUNT ON ? @V200930 00349000
BO *+8 YES,, BRANCH @V200930 00350000
STCM R5,7,SETHDR+34 STORE "OFF" @V200930 00351000
TM VMOSTAT,VMCFRUN RUN ON ? @V200820 00352000
BO *+8 YES -- @V200820 00353000
STCM R5,7,SETHDR+43 MAKE IT RUN OFF @V200820 00354000
SPACE 00355000
LA R1,SETHDR BUFFER ADDRESS FOR DMKQCNWT @V200820 00356000
LA R0,L'HDRSET1 LENGTH OF THE FIRST LINE @V200820 00357000
CALL DMKQCNWT,PARM=NORET PRINT THIS LINE @V200930 00358000
SPACE 00359000
MVC SETHDR(L'HDRSET2),HDRSET2 MOVE IN SECOND-LINE @V200820 00360000
TM VMMLEVEL,VMMLINED IS LINE EDIT ON ? @V200930 00361000
BO *+8 YES, BRANCH @V200930 00362000
STCM R5,7,SETHDR+8 STORE "OFF" @V200930 00363000
TM VMTLEVEL,VMTON IS TIMER ON ? @V200930 00364000
BO RUNCHEK YES, BRANCH @V200930 00365000
STCM R5,7,SETHDR+19 ASSUME ITS OFF @V200930 00366000
TM VMTLEVEL,VMRON HAS USER GOT A REAL TIMER ? @V200930 00367000
BZ RUNCHEK NO, BRANCH @V200930 00368000
MVC SETHDR+19(4),=C'REAL' CHANGE TO REAL @V200930 00369000
RUNCHEK EQU * @V200820 00370000
TM VMPSTAT,VMISAM VIRT MACH WITH ISAM CHECKING@V200820 00371000
BO *+8 YES - LEAVE IT AS 'ON' @V200820 00372000
STCM R5,7,SETHDR+30 STORE "OFF" @V200820 00373000
TM VMPSTAT,VMV370R VIRTUAL MACHINE WITH ECMODE @V200820 00374000
BO *+8 YES -- @V200820 00375000
STCM R5,7,SETHDR+42 STORE "OFF" @V200820 00376000
SPACE 00377000
LA R0,L'HDRSET2 LENGTH OF SECOND LINE OF OUTPUT @V200820 00378000
LA R1,SETHDR START OF THE MESSAGE @V200820 00379000
CALL DMKQCNWT,PARM=NORET TYPE SECOND MESSAGE LINE @V200820 00380000
MVC SETHDR(L'HDRSET3),HDRSET3 MOVE IN THIRD LINE@V200820 00381000
TM VMPSTAT,VMPAGEX PSEUDO PAGE FAULTS @V213135 00382000
BO *+8 YES - MSG SET FOR 'ON' @V213135 00383000
STCM R5,B'0111',SETHDR+29 NO - CHANGE TO 'OFF' @V3M4026 00384000
TM VMFSTAT,VMFAUTO USING AUTOPOLL HANDSHAKE OPT? @V386298 00385000
BO AUTOSET YES, MESSAGE IS ALREADY SET... @V3M4035 00386000
STCM R5,B'0111',SETHDR+43 ELSE RESET MSG TO 'OFF' @V3M4026 00387000
AUTOSET EQU * TELL USER ABOUT HIS VM ASSIST@V4M0134 00388000
TM VMMCR6,VMMFE VM ASSIST ON FOR USER? @VM08658 00389000
BZ MICOFF NO, MESSAGE IS OK AS IS @VM08658 00390000
SR R15,R15 POINT TO OUR PSA @V4M0134 00391000
TM APSTAT1,APUOPER IS THERE ANOTHER PROCESSOR? @V4M0134 00392000
BNO VMAONE NO, JUST TEST THIS ONE'S VM A@V4M0134 00393000
TM VMAFF,VMAFFON USER AFFINITY TO ONE PROCESSO@V4M0134 00394000
BNO VMANY NO, TEST BOTH PSA'S @V4M0134 00395000
CLC VMAFF,LPUADDR+1 AFFINITY TO OUR PROCESSOR? @V4M0134 00396000
BE VMAONE YES, ALL SET FOR TEST @V4M0134 00397000
B VMAOTHER NO, POINT TO OTHER PSA @V4M0134 00398000
SPACE 1 @V4M0134 00399000
VMANY TM CPSTAT2,CPMICON DO WE HAVE VM ASSIST RUNNING @V4M0134 00400000
BO VMAISON YES, GOOD ENOUGH, TELL USER @V4M0134 00401000
VMAOTHER L R15,PREFIXB POINT TO OTHER PSA @V4M0134 00402000
VMAONE TM CPSTAT2-PSA(R15),CPMICON IS VMA ON HERE? @V4M0134 00403000
BO VMAISON IT'S ON SOMEWHERE, TELL USER @V4M0134 00404000
MVC SETHDR+7(10),=C'NOT ACTIVE' USER REQUEST IS ON, @V4M0134 00405000
B MICOFF OPERATOR HAS IT OFF FOR SYSTE@V4M0134 00406000
VMAISON EQU * @V4M0134 00407000
MVC SETHDR+7(6),=C'ON SVC' CHANGE MSG TO 'ON SVC' @V3M4026 00408000
TM VMMCR6,VMMSVC IS VM ASSIST HANDLING SVCS? @VM08658 00409000
BZ MICTMR YES, MSG IS OK SO FAR @V3M4026 00410000
MVC SETHDR+10(5),=C'NOSVC' NO, CHANGE TO NOSVC @VM08658 00411000
MICTMR EQU * @V3M4026 00412000
MVC SETHDR+16(5),=C'NOTMR' INITIALIZE MSG OUTPUT @V3M4026 00413000
TM VMMCR6,VMMVTMR IS TIMER ASSIST ENABLED ? @V3M4026 00414000
BZ MICOFF NO, MSG IS READY TO GO @V3M4026 00415000
MVC SETHDR+16(5),=C'TMR ' CHANGE APPROPRIATELY @V3M4026 00416000
MICOFF EQU * @VM08658 00417000
SPACE 1 00418000
LA R0,L'HDRSET3 LENGTH OF THIRD LINE @VM08658 00419000
LA R1,SETHDR START FOR OUTPUT @V200820 00420000
CALL DMKQCNWT,PARM=NORET TYPE THE MSG @V2A3663 00421000
SPACE 00422000
MVC SETHDR(L'HDRSET4),HDRSET4 MOVE IN LINE 4 @V2A3663 00423000
TM VMMLVL2,VMMIMSG RECEIVING INFO. MSGS?? @V2A3663 00424000
BO AFFSET @V4075A0 00425000
STCM R5,7,SETHDR+5 NO - SET TO OFF. @V2A3663 00426000
AFFSET EQU * @V4075A0 00427000
TM VMAFF,VMAFFON DOES USER HAVE AFFINITY SET? @V4075A0 00428000
BZ LSTWRT TELL HIM NO @V4075A0 00429000
MVC SETHDR+29(5),=C'PROC ' YES, SHOW HIM @V60C2B8 00430000
IC R1,VMAFF THE PROCESSOR ADDRESS @V4075A0 00431000
N R1,=F'63' 6-BIT PROC ADDR FIELD @V4075A0 00432000
CALL DMKCVTBD @V4075A0 00433000
STCM R1,3,SETHDR+34 2 DIGIT NUMBER @V60C2B8 00434000
LSTWRT EQU * @V2A3663 00435000
TM VMPSTAT,VMNOTRAN IS NOTRAN ON @VA07984 00435200
BO *+8 YES @VA07984 00435400
STCM R5,B'0111',SETHDR+46 SET MSG OFF @V60C2B8 00435600
TM VMSPMFLG,VMSPMON IS SPM FLAG 'ON'? @V60C2B8 00435700
BO *+8 YES, GO TELL USER @V60C2B8 00435800
STCM R5,7,SETHDR+15 INDICATE OFF @V60C2B8 00435900
LA R0,L'HDRSET4 LINE 4'S LENGTH @V2A3663 00436000
LA R1,SETHDR AND BUFFER START ADDR @V2A3663 00437000
CALL DMKQCNWT,PARM=NORET Type msg line 4 HRC068DK 00437200
MVC SETHDR(L'HDRSET5),HDRSET5 Move in line 5 HRC068DK 00437210
TM VMCXSTAT,VMSTBYPS Is STBYPASS active? HRC068DK 00437220
BO *+8 Yes HRC068DK 00437230
STCM R5,B'0111',SETHDR+9 Set msg text OFF HRC068DK 00437240
LA R0,L'HDRSET5 Line 5's length HRC068DK 00437250
LA R1,SETHDR -> buffer start HRC068DK 00437260
LA R3,7 BUFFER SIZE IN DBLWDS @V2A3663 00438000
CALL DMKQCNWT,PARM=NORET+DFRET TYPE MSG & FRET BUFFER@V2A3663 00439000
B QRYEXIT RETURN @V200930 00440000
DROP R4 @V200930 00441000
SPACE 00442000
HDRSET1 DC C'MSG ON , WNG ON , EMSG ON , ACNT ON , RUN ON ' 00443000
SPACE 00444000
HDRSET2 DC C'LINEDIT ON , TIMER ON , ISAM ON , ECMODE ON ' 00445000
SPACE 00446000
HDRSET3 DC C'ASSIST OFF , PAGEX ON , AUTOPOLL ON ' 00447000
SPACE 00448000
HDRSET4 DC C'IMSG ON , SMSG ON , AFFINITY NONE , NOTRANS ON ' 00449000
SPACE 00449500
HDRSET5 DC C'STBYPASS VR ' HRC068DK 00449520
EJECT 00450000
*. 00451000
* 00452000
* QUERY DUMP 00453000
* 00454000
* COMMAND FORMAT 00455000
* 00456000
* +---------+-----------+ 00457000
* | QUERY | DUMP | 00458000
* +---------+-----------+ 00459000
* 00460000
* 1. FORMAT DUMP RESPONSE 00461000
* 2. WRITE RESPONSE 00462000
* 00463000
* RSEPONSE 00464000
* 00465000
* DUMP UNIT TYPE XXX CP/ALL 00466000
* 00467000
*. 00468000
QRYDUMP MVC SAVEWRK2(1),BLANKS MOVE A X'40' INTO WORK AREA @V386198 00469000
MVC SAVEWRK2+1(25),SAVEWRK2 AND CLEAR REST OF AREA. @V200930 00470000
MVC SAVEWRK2+9(12),=C'DUMP UNIT CP' SET FOR CP DUMP @V200930 00471000
L R5,=A(DMKDMPSW) GET THE DUMP INTERFACE @V200930 00472000
TM 0(R5),X'80' FOR CP AREA ONLY ? @V200930 00473000
BZ QRYDUMP1 YES,, GO GET DEVICE ADDRESS. @V200930 00474000
MVC SAVEWRK2+19(3),=CL5'ALL ' NO, SET TO ALL @V200930 00475000
QRYDUMP1 L R10,=A(DMKDMPDV) LOAD ADDRESS OF DUMP DEVICE @V200930 00476000
L R1,0(R10) GET DUMP DEVICE ADDRESS (CCU) @V407438 00477000
LTR R1,R1 ANY UNIT ALLOCATED ? @V407438 00478000
BZ FINDPRT NOPE, FIND FIRST PRINTER @V407438 00479000
CALL DMKSCNRU FIND REAL BLOCKS @V407438 00480000
B DMPUNIT AND CONTINUE @V407438 00481000
SPACE 00482000
FINDPRT L R15,=A(DMKRIOPR) GET THE LIST OF PRINTERS @V407438 00483000
L R15,=A(DMKRIOPR) GET DEFAULT PRINTER ADDRESS @V200930 00484000
LH R8,4(R15) GET RDEVBLOK DISPLACEMENT @V200930 00485000
SLL R8,3(R0) EXPAND IT @VA01793 00486000
AL R8,ARIODV POINT TO RDEVBLOK @V200930 00487000
USING RDEVBLOK,R8 @V200930 00488000
CALL DMKSCNRD GET REAL DEV ADDRESS @V200930 00489000
DMPUNIT CALL DMKCVTBH CONVERT TO PRINTABLE HEX @V407438 00490000
STCM R1,7,SAVEWRK2+5 SAVE DEVICE ADDRESS @V200930 00491000
LA R0,22 LOAD MSG LNG. @V200930 00492000
LA R1,SAVEWRK2 AND ALSO ITS ADDRESS @V200930 00493000
MVC SAVEWRK2(4),=C'TAPE ' ASSUME TAPE @V200930 00494000
TM RDEVTYPC,CLASTAPE IS IT REALLY A "TAPE DRIVE " @V200930 00495000
BO QRYWRIT YES,, GO PRINT IT. @V200930 00496000
MVC SAVEWRK2(4),=CL5'DASD ' ASSUME DASD @V200930 00497000
TM RDEVTYPC,CLASDASD IS IT A DASD ? @V200930 00498000
BO QRYWRIT YEP,, GO PRINT IT. @V200930 00499000
MVC SAVEWRK2(4),=C'PRT ' NO,, ITS A PRINTER DEVICE. @V200930 00500000
B QRYWRIT GO SEND MSG AND EXIT @V200930 00501000
DROP R8 @V200930 00502000
EJECT 00503000
*. 00504000
* 00505000
* QUERY PAGING 00506000
* 00507000
* COMMAND FORMAT 00508000
* 00509000
* +---------+-------------+ 00510000
* | QUERY | PAGING | 00511000
* +---------+-------------+ 00512000
* 00513000
* 1. FORMAT PAGING RESPONSE 00514000
* 2. WRITE RESPONSE 00515000
* 00516000
* RESPONSE 00517000
* 00518000
* PAGING XX, SET YY, NNN/SEC, MEASUREMENT= XX:XX:XX 00519000
* 00520000
* OPERATION OF THE PAGING LOAD CALCULATOR 00521000
* 00522000
* 1. STORE TOD CLOCK AND COMPUTE LENGTH OF RECORDING INTERVAL 00523000
* 2. CONVERT THE TIME TO MICROSECONDS, INSURING THAT IT FITS IN 00524000
* ONE WORD (31 BITS PLUS SIGN) 00525000
* 3. OBTAIN PAGE-WAIT TIME OVER THE INTERVAL 00526000
* 4. PROJECT PAGE-WAIT PERCENTAGE FOR NEXT INTERVAL 00527000
* 5. CALCULATE THE PAGING RATE IN PAGES/SECOND. 00528000
* 6. CALCULATE THE RATIO OF STOLEN TO FLUSHED PAGES. 00529000
* 7. RESET COUNTERS AND VALUES FOR THE START OF A NEW MEASURE- 00530000
* MENT INTERVAL. 00531000
*. 00532000
QRYPAGE STCK ENDTIME REMEMBER END OF RECORDING PERIOD @V386198 00533000
BC 3,DOWNWEGO CLOCK NOT FUNCTIONING @VA04301 00534000
STM R10,R13,CQRSAVRG SAVE REGS @V4M0131 00535000
L R0,RECDTIME GET START TIME @VA08859 00536000
LTR R0,R0 IS THIS FIRST TIME QUERY EXECUTED@VA08859 00537000
BNZ *+10 NO - START TIME IS CORRECT @VA08859 00538000
MVC RECDTIME,STARTIME USE TIME FROM PSA START-UP @VA08859 00539000
LM R0,R3,RECDTIME GET START AND END OF RECORDING @VA08859 00540000
* PERIOD 00541000
LA R4,1 GET CONSTANT FOR ARITHMETIC @VA08859 00542000
SR R6,R6 CLEAR SHIFT COUNTER @VA08859 00543000
LA R7,100 GET CONSTANT FOR PERCENTAGE @VA08859 00544000
* CALCULATIONS 00545000
SLR R3,R1 CALCULATE LENGTH OF RECORDING @VA08859 00546000
* PERIOD 00547000
BC 11,*+6 ... @VA08859 00548000
SLR R2,R4 ... @VA08859 00549000
SLR R2,R0 ... @VA08859 00550000
SRDL R2,12 AND CONVERT TO MICROSECONDS @VA08859 00551000
LR R0,R2 SAVE THE ELAPSED TIME @VA08859 00552000
LR R1,R3 ... @VA08859 00553000
D R0,=F'10000' CONVERT TO 1/100'S OF A SECOND @VA08859 00554000
LTR R15,R1 SAVE AND TEST THE RESULT @VA08859 00555000
BP *+8 OK TO USE -- @VA08859 00556000
LA R15,1 SET MAXIMUM RATE @VA08859 00557000
L R14,=A(DMKPAGQR) GET ADDRESS OF PAGE I/O COUNTER@VA08859 00558000
L R1,0(,R14) LOAD NUM. OF PAGE I/O. @VA08859 00559000
MVC 0(4,R14),F0 CLEAR FOR NEXT RECOEDING @VA08859 00560000
MR R0,R7 TIMES 100 @VA08859 00561000
LTR R1,R1 AVOID DIVIDE ERROR @VA08859 00562000
BZ *+6 BRANCH IF NO PAGE ACTIVITY @VA08859 00563000
DR R0,R15 AND GET PAGING RATE @VA08859 00564000
STH R1,QPAGRATE SAVE IT. @VA08859 00565000
BAL R15,SHIFTER MAKE SURE THAT IT FITS IN ONE @VA08859 00566000
* REGISTER 00567000
SR R10,R10 INDEX TO MAIN PROC WAITSAVE VALUE@V4M0131 00568000
SR R11,R11 PREFIX VALUE FOR REAL PSA @V4M0131 00569000
LA R13,1 COUNTER - ONE FOR UP MODE @V4M0131 00570000
TM APSTAT1,APUOPER APU OPERATIONAL ? @V4M0131 00571000
BNO COMPSTAT NO - ONLY 1 PASS THRU CODE BELOW @V4M0131 00572000
LA R13,2 YES - MAKE 2 PASSES THRU CODE @V4M0131 00573000
* BELOW TO COMPUTE STATISTICS FOR 00574000
* BOTH PROCESSORS. 00575000
TM APSTAT1,PROCIPL IS THIS THE IPL'ED PROCESSOR? @VMV0008 00576100
BO COMPSTAT YES - COMPUTE PAGING STATISTICS @V4M0131 00577000
LA R10,8 NO - BEFORE COMPUTE PAGEING STATS@V4M0131 00578000
* SET INDEX TO AP WORKSAVE VALUE. 00579000
COMPSTAT EQU * @V4M0131 00580000
L R8,PAGEWAIT(R11) 1ST WORD OF CURRENT PG WT TOTAL@VA09324 00580010
L R9,PAGEWAIT+N4(R11) 2ND WORD OF PG WT TOTAL @VA09324 00580020
STM R8,R9,SAVEWRK3 STORE VALUE @VA09324 00580030
LA R1,DMKCQRWS(R10) ADDDRESS CORRECT PG.WT. VALUE @VA09324 00580040
CLC SAVEWRK3(8),0(R1) PAGEWAIT HIGHER? @VA09324 00580050
BNH COMPST1 NO, BRANCH @VA09324 00580060
* CONTROL FALLS HERE WHENEVER 00580070
* PAGEWAIT IS HIGHER THAN DMKCQRWS. 00580080
* THIS OCCURS ONLY WHEN THE LAST Q 00580090
* PAGING WAS DONE WHILE THE SYSTEM 00580100
* WAS IN AP MODE, AND THE SYSTEM IS 00580110
* NOW IN UP MODE DO TO A VARY OFF 00580120
* PROCESSOR COMMAND. 00580130
MVC 0(8,R1),INITSAVE SAVE PAGE WAIT VALUE @VA09324 00580140
COMPST1 DS 0H @VA09324 00580150
L R0,DMKCQRWS(R10) 1ST WORD OF SAVED PG WT TIME @VMH0012 00581000
L R1,DMKCQRWS+N4(R10) 2ND WORD OF SAVED PG WT @VMH0012 00582000
ST R8,DMKCQRWS(R10) SAVE PAGEWAIT FOR @VMH0012 00585000
ST R9,DMKCQRWS+N4(R10) NEXT TIME @VMH0012 00586000
SPACE 00587000
SLR R1,R9 COMPUTE PAGE WAIT OVER INTERVAL @VA08859 00588000
BC 8+2+1,*+6 ... @VA08859 00589000
SLR R0,R4 .. @VA08859 00590000
SLR R0,R8 . @VA08859 00591000
SRDL R0,12 AND CONVERT TO MICROSECONDS @VA08859 00592000
SPACE 00593000
LTR R1,R1 REMEMBER SETTING OF HIGH ORDER @VA08859 00594000
BALR R15,R0 BIT IN LOW ORDER REGISTER @VA08859 00595000
SPACE 00596000
N R1,=XL4'7FFFFFFF' CLEAR HIGH ORDER BIT @VA08859 00597000
LR R5,R0 SAVE HIGH ORDER WORD @VA08859 00598000
MR R0,R7 MULTIPLY BY 100 FOR PERCENTAGE @VA08859 00599000
MR R4,R7 MULTIPLY HIGH ORDER WORD @VA08859 00600000
ALR R0,R5 AND ADD IN OVERFLOW @VA08859 00601000
SPM R15 WAS HIGH ORDER BIT ON ? @VA08859 00602000
BNM ALIGN NO -- @VA08859 00603000
SRL R7,1 ALIGN MULTIPLIER WITH MISSING BIT@VA08859 00604000
ALR R0,R7 AND ADD IN PARTIAL SUM @VA08859 00605000
ALIGN SRDL R0,0(R6) ALIGN WITH DIVISOR @VA08859 00606000
DR R0,R3 GET PAGING OVERHEAD PERCENTAGE @VA08859 00607000
SR R15,R15 INDEX TO PAGELOAD VALUES IN CQR @V4M0131 00608000
TM APSTAT1-PSA(R11),PROCIPL THE IPL'ED PROCESSOR? @VMV0008 00609100
BO UPDATEMP YES - MAIN PROC TABLE INDEX IS 0 @V4M0131 00610000
LA R15,2 NO - AP TABLE INDEX IS 2 @V4M0131 00611000
UPDATEMP EQU * UPDATE MAIN PROC PAGE LOAD VALUE @V4M0131 00612000
LH R0,QPAGLOAD(R15) GET PREVIOUS PAGE LOAD VALUE. @V4M0131 00613000
ALR R0,R0 TIMES 2 @VA08859 00614000
AH R0,QPAGLOAD(R15) TIMES 3 @V4M0131 00615000
ALR R1,R0 PLUS RECENT LOAD @VA08859 00616000
SRL R1,2 /4 FOR SMOOTHED AVERAGE @VA08859 00617000
STH R1,QPAGLOAD(R15) AND SAVE FOR EACH PROCESSOR. @V4M0131 00618000
X R10,F08 INVERT WAITSAVE INDEX @V4M0131 00619000
L R11,PREFIXB ADDR OF OTHER PREFIX AREA @V4M0131 00620000
BCT R13,COMPSTAT COMPUTE PAGEING STATISTICS FOR @V4M0131 00621000
* THE OTHER PROCESSOR. 00622000
LM R10,R13,CQRSAVRG RESTORE CALLERS REQUIRED REGS @V4M0131 00623000
LM R1,R2,=V(DMKPTRSS,DMKPTRFF) GET FLUSH AND @VA08859 00624000
* STEAL COUNTS 00625000
L R1,0(,R1) GET STEAL COUNT @VA08859 00626000
L R2,0(,R2) GET FLUSH COUNT @VA08859 00627000
LM R3,R4,QPAGSAV GET OLD COUNTS @VA08859 00628000
STM R1,R2,QPAGSAV SAVE NEW COUNTS FOR NEXT TIME @VA08859 00629000
SLR R1,R3 GET STEALS OVER INTERVAL @VA08859 00630000
SLR R2,R4 GET FLUSHES OVER INTERVAL @VA08859 00631000
LA R7,100 .. FOR ARITHMETIC @VA08859 00632000
ALR R2,R1 GET TOTAL PAGES REPLENISHED @VA08859 00633000
BZ SETRATIO IF ZERO, QUIT NOW @VA08859 00634000
MR R0,R7 GET STEALS X 100 @VA08859 00635000
DR R0,R2 DIVIDED BY STEALS + FLUSHES @VA08859 00636000
LR R2,R1 GET RATIO @VA08859 00637000
SETRATIO STH R2,QPGRATIO AND SAVE IT @VA08859 00638000
LA R0,8 GET SOME FREE STORAGE @VA08859 00639000
CALL DMKFREE ... @VA08859 00640000
LR R7,R1 SAVE ITS ADDRESS @VA08859 00641000
LR R9,R1 SAVE FOR FRET @V4M0131 00642000
MVI 0(R7),C' ' BLANK IT OUT. @VA08859 00643000
MVC 1(63,R7),0(R7) ..... @VA08859 00644000
MVC 0(7,R7),=C'PAGING ' SET HEADER @VA08859 00645000
TM APSTAT1,APUOPER APU OPERATIONAL ? @V4M0131 00646000
BNO NOAP NO - DO NOT EXTEND MESSAGE @V4M0131 00647000
MVC PLUS7(L3,R7),MP MOVE 'MP-' TO MESSAGE @V4M0131 00648000
LH R1,QPAGLDMP PAGE LOAD VALUE OF MAIN PROCESSOR@V4M0131 00649000
CALL DMKCVTBD CONVERT IT @V4M0131 00650000
STCM R1,B'0011',PLUS10(R7) AND STORE AS MP VALUE @V4M0131 00651000
MVC PLUS12(L4,R7),AP MOVE '/AP-' TO MESSAGE @V4M0131 00652000
LH R1,QPAGLDAP PAGE LOAD VALUE OF APU @V4M0131 00653000
CALL DMKCVTBD CONVERT IT @V4M0131 00654000
STCM R1,B'0011',PLUS16(R7) AND STORE AS AP VALUE @V4M0131 00655000
LA R7,N9(R7) ADJUST TO ACCOMODATE MP/AP TOTALS@V4M0131 00656000
B APDONE CONTINUE WITH REMAINDER OF MSG @V4M0131 00657000
NOAP EQU * @V4M0131 00658000
LH R1,QPAGLOAD RE-LOAD CURRENT WAIT PERCENTAGE @VA08859 00659000
CALL DMKCVTBD CONVERT IT @VA08859 00660000
STCM R1,B'0011',7(R7) AND STORE IT @VA08859 00661000
APDONE EQU * @V4M0131 00662000
MVC 9(6,R7),=C', SET ' SET HEADER @VA08859 00663000
L R1,=A(DMKSCHPG) GET ADDRESS OF THRESHOLD @VA08859 00664000
L R1,0(,R1) GET THRESHOLD @VA08859 00665000
CALL DMKCVTBD CONVERT IT @VA08859 00666000
STCM R1,B'0011',15(R7) AND STORE IT @VA08859 00667000
MVC 17(7,R7),=C', RATE ' SET HEADER @VA08859 00668000
LH R1,QPAGRATE RE-LOAD CALCULATED PAGING RATE @VA08859 00669000
CALL DMKCVTBD CONVERT IT @VA08859 00670000
STCM R1,B'0111',24(R7) AND STORE IT @VA08859 00671000
MVC 27(4,R7),=C'/SEC' SET HEADER @VA08859 00672000
MVC 31(15,R7),=C', INTERVAL= ' LAST HEADER @VA08859 00673000
LM R0,R1,ENDTIME GET ENDING TIME PERIOD @VA08859 00674000
SL R1,RECDTIME+4 GET DIFFERENCE FROM START TIME @VA08859 00675000
BC 8+2+1,*+8 ... @VA08859 00676000
SL R0,F1 .... @VA08859 00677000
SL R0,RECDTIME ..... @VA08859 00678000
STCK RECDTIME REMEMBER START OF NEXT PERIOD. @VA08859 00679000
BC 12,CLOCKOK IS CLOCK FUNCTIONING? @VA04301 00680000
DOWNWEGO GOTO DMKCVTAB CLOCK DAMAGED...ABEND CVT001 @VA04301 00681000
CLOCKOK EQU * @VA04301 00682000
SRDL R0,12 CONVERT TO MICROSECONDS @VA08859 00683000
D R0,=F'1000000' CONVERT TO SECONDS @VA08859 00684000
SLR R0,R0 CLEAR REMAINDER FOR NEXT DIVIDE. @VA08859 00685000
D R0,=F'3600' GET NUMBER OF HOURS @VA08859 00686000
CVD R1,TEMPSAVE CONVERT HOURS TO DECIMAL @VA08859 00687000
UNPK 43(4,R7),TEMPSAVE+6(3) UNPACK IT @VA08859 00688000
MVI 45(R7),C':' MAKE READABLE @VA08859 00689000
LR R1,R0 REMAINDER FROM DIVIDE TOTAL SEC @VA08859 00690000
SLR R0,R0 CLEAR FOR MINUTES @VA08859 00691000
D R0,F60 GET TOTAL NUMBER OF MINUTES @VA08859 00692000
CVD R1,TEMPSAVE CONVERT TO NUMBER OF MINUTES @VA08859 00693000
UNPK 46(4,R7),TEMPSAVE+6(3) UNPACK MINUTES @VA08859 00694000
MVI 48(R7),C':' MAKE READABLE @VA08859 00695000
CVD R0,TEMPSAVE CONVERT SECONDS TO DECIMAL @VA08859 00696000
UNPK 49(2,R7),TEMPSAVE+6(2) UNPACK SECONDS @VA08859 00697000
OI 50(R7),X'F0' CORRECT FOR SIGN CHARACTER @VA08859 00698000
LA R0,64 MESSAGE LENGTH @VA08859 00699000
LR R1,R9 AND WHERE IT CAN BE FOUND @V4M0131 00700000
CALL DMKQCNWT,PARM=NORET @VA08859 00701000
LA R0,8 NUMBER OF DW'S TO FRET @VA08859 00702000
LR R1,R9 AND ITS ADDRESS. @V4M0131 00703000
CALL DMKFRET FRET IT. @VA08859 00704000
B QRYEXIT RETURN TO DMKCFM @VA08859 00705000
SPACE 2 00706000
SHIFTER EQU * HERE TO TRUNCATE DIVISOR TO ONE @VA08859 00707000
* WORD 00708000
LTR R2,R2 ANY DATA IN HIGH ORDER WORD ?? @VA08859 00709000
BZ SHIFTER1 NO - INSURE NON-NEGATIVE @VA08859 00710000
SRDL R2,1 SHIFT ONE @VA08859 00711000
ALR R6,R4 AND COUNT NUMBER OF SHIFTS @VA08859 00712000
B SHIFTER CONTINUE @VA08859 00713000
SHIFTER1 LTR R3,R3 INSURE NON-NEGATIVE VALUE -- @VA08859 00714000
BCR 11,R15 IF NOT MINUS, EXIT @VA08859 00715000
SRL R3,1 OTHERWISE, SHIFT ONE MORE @VA08859 00716000
ALR R6,R4 BUMP SHIFT COUNT @VA08859 00717000
BR R15 AND RETURN @VA08859 00718000
DS 0D ALIGNMENT @VA08859 00719000
CQRSAVRG DS 4F OVERHEAD REG SAVEAREA @V4M0131 00720000
F08 DC F'08' BIT TO INVERT WAITSAVE INDEX @V4M0131 00721000
DMKCQRWS DS 0F @VMH0012 00722000
DC X'7FFFFFFF' WAITSAVE VALUE FOR MAIN PROC @V4M0131 00723000
DC X'FFFFF000' @V4M0131 00724000
DC X'7FFFFFFF' WAITSAVE VALUE FOR THE APU @V4M0131 00725000
DC X'FFFFF000' @V4M0131 00726000
INITSAVE DC X'7FFFFFFFFFFFF000' INITIAL DMKCQRWS VALUE @VA09324 00726100
RECDTIME DC D'0' START OF RECORDING PERIOD. @VA08859 00727000
ENDTIME DC D'0' END OF RECORDING PERIOD. @VA08859 00728000
QPAGSAV DC 2F'0' FOR STEAL RATIO COUNTERS @VA08859 00729000
QPAGRATE DC H'0' PAGE RATE PER SECONDS @VA08859 00730000
QPAGLOAD DS 0H @V4M0131 00731000
QPAGLDMP DC H'0' SAVE PAGE LOAD FACTOR - MAIN PROC@V4M0131 00732000
QPAGLDAP DC H'0' SAVE PAGE LOAD FACTOR - APU @V4M0131 00733000
QPGRATIO DC H'0' PAGING RATIO. @VA08859 00734000
MP DC C'MP-' MESSAGE TEXT- PAGE LOAD VALUE MP @V4M0131 00735000
AP DC C'/AP-' MESSAGE TEXT- PAGE LOAD VALUE AP @V4M0131 00736000
PLUS7 EQU 7 @V4M0131 00737000
PLUS10 EQU 10 @V4M0131 00738000
PLUS12 EQU 12 @V4M0131 00739000
PLUS16 EQU 16 @V4M0131 00740000
N4 EQU 4 INDEX TO 2ND WORD @V4M0131 00741000
N8 EQU 8 WAITSAVE INDEX @V4M0131 00742000
N9 EQU 9 ADJUST BUFFER PTR @V4M0131 00743000
L3 EQU 3 LENGTH @V4M0131 00744000
L4 EQU 4 LENGTH @V4M0131 00745000
EJECT 00746000
*. 00747000
* QUERY HOLD 00748000
* 00749000
* COMMAND FORMAT 00750000
* 00751000
* +----------+----------+ 00752000
* | QUERY | HOLD | 00753000
* +----------+----------+ 00754000
* 00755000
* 1. SCAN RDR PRT AND PUN SPOOL FIELS TO COUNT HOLD 00756000
* 2. FORMAT HOD RESPONSE FOR FILE COUNT 00757000
* 3. WRITE HOLD COUNT RESPONSE 00758000
* 4. SCAN HOLD BUFFER QUEUE FOR USER HOLD RECORDS 00759000
* 5. FORMAT RESPONSE FOR EACH USER RECORD 00760000
* 6. STACK USER HOLD RECORD RESPONSE 00761000
* 00762000
* RESPONSE 00763000
* 00764000
* HELD: NNN RDR, NNN PRT, NNN PUN 00765000
* 00766000
* USERID PRT, USERID PUN, USERID ALL, ... 00767000
* ... ... ... 00768000
* 00769000
*. 00770000
QRYHOLD LA R0,8 GET STORAGE FOR BUFFER AREA @V386198 00771000
CALL DMKFREE @V200930 00772000
LR R6,R1 SAVE ADDRESS OF BUFFER GOTTEN @V200930 00773000
USING HELDFILE,R6 AND ESTABLISHED ADDRESSABILITY @V200930 00774000
MVC HELDFILE(32),HELDMSG @V200930 00775000
L R7,=A(DMKRSPRD) LOAD ADDR. OF RDR SPOOL BLKS @V200930 00776000
L R7,0(,R7) " " " @V200930 00777000
BAL R9,SCANRSP SCAN FOR ALL RDR FILES HELD @V200930 00778000
LTR R1,R1 WERE ANY FILE BEING "HELD" ? @V200930 00779000
BZ *+8 NO,, BRANCH -LEAVE LINE ALONE @V200930 00780000
STCM R1,7,HELDFILE+7 STORE NUM OF FILES HELD @V200930 00781000
L R7,=A(DMKRSPPR) LOAD ADDRESS OF PRT SPOOL BLOCKS@V200930 00782000
L R7,0(,R7) " " " @V200930 00783000
BAL R9,SCANRSP SCAN FOR ALL PRINTER FILES HELD @V200930 00784000
LTR R1,R1 WERE ANY "HELD" FILES FOUND / @V200930 00785000
BZ *+8 NO,, BRANCH @V200930 00786000
STCM R1,7,HELDFILE+16 STORE NUM. OF FILES FOUND @V200930 00787000
L R7,=A(DMKRSPPU) LOAD ADDRESS OF PUNCH SPOOL BLKS@V200930 00788000
L R7,0(,R7) " " " @V200930 00789000
BAL R9,SCANRSP SCAN FOR ALL PUNCH FILES. @V200930 00790000
LTR R1,R1 WERE ANY FOUND ? @V200930 00791000
BZ *+8 NO,, TAKE THE BRANCH @V200930 00792000
STCM R1,7,HELDFILE+25 STORE NUM OF FILES FOUND @V200930 00793000
LA R0,32 SET LNG OF LINE @V200930 00794000
LA R1,HELDFILE AND ALSO ITS ADDRESS @V200930 00795000
BAL R3,STACK STACK OUTPUT @V200930 00796000
LA R0,1 @V200930 00797000
LA R1,BLANKS @V200930 00798000
BAL R3,STACK STACK FOR OUTPUT @V200930 00799000
L R7,=A(DMKRSPHQ) LOAD ADDRESS OF FIRST HELD BLOCK@V200930 00800000
L R7,0(,R7) " " " @V200930 00801000
LR R5,R6 SAVE ADDRESS OF BUFFER @V200930 00802000
NXTLINE LR R6,R5 LOAD R6 W/ADDRESS OF BUFFER @V200930 00803000
MVI HELDFILE,C' ' STORE BLANK INTO FIRST POSITION @V200930 00804000
MVC HELDFILE+1(63),HELDFILE NOW CLEAR REMAINING @V200930 00805000
SR R1,R1 CLEAR REG 1 @V200930 00806000
BAL R9,SCANSHQ FIND ANY FILES BEING HELD @V200930 00807000
LTR R1,R1 WERE ANY FOUND ? @V200930 00808000
BZ HELDBUF IFNOT,, FRET THE BUFFER @V200930 00809000
LR R0,R1 SAVE LNG OF PRINT LINE @V200930 00810000
LR R1,R5 GET ADDRESSFIRST BYTE OF @V200930 00811000
BAL R3,STACK STACK FOR OUTPUT @V200930 00812000
LTR R7,R7 ARE THERE MORE FILES BEING "HELD"@V200930 00813000
BNZ NXTLINE IF YES,, FIND ALL OF THEM. @V200930 00814000
SPACE 00815000
HELDBUF LR R1,R5 GET ADDRESS OF THE BUFFER @V200930 00816000
LA R0,8 ALSO GET THE SIZE @V200930 00817000
CALL DMKFRET NOW FRET IT @V200930 00818000
B QRYEXIT AND EXIT FROM THIS MODULE @V200930 00819000
SPACE 00820000
SCANRSP SR R1,R1 GPR USED FOR COUNT @V200930 00821000
USING SFBLOK,R7 ESTABLISH ADDRESSABILITY @V200930 00822000
NXTRSP LTR R7,R7 IS THERE AN SFBLOK PRESENT @V200930 00823000
BZ CVTBD NO,, BRANCH @V200930 00824000
TM SFBFLAG,SFBUHOLD+SFBSHOLD IS FILE BEING HELD ? @V200930 00825000
L R7,0(,R7) GET ADDRESS OF NEXT SPOOL BLOCK. @V200930 00826000
BZ NXTRSP IF FILE NOT HELD ,,TRY NEXT ONE. @V200930 00827000
LA R1,1(0,R1) ADD 1 TO ACCUMULATE THE TOTAL @V200930 00828000
B NXTRSP CHECK FOR MORE @V200930 00829000
SPACE 00830000
CVTBD LTR R1,R1 WERE ANY "HELD" FILES FOUND ? @V200930 00831000
BZ 0(,R9) NO,, RETURN TO "QRYHOLD" LOGIC @V200930 00832000
CALL DMKCVTBD CONVERT TO PRINTABLE CHARS. @V200930 00833000
BR R9 RETURN TO CALLER @V200930 00834000
DROP R7 @V200930 00835000
SPACE 1 00836000
USING SHQBLOK,R7 ESTABLISH ADDRESSABILITY @V200930 00837000
SCANSHQ LTR R7,R7 IS THERE AN SHQBLOK HERE ? @V200930 00838000
BZ 0(,R9) IF NOT,, RETURN @V200930 00839000
MVI HELDFILE+9,C'-' PUT IN A DASH. @V200930 00840000
TM SHQSHOLD,TYPPRT+TYPPUN IS THIS FILE BEING HELD ?@V200930 00841000
BZ NOTHELD IF NOT,, NO PROCESSING IS INVOLED@V200930 00842000
MVC HELDFILE(8),SHQUSER MOVE IN THE USERIDFILETHE @V200930 00843000
BO BOTHHELD BRANCH,, IF BOTH PRINTER + PUN @V200930 00844000
TM SHQSHOLD,TYPPRT IS IT THE PRINTER ONLY ? @V200930 00845000
BO PRTHELD YEP,, PRINTER ONLY @V200930 00846000
MVC HELDFILE+11(3),=C'PUN' HERE IF A PUNCH @V200930 00847000
B BUMPPTR BUMP POINTER @V200930 00848000
PRTHELD MVC HELDFILE+11(3),=C'PRT ' PRINTER FILE @V200930 00849000
B BUMPPTR BUMP POINTER @V200930 00850000
BOTHHELD MVC HELDFILE+11(3),=CL5'ALL ' BOTH HELD @V200930 00851000
BUMPPTR LA R1,16(,R1) FIND NEXT ADDRESS IN BUFFER. @V200930 00852000
LR R6,R5 GET BASE ADDRESS OF BUFFER @V200930 00853000
AR R6,R1 NOW ADD THE INDEX POINTER TO IT @V200930 00854000
NOTHELD L R7,0(,R7) GET NEXT SHQBLOK CHAIN POINTER @V200930 00855000
CH R1,=H'60' IS THIS LINE FULL UP ? @V200930 00856000
BH 0(,R9) IF SO,, BETTER GO PRINT THE LINE @V200930 00857000
LR R3,R6 GET BUFFER POSITION @V200930 00858000
S R3,F2 BACK IT UP BY TWO BYTES. @V200930 00859000
MVI 0(R3),C',' MOVE IN THE COMMA. @V200930 00860000
B SCANSHQ IF NOT,, SCAN FOR ANOTHER SHQBLOK@V200930 00861000
SPACE 00862000
DROP R6,R7 @V200930 00863000
EJECT 00864000
*. 00865000
* QUERY PRIORITY 00866000
* 00867000
* COMMAND FORMAT 00868000
* +--------+-------------------------+ 00869000
* | QUERY | PRIORITY USERID | 00870000
* +--------+-------------------------+ 00871000
* 00872000
* 1. FORMAT PRIORITY RESPONSE FOR USER 00873000
* 2. WRITE PRIORITY RESPONSE 00874000
* 00875000
* RESPONSE 00876000
* 00877000
* USERID PRIORITY = NN 00878000
* 00879000
*. 00880000
QRYPRIOR CALL DMKSCNFD LOCATE USERID @V386198 00881000
BNZ CQR020 NONE FOUND @V200930 00882000
CL R0,F8 IF USERID IS OVER EIGHT @V200930 00883000
BH CQR020 WE HAVE AN ERROR - GO TELL USER @V200930 00884000
STM R0,R1,SAVER0 SAVE LENGTH AND ADDRESS @V200930 00885000
CALL DMKSCNAU GET VMBLOK ADDRESS @V200930 00886000
BNZ CQR045 BRANCH IF USER NOT ON @V200930 00887000
LR R10,R1 USERID VMBLOK ADDRESS TO R10 @V200930 00888000
DROP R11 @V200930 00889000
USING VMBLOK,R10 @V200930 00890000
MVC SAVEWRK2(8),VMUSER STORE USERID INTO MSG LINE @V200930 00891000
SLR R1,R1 @V200820 00892000
IC R1,VMUPRIOR PICK UP USER PRIORITY VALUE @V200820 00893000
DROP R10 @V200930 00894000
USING VMBLOK,R11 @V200930 00895000
CALL DMKCVTBD CONVERT TO DECIMAL @V200930 00896000
MVC SAVEWRK2+8(12),=C' PRIORITY = ' PRIORITY MESSAGE@V200930 00897000
STCM R1,3,SAVEWRK2+20 INSERT PRIORITY VALUE @V200930 00898000
LA R0,22 SET LNG OF LINE @V200930 00899000
LA R1,SAVEWRK2 AND THE ADDRESS @V200930 00900000
B QRYWRIT SEND THE RESPOMSE AND EXIT. @V200930 00901000
EJECT 00902000
*. 00903000
* QUERY TERMINAL 00904000
* 00905000
* COMMAND FORMAT 00906000
* 00907000
* +---------+--------------+ 00908000
* | QUERY | TERMINAL | 00909000
* +---------+--------------+ 00910000
* 00911000
* 1. FORMAT RESPONSE FOR TERMINAL 00912000
* 2. WRITE RESPONSE 00913000
* 00914000
* RESPONSE 00915000
* 00916000
* LINEND XXX, LINEDEL XXX, CHARDEL XXX, ESCAPE XXX, TABCHAR XXXHRC101DK 00917590
* LINESIZE NNN, ATTN XXX, APL XXX, TEXT XXX, MODE XX, HILIGHT XHRC101DK 00918180
* AUTOCR XXX, MORE NNN NNN, HOLD XXX, TIMESTAMP XXX HRC101DK 00918770
*+ |...+....1....+....2....+....3....+....4....+....5....+....6HRC101DK 00919360
*. 00920000
SPACE 2 00921000
QRYTERM EQU * @V200930 00922000
LA R0,8 SIZE OF BUFFER AREA @V387398 00923000
CALL DMKFREE HAVE DMKFREE GET IT FOR USE @V200930 00924000
LR R3,R1 REMEMBER ITS ADDRESS @V200930 00925000
USING TERMLINE,R3 ADDRESSABILITY @V200930 00926000
MVC TERMLINE(L'TERMSG),TERMSG @V60A6B6 00927000
SPACE 00929000
L R7,VMTLEND LOAD "LINEND/LINEDEL/CHARDEL/ESCA@V200820 00930000
* "LINEND/LINEDEL/CHARDEL/ESCAPE" 00931000
L R6,=C' OFF' STANDARD VALUE @V200930 00932000
STCM R7,8,TERMLINE+8 ASSUME CHAR IS VALID @V200930 00933000
STCM R7,4,TERMLINE+21 ASSUME CHAR IS LINE DELETE @V200930 00934000
STCM R7,2,TERMLINE+34 ASSUME CHAR IS CHAR DELETE @V200930 00935000
STCM R7,1,TERMLINE+46 ASSUME CHAR IS ESCAPE CHAR @V200930 00936000
CLI VMTLEND,X'00' IS LINEND CHARACTER DEFINED ? @V200820 00937000
BNE *+8 YES - @V200820 00938000
STCM R6,7,TERMLINE+7 STORE "OFF" @V200930 00939000
CLI VMTLDEL,X'00' IS LINE DELETE CHARACTER DEFINED @V200820 00940000
BNE *+8 YES - @V200820 00941000
STCM R6,7,TERMLINE+20 STORE "OFF" @V200930 00942000
CLI VMTCDEL,X'00' IS CHARACTER DELETE DEFINED ? @V200820 00943000
BNE *+8 YES - @V200820 00944000
STCM R6,7,TERMLINE+33 STORE "OFF" @V200930 00945000
CLI VMTESCP,X'00' IS ESCAPE CHARACTER DEFINED ? @V200820 00946000
BNE *+8 YES - @V200820 00947000
STCM R6,7,TERMLINE+45 STORE "OFF" @V200930 00948000
SPACE 00948150
CLI VMGRFTAB,X6A IS TABCHAR EQUAL TO "ON" VALUE? @V60A6B6 00948300
BE WRTERMLN YES, ALL SET TO WRITE THE LINE @V60A6B6 00948450
CLI VMGRFTAB,X00 IS TABCHAR DEFINED ? @V60A6B6 00948600
BNE TABCMOVE YES, GO PUT IT INTO THE OUTPUT @V60A6B6 00948750
STCM R6,B'0111',TERMLINE+58 STORE "OFF" @V60A6B6 00948900
B WRTERMLN AND GO TO WRITE THE LINE @V60A6B6 00949050
TABCMOVE MVC TERMLINE+59(1),VMGRFTAB MOVE IN TABCHAR VALUE @V60A6B6 00949200
MVI TERMLINE+58,X40 CLEAR THE REST OF THE TABCHAR @V60A6B6 00949350
SPACE 00949500
WRTERMLN LA R0,L'TERMSG SET MSG LNG @V60A6B6 00949650
LA R1,TERMLINE AND ALSO ITS ADDRESS @V200930 00950000
CALL DMKQCNWT,PARM=NORET @V200930 00951000
MVC TERMLINE(L'TERMSG2),TERMSG2 HRC101DK 00952990
SPACE 00955000
L R8,VMTERM PICK UP TERMINAL RDEVBLOK @V200820 00956000
LTR R8,R8 IS THERE ON RIGHT NOW ? @V200820 00957000
BNP QRYTRMF NO -- GO FRET THE BUFFER AND EXIT@V200820 00958000
USING RDEVBLOK,R8 @V200820 00959000
CLI RDEVTYPC-RDEVBLOK(R8),CLASTERM IS CLASS TERMINAL 00960000
BNE *+12 NO, BYPASS TEST FOR BISYNC LINE 00961000
CLI RDEVTYPE-RDEVBLOK(R8),TYPBSC IS THIS A LINE 00962000
BE QRYTRMS YES, GET RESOURCE ID. 00963000
CLI RDEVTYPC,CLASSPEC IS THIS A 3705-BASED TERMINA@V200820 00964000
BE QRYTRMS YES - NEED TO FIND NICBLOK @V200820 00965000
SR R1,R1 CLEAR REG 1 @V200930 00966000
IC R1,RDEVLLEN INSERT TERMINAL LINE LENGHT @V200930 00967000
CALL DMKCVTBD AND CONVERT IT TO DECIMAL @V200930 00968000
STCM R1,7,TERMLINE+9 STORE IN MSG LINE @V200930 00969000
TM RDEVTFLG,RDEVATOF IS ATTN OFF ? HRC101DK 00970490
BZ *+8 IF ON BIT = 0 @V200930 00971000
STCM R6,7,TERMLINE+19 STORE "OFF" @V200930 00972000
TM RDEVTMCD,RDEVAPLP IS APL-CODE BIT ON ? (X'08'@V200820 00973000
BO *+8 YES -- @V200820 00974000
STCM R6,7,TERMLINE+28 STOR "OFF" @V200930 00975000
TM RDEVTMCD,RDEVTEXT IS TEXT-CODE BIT ON ? @V387398 00976000
BO TEXTON YES -- @V387398 00977000
STCM R6,7,TERMLINE+38 STORE "OFF" @V387398 00978000
TEXTON EQU * @V387398 00979000
B QRYTRME GO FIGURE OUT ENVIRONMENT @V200820 00983000
QRYTRMS EQU * PROCESS SECOND LINE FOR 3705 TERM@V200820 00984000
LH R7,VMTRMID 370X NCP RESOURCE REFERENCE @V200820 00985000
N R7,F4095 STRIP OFF THE DEVICE CODE @V200820 00986000
MH R7,=AL2(NICSIZE*8) CONVERT TO NICLIST INDEX @V200820 00987000
AL R7,RDEVNICL GR7 = NICBLOK ADDRESS @V200820 00988000
USING NICBLOK,R7 ... @V200820 00989000
MVC SAVEWRK8(1),NICTMCD SAVE TERMINAL STATE @V387398 00990000
MVI SAVEWRK8+1,X'FF' INDICATE NICTMCD SAVED @V387398 00991000
SLR R1,R1 @V200820 00992000
IC R1,NICLLEN LINE LENGTH IN BYTES @V200820 00993000
CALL DMKCVTBD @V200820 00994000
STCM R1,7,TERMLINE+9 SET IN OUTPUT LINE @V200820 00995000
CLI RDEVTYPC,CLASTERM IS THIS A REMOTE 3270 ? @VM03094 00999000
BNE NOAPL NO, CONTINUE @VM03094 01000000
TM NICTMCD,NICAPL IS APL ON ? @VM03094 01001000
BO *+8 YES, BYPASS OFF INDICATOR @VM03094 01002000
STCM R6,7,TERMLINE+28 STORE "OFF" @V387398 01003000
TM NICTMCD,NICTEXT IS 'TEXT' ON? @V387398 01004000
BO TSTATTN YES, BYPASS OFF INDICATOR @V387398 01005000
STCM R6,7,TERMLINE+38 STORE "OFF" HRC101DK 01006490
B TSTATTN @V387398 01007000
NOAPL EQU * @VM03094 01008000
STCM R6,7,TERMLINE+28 APL IS 'OFF' FOR 3705 @V200820 01009000
STCM R6,7,TERMLINE+38 TEXT IS 'OFF' FOR 3705 @V387398 01010000
TSTATTN CLI RDEVTYPC,CLASTERM IS THIS A BISYNC LINE @V387398 01011000
BE *+12 YES, ATTN IS OFF 01012000
TM NICFLAG,NICATOF IS ATTN ON OR OFF ? @V200820 01013000
BZ *+8 'ON' -- @V200820 01014000
STCM R6,7,TERMLINE+19 STORE "OFF" HRC101DK 01015490
QRYTRME EQU * TERMINAL ENVIRONMENT SETTING @V200820 01016000
TM VMMLEVEL,VMMCPENV ENVIR CP ?? @V200930 01017000
BO *+10 YES, OK @V200930 01018000
MVC TERMLINE+48(2),=C'VM' FLAG VM MODE HRC101DK 01019190
TM VMMLVL2,VMMHLITE HIGHLIGHT ON HRC101DK 01019380
BO WRTLINE2 YES, OK HRC101DK 01019570
STCM R6,7,TERMLINE+60 STORE OFF HRC101DK 01019760
WRTLINE2 EQU * HRC101DK 01019950
LA R0,L'TERMSG2 LENGTH OF OUTPUT LINE HRC101DK 01020140
LA R1,TERMLINE AND ALSO ITS ADDRESS @V200930 01021000
CALL DMKQCNWT,PARM=NORET GO PRINT IT @V200930 01022000
QRYTRMF EQU * RETURN THE BUFFER TO FREE STORAGE@V200820 01023000
MVC TERMLINE(L'TERMSG3),TERMSG3 HRC101DK 01023040
TM VMMLVL2,VMMAUTCR AUTOCR ON HRC101DK 01023080
BO *+8 YES, OK HRC101DK 01023120
STCM R6,7,TERMLINE+7 STORE OFF HRC101DK 01023160
SR R1,R1 CLEAR R1 HRC101DK 01023200
IC R1,VMMOREBP GET BEEP TIME HRC101DK 01023240
CALL DMKCVTBD CONVERT IT HRC101DK 01023280
STCM R1,7,TERMLINE+17 STORE IT HRC101DK 01023320
SR R1,R1 CLEAR R1 HRC101DK 01023360
IC R1,VMMORECL GET CLEAR TIME HRC101DK 01023400
CALL DMKCVTBD CONVERT IT HRC101DK 01023440
STCM R1,7,TERMLINE+21 STORE IT HRC101DK 01023480
TM VMMLVL2,VMMNHOLD NO HOLD ON ? HRC101DK 01023520
BNO *+8 NO, OK HRC101DK 01023560
STCM R6,7,TERMLINE+31 STORE OFF HRC101DK 01023600
TM VMMLEVEL,VMMSTMP TIME STAMP ON ? HRC101DK 01023640
BO WRTLINE3 HRC101DK 01023680
STCM R6,7,TERMLINE+46 STORE OFF HRC101DK 01023720
WRTLINE3 EQU * HRC101DK 01023760
LA R0,L'TERMSG3 LENGTH OF OUTPUT LINE HRC101DK 01023800
LA R1,TERMLINE AND ALSO ITS ADDRESS HRC101DK 01023840
CALL DMKQCNWT,PARM=NORET GO PRINT IT HRC101DK 01023880
LR R1,R3 SET UP R0 AND R1 TO @V200930 01024000
LA R0,8 "FRET" THIS BUFFER @V387398 01025000
CALL DMKFRET @V200930 01026000
DROP R3,R7,R8 @V200820 01027000
B QRYEXIT RETURN TO DMKCFM @V200930 01028000
SPACE 2 01028200
X00 EQU X'00' @V60A6B6 01028400
X40 EQU X'40' @V60A6B6 01028600
X6A EQU X'6A' @V60A6B6 01028800
EJECT 01029000
* @V4075A0 01030000
* QUERY AFFINITY CLASS A + E USERS ONLY @V4075A0 01031000
* @V4075A0 01032000
* COMMAND FORMAT @V4075A0 01033000
* @V4075A0 01034000
* +---------+-------------------------+ @V4075A0 01035000
* | QUERY | AFFINITY (USERID) | @V4075A0 01036000
* +---------+-------------------------+ @V4075A0 01037000
* @V4075A0 01038000
* RESPONSE: @V4075A0 01039000
* @V4075A0 01040000
* USERID PROCESSOR AFFINITY @V4075A0 01041000
* .... ... @V4075A0 01042000
* @V4075A0 01043000
* METHOD OF OPERATION @V4075A0 01044000
* 1. IF USERID SPECIFIED, CALL DMKSCNAU @V4075A0 01045000
* 2. IF NOT FOUND, ISSUE DMKCQR045 & EXIT @V4075A0 01046000
* 3. ISSUE HEADER MESSAGE @V4075A0 01047000
* 4. GET SPACE FOR DATA MESSAGES @V4075A0 01048000
* 5. IF SINGLE USER, FILL IN HIS USERID AND AFFINITY ST@V4075A0 01049000
* WRITE RESPONSE, FREE BUFFER & EXIT @V4075A0 01050000
* 6. ELSE, SET FLAG FOR NONE FOUND @V4075A0 01051000
* 7. DO 8+9 FOR EACH USER IN THE VMBLOK CHAIN @V4075A0 01052000
* 8. TEST VMAFFON FOR AFFINITY SET @V4075A0 01053000
* 9. IF AFFINITY SET, FILL IN USERID AND PROCESSOR ADDR@V4075A0 01054000
* WRITE MESSAGE, AND SET FLAG FOR AFFINITY FOUND @V4075A0 01055000
* 10. IF FLAG SHOWS NO AFFINITY FOUND, WRITE MESSAGE 'NO@V4075A0 01056000
* 11. FREE BUFFER AND EXIT @V4075A0 01057000
* @V4075A0 01058000
* REGISTER USAGE: @V4075A0 01059000
* @V4075A0 01060000
* R3 - INTERNAL LINKAGE @V4075A0 01061000
* R5 - BUFFER POINTER @V4075A0 01062000
* R6 - AFFINITY FLAG FOUNK @V4075A0 01063000
* R10 - VMBLOK POINTER OF QUERIED USER @V4075A0 01064000
* @V4075A0 01065000
QRYAFF EQU * @V4075A0 01066000
SR R10,R10 SECONDARY VMBLOK POINTER @V4075A0 01067000
CALL DMKSCNFD R0 = LEN, R1 -> FIELD. INPUT TO US @V4075A0 01068000
BNZ AFFALL NO MORE PARMS, DO FOR EVERYBODY @V4075A0 01069000
CALL DMKSCNAU USE PARM AS USERID, FIND HIS VMBLOK @V4075A0 01070000
BNZ CQR026 PARM IS NOT A USERID. TOO BAD @V4075A0 01071000
LR R10,R1 SAVE VMBLOK POINTER @V4075A0 01072000
AFFALL LA R0,L'AFFHDR @V4075A0 01073000
LA R1,AFFHDR START WITH HEADER MESSAGE @V4075A0 01074000
CALL DMKQCNWT,PARM=NORET @V4075A0 01075000
LA R0,3 A LITTLE DYNAMIC BUFFER SPACE @V4075A0 01076000
CALL DMKFREE @V4075A0 01077000
LR R5,R1 SAVE ITS NAME @V4075A0 01078000
LTR R10,R10 WAS IT ALL USERS? OR ONLY ONE? @V4075A0 01079000
BZ AFFORALL ALL USERS @V4075A0 01080000
BAL R3,DOMSG DO FOR 1 USER @V4075A0 01081000
AFFEX LR R1,R5 FIRST RETURN THE DYNAMIC BUFFER @V4075A0 01082000
LA R0,3 @V4075A0 01083000
CALL DMKFRET @V4075A0 01084000
B QRYEXIT THEN RETURN @V4075A0 01085000
SPACE 2 @V4075A0 01086000
AFFORALL EQU * @V4075A0 01087000
SR R6,R6 SET TO NO AFFINITY FOUND @V4075A0 01088000
LR R10,R11 @V4075A0 01089000
******** MAY HAVE TO ADD SOME INSTRUCTIONS HERE @V4075A0 01090000
AFFLOOP TM VMAFF-VMBLOK(R10),VMAFFON DOES THIS USER HAVE@V4075A0 01091000
BZ AFFNEXT SKIP HIM IF NOT @V4075A0 01092000
BAL R3,DOMSGA SEND MESSAGE DESCRIBING HIS AFFINI@V4075A0 01093000
LA R6,1(R6) SET TO AFFINITY FOUND @V4075A0 01094000
AFFNEXT L R10,VMPNT-VMBLOK(R10) POINT TO NEXT USER @V4075A0 01095000
CR R11,R10 HAVE WE COME FULL CIRCLE? @V4075A0 01096000
BNE AFFLOOP NO -> KEEP GOING AROUND @V4075A0 01097000
LTR R6,R6 DID ANYBODY HAVE AFFINITY? @V4075A0 01098000
BNZ AFFEX YES, GO FREE SPACE AND EXIT @V4075A0 01099000
MVC AFFSTATE-AFFRESP(4,R5),=C'NONE' TELL OPERATOR @V4075A0 01100000
MVC AFFUSID-AFFRESP(8,R5),BLANKS @V4075A0 01101000
BAL R3,AFFWR THERE IS NO AFFINITY @V4075A0 01102000
B AFFEX THEN CLOSE DOWN @V4075A0 01103000
SPACE 2 @V4075A0 01104000
USING AFFRESP,R5 @V4075A0 01105000
DOMSG TM VMAFF-VMBLOK(R10),VMAFFON DOES USER HAVE AFF? @V4075A0 01106000
BO DOMSGA YES @V4075A0 01107000
MVC AFFSTATE,=C'NONE' ONLY GO THROUGH HERE FOR 1 U@V4075A0 01108000
B AFFUSER SO WE CAN DESTROY BUFFER CONTENTS @V4075A0 01109000
SPACE 1 @V4075A0 01110000
DOMSGA IC R1,VMAFF-VMBLOK(R10) GET PROCESSOR ADDR @V4075A0 01111000
N R1,=F'63' ELIMINATE FLAG BIT IN FIELD @V4075A0 01112000
CALL DMKCVTBD CONVERT TO EBCDIC OUTPUT FORMAT @V4075A0 01113000
STCM R1,3,AFFSTATE PICK UP TWO DIGIT MAXIMUM @V4075A0 01114000
MVC AFFSTATE+2(2),BLANKS NICE FORMATTING @V4075A0 01115000
SPACE 1 @V4075A0 01116000
AFFUSER MVC AFFUSID,VMUSER-VMBLOK(R10) PUT IN HIS USERID @V4075A0 01117000
AFFWR LA R0,LAFFRESP @V4075A0 01118000
MVC AFFUSID+8(2),BLANKS UNFILLED FIELD (FORMATTING)@V4075A0 01119000
LR R1,R5 @V4075A0 01120000
CALL DMKQCNWT,PARM=NORET @V4075A0 01121000
BR R3 @V4075A0 01122000
DROP R5 @V4075A0 01123000
SPACE 3 @V4075A0 01124000
AFFHDR DC C' USERID PROCESSOR AFFINITY' @V4075A0 01125000
AFFRESP DSECT @V4075A0 01126000
AFFUSID DS CL8 THIS IS WHAT WE OUTPUT @V4075A0 01127000
DS CL2 UNDER THE HEADER @V4075A0 01128000
AFFSTATE DS CL4 @V4075A0 01129000
LAFFRESP EQU *-AFFRESP @V4075A0 01130000
DMKCQR CSECT @V4075A0 01131000
EJECT @V4075A0 01132000
HELDMSG DC C'HOLD : NO RDR, NO PRT, NO PUN' @V3E7466 01133000
TERMSG DC C'LINEND X , LINEDEL X , CHARDEL X , ESCAPE X , TABC+01133600
HAR ON ' @V60A6B6 01134200
TERMSG2 DC C'LINESIZE NNN, ATTN ON , APL ON , TEXT ON , MODE CP, HI*01135190
LIGHT ON ' HRC101DK 01135380
TERMSG3 DC C'AUTOCR ON , MORE 050 010, HOLD ON , TIMESTAMP ON ' *01135570
NEW FUNCTION HRC101DK 01135760
CPUMSG DC C'CPUID = FF' @V3E7466 01136000
LCPUMSG EQU 24 MESSAGE LENGTH @V3E7466 01137000
SPACE 1 01138000
CQR020 LA R2,RC20 ERROR RETURN CODE = 20 @V3E7466 01139000
B NOPARM ERROR MESSAGE @V200930 01140000
SPACE 01141000
CQR026 LA R2,RC26 ERROR RETURN CODE = 26 @V3E7466 01142000
B NOPARM ERROR MESSAGE @V200930 01143000
SPACE 01144000
CQR028 LA R2,RC28 ERROR RETURN CODE = 28 @V3E7466 01145000
B NOPARM ERROR MESSAGE @V200930 01146000
SPACE 01147000
CQR045 LA R2,RC45 ERROR RETURN CODE = 45 @V3E7466 01148000
LM R0,R1,SAVER0 GET PARMS @V200930 01149000
B CALLERM ERROR MESSAGE @V200930 01150000
SPACE 01151000
NOPARM SR R1,R1 NO ERROR PARMS @V200930 01152000
CALLERM ICM R0,14,MODID+3 GET MODULE ID @V200930 01153000
CALL DMKERMSG WRITE ERROR MESSAGE @V200930 01154000
SPACE 01155000
* DMKERMSG WILL EXIT AND NOT RETURN HERE .... 01156000
* 01157000
SPACE 01158000
RC20 EQU 20 ERROR RETURN CODE = 20 @V3E7466 01159000
RC26 EQU 26 ERROR RETURN CODE = 26 @V3E7466 01160000
RC28 EQU 28 ERROR RETURN CODE = 28 @V3E7466 01161000
RC45 EQU 45 ERROR RETURN CODE = 45 @V3E7466 01162000
LTORG @V200930 01163000
SPACE 01164000
HELDFILE DSECT @V200930 01165000
DS 0CL64 @V200930 01166000
SPACE 01167000
TERMLINE DSECT @V200930 01168000
DS 0CL64 @V60A6B6 01169000
SPACE 01170000
SETHDR DSECT @V200930 01171000
DS 0CL64 @V200930 01172000
EJECT 01173000
PSA , @V306638 01174000
COPY DEVTYPES @V306638 01175000
COPY EQU @V306638 01176000
COPY NETWORK @V306638 01177000
COPY RBLOKS @V306638 01178000
COPY SAVE @V306638 01179000
COPY SPOOL @V306638 01180000
COPY VBLOKS @V306638 01181000
COPY VMBLOK @V306638 01182000
END DMKCQR 01183000