ibm:vm370-lib:cp:dmkcqr.assemble_src
Table of Contents
DMKCQR Source
References
- Fixes Applied : 5
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [HRC068DK]
Source Listing
- DMKCQR.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkcqr.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator