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