CQH TITLE 'DMKCQH (CP) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000 *. 00003000 * 00004000 * MODULE NAME - 00005000 * DMKCQH 00006000 * 00007000 * FUNCTION - 00008000 * TO RETURN TO THE REQUESTOR INFORMATION FOR THE FOLLOWING 00009000 * QUERY FUNCTIONS : 00010000 * QUERY RDR, PRT, PUN (WITH OPTIONS ) 00011000 * 00012000 * ATTRIBUTES - 00013000 * REENTRANT, PAGEABLE, CALLED VIA SVC 00014000 * 00015000 * ENTRY POINTS - 00016000 * DMKCQHQU - TO PROCESS THE 'QUERY RDR' COMMAND 00017000 * - TO PROCESS THE 'QUERY PRT' COMMAND 00018000 * - TO PROCESS THE 'QUERY PCH' COMMAND 00019000 * 00020000 * 00021000 * ENTRY CONDITIONS - 00022000 * GPR6 - BRANCH TABLE INDEX VALUE 00022500 * GPR9 - ADDRESS OF THE COMMAND LINE BUFFER 00023000 * GPR11 - ADDRESS OF THE VMBLOK 00024000 * GPR12 - ADDRESS OF THE ENTRY POINT 00025000 * GPR13 - ADDRESS OF THE STANDARD SAVE AREA 00026000 * 00027000 * EXIT CONDITIONS - 00028000 * NORMAL - 00029000 * GPR2 = 0 00030000 * 00031000 * ERROR - 00032000 * GPR2 = ERROR MESSAGE CODE NUMBER 00033000 * 00034000 * NOTE: RETURN IS MADE DIRECTLY TO DMKCFM VIA USE OF SVC 16 00035000 * 00037000 * CALLS TO OTHER ROUTINES - 00038000 * DMKSCNFD - TO LOCATE THE NEXT ARGUMENT IN THE COMMAND BUFFER 00039000 * DMKSCNAU - TO FIND THE VMBLOK FOR A SPECIFIC USERID 00040000 * DMKSCNVU - TO FIND CONTROL BLOKS FOR A VIRTUAL DEVICE 00041000 * DMKCVTHB - TO CONVERT HEXADECIMAL ADDRESS TO BINARY 00042000 * DMKCVTDB - TO CONVERT A DECIMAL NUMBER TO BINARY 00043000 * DMKCVTBD - TO CONVERT A BINARY NUMBER TO DECIMAL 00044000 * DMKCVTBH - TO CONVERT A BINARY NUMBER TO HEXADECIMAL 00045000 * DMKFREE - TO OBTAIN STORAGE FOR REGISTER SAVE 00046000 * DMKFRET - TO RETURN STORAGE TO THE SYSTEM 00047000 * DMKQCNWT - TO OUTPUT MESSAGES TO THE TERMINAL 00048000 * DMKSCNRN - TO GET REAL DEVICE NAME 00049000 * DMKERMSG - TO OUTPUT ERROR MESSAGES TO THE TERMINAL. 00050000 * DMKSCNRD - TO GET THE ADDRESS OF A DEVICE. 00051000 * DMKSCNVN - TO GET A DEVICE NAME. 00052000 * DMKCVTDT - TO GET THE DATE AND TIME. 00053000 * DMKCFCSC - SCAN OPERAND FOR RANGE OF ADDRESSES 00054000 * DMKPGTVG - GET A SYSTEM VIRTUAL PAGE FOR SPLINK BUFFER 00055000 * DMKPGTVR - GIVE BACK THE SYSTEM VIRTUAL PAGE 00056000 * DMKRPAGT - READ IN THE FIRST DASD BUFFER OF A SPOOL FILE 00057000 * 00058000 *EXTERNAL REFERENCES - 00059000 * NONE 00060000 * 00061000 * TABLES/WORKAREAS - 00062000 * NONE 00063000 * 00064000 * REGISTER USAGE - 00065000 * GPR0 - LENGTH OF ARGUMENT IN LINE BUFFER(RETURNED BY DMKSCNFD 00066000 * GPR1 - ADDRESS OF NEXT ARGUMENT(RETURNED BY DMKSCNFD) 00067000 * GPR2 - PARAMETERS PASSED TO CALLED ROUTINES 00068000 * GPR3 - WORK REG AND INDEX FOR BXLE'S 00069000 * GPR4 - WORK REG AND INCREMENT REG FOR BXLE'S 00070000 * GPR5 - WORK REGISTER AND COMPARAND REG FOR BXLE'S 00071000 * GPR6 - BRANCH INDEX VALUE 00072000 * - ADDRESS OF RCHBLOK OR VCUBLOK 00072500 * GPR7 - ADDRESS OF RCUBLOK OR VCUBLOK 00073000 * GPR8 - ADDRESS OF RDEVBLOK OR VDEVBLOK 00074000 * GPR9 - ADDRESS OF COMMAND LINE BUFFER 00075000 * GPR10 - WORK REGISTER 00076000 * GPR11 - ADDRESS OF THE VMBLOK 00077000 * GPR12 - MODULE BASE REGISTER 00078000 * GPR13 - SAVEAREA BASE 00079000 * GPR14 - LINKAGE REGISTER 00080000 * GPR15 - LINKAGE REGISTER 00081000 * 00082000 EJECT 00083000 * COMMAND FORMAT - 00084000 * 00085000 * 00086000 * CLASS G 00087000 * 00088000 * 00089000 * +---------+-----------------------------------+ 00090000 * | QUERY | READER SPOOLID | 00091000 * | Q | PRINTER ALL | 00092000 * | | PUNCH CLASS X | 00093000 * | | TBL | 00094000 * | | | 00095000 * +---------+-----------------------------------+ 00096000 * 00097000 * 00098000 * CLASS D - 00099000 * 00100000 * +---------+---------------------------------+ 00101000 * | QUERY | READER SPOOLID | 00102000 * | Q | PRINTER ALL USERID | 00103000 * | | READER CLASS X USERID | 00104000 * | | TBL USERID | 00105000 * | | | 00106000 * +---------+---------------------------------+ 00107000 * 00108000 * OPERATION - 00109000 * 00110000 * 1. ISSUE SVC 16 TO RETURN THE SAVEAREA, THUS, WHEN EXIT 00111000 * WILL RETURN DIRECTLY TO DMKCFM COMMAND PROCESSING INSTEAD 00112000 * OF RETURNING TO THE INVOKER. 00113000 * 2. THE PROPER ROUTINE IS ENTERED VIA A BRANCH TABLE. 00113500 * REGISTER 6 IS SET UP BY DMKCFMQU TO INDEX TO THE PROPER 00114000 * BRANCH INSTRUCTION. 00114500 * 3. EACH ROUTINE SCANS THE APPROPRIATE CONTROL BLOKS TO 00115000 * PICK UP THE INFORMATION NEEDED FOR THE REQUEST AND FORMATS 00116000 * THE MESSAGE TO BE RETURNED TO THE USER. 00117000 * 4. READER - 00118000 * PUNCH - 00121000 * PRINTER - SET A FLAG IN SAVEWRK1 TO INDICATE THE TYPE OF 00122000 * REQUEST. CALL DMKSCNFD TO LOCATE THE ALL, TBL OR SPOOLID 00123000 * ARGUMENT. IF NO ARGUMENT IS FOUND LIST THE SHORT FORM 00124000 * OF FILE-ID INFORMATION. IF SPOOLID IS FOUND, CALL 00125000 * DMKCVTDB TO CONVERT THE SPOOLID TO BINARY. IF THE CONVERT 00126000 * IS BAD, CALL DMKERMSG TO SEND THE DMKCQH027E ERROR 00127000 * MESSAGE. ELSE SEARCH THE SFBLOKS FOR THIS USERID 00128000 * AND/OR SPOOLID. WHEN A SFBLOK IS FOUND, EXTRACT THE NEEDED 00129000 * INFORMATION FROM IT TO BUILD THE MESSAGE. 00130000 * IF TBL, BRING THE FIRST DASD BUFFER INTO STORAGE AND 00131000 * EXTRACT THE REQUIRED INFORMATION. CALL DMKQCNWT 00132000 * TO OUTPUT THE MESSAGE. IF 'ALL' OR 'TBL' REQUEST, KEEP 00133000 * SCANNING THE SFBLOKS UNTIL THERE ARE NO MORE AND THEN 00134000 * EXIT. IF A SPOOLID REQUEST AND THE SPOOLID WAS NOT FOUND, 00135000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCQH042E. 00136000 * 00137000 * RESPONSES - 00138000 * 00139000 * THE FOLLOWING ARE TYPICAL RESPONSES FOR THE QUERY COMMANDS 00140000 * COVERED IN THIS MODULE. XXX DENOTES A VIRTUAL ADDRESS AND 00141000 * YYY A REAL ADDRESS. 00142000 * 00143000 * 00144000 * QUERY READER/PRINTER/PUNCH 00145000 * USERID FILE CLASS RECDS CPY HOLD 00146000 * 00147000 * QUERY READER/PRINTER/PUNCH 00148000 * USERID FILE CLASS RECDS CPY HOLD DATE TIME NAME TYPE DIST 00149000 * 00150000 * QUERY READER/PRINTER/PUNCH 00151000 * USERID FILE CLASS RECDS CPY HOLD FLASH CHARS FCB MDFY FLSHC 00152000 * 00153000 * USERID - OWNER OF FILE FOR CLASS D USER REQUEST 00154000 * USERID - ORIGINATOR OF FILE FOR CLASS G REQUEST 00155000 * CLASS - 2 FIELDS, CLASS AND TYPE 00156000 * HOLD - USER/ SYS/USYS/NONE 00157000 * DATE - MM/DD, NO YEAR 00158000 * NAME TYPE - 20 CHARACTERS ONLY 00159000 * DIST - DISTRIBUTION CODE 00160000 * FLASH - FLASH OVERLAY NAME FOR THIS SPOOL FILE TO PRINT 00161000 * CHARS - CHARACTER ARR TBL TO USE ON A 3800 PRINTER 00162000 * FCB - FCB TO LOAD ON A 3800 PRINTER 00163000 * MDFY - COPY MODIFICATION NAME ON A 3800 PRINTER 00164000 * FLSHC - FLASH COUNT 00165000 * CPY - NUMBER OF COPIES TO BE PRINTED/PUNCHED. 00166000 * IF PRECEDED BY AN ASTERISK(*) AND PRINTED ON A 3800 00167000 * ONE TRANSMISSION TO 3800 IS MADE WITH THE 3800 00168000 * DOING THE REPLICATION INTERNALLY. 00169000 * 00170000 * OUTPUT DATA SAME FOR ALL FILE TYPES 00171000 * 00172000 * 00173000 * 00174000 * 00175000 * 00176000 * ERROR MESSAGES - 00177000 * DMKCQH020E USERID MISSING OR INVALID 00178000 * DMKCQH026E OPERAND MISSING OR INVALID 00179000 * DMKCQH028E CLASS MISSING OR INVALID 00180000 * DMKCQH040E DEV (ADDR) DOES NOT EXIST 00181000 * DMKCQH042E SPOOLID (NNNN) DOES NOT EXIST 00182000 * 00183000 *. 00184000 EJECT 00185000 DMKCQH CSECT 00186000 MODID DC CL8'DMKCQH' @V200930 00187000 USING PSA,R0 00188000 USING VMBLOK,R11 00189000 USING SAVEAREA,R13 00190000 SPACE 00191000 EXTRN DMKCVTDT 00192000 EXTRN DMKCVTDB 00193000 EXTRN DMKSCNVU 00194000 EXTRN DMKCVTBD 00195000 EXTRN DMKCVTBH 00196000 EXTRN DMKSCNAU 00197000 EXTRN DMKCVTHB 00198000 EXTRN DMKSCNFD 00199000 EXTRN DMKERMSG 00200000 EXTRN DMKSCNVN 00201000 EXTRN DMKSCNRN @V200930 00202000 EXTRN DMKSCNRD 00203000 EXTRN DMKCFCSC RANGE SCAN @V407466 00204000 EXTRN DMKPGTVG,DMKPGTVR,DMKRPAGT @V60B9BA 00205000 EJECT 00206000 ENTRY DMKCQHQU @VA13360 00207000 USING *,R12 00208000 DMKCQHQU SVC 16 GIVE UP SAVEAREA - USE CFMQU'S @VA13360 00209000 SL R12,=A(DMKCQHQU-DMKCQH) SET ADDRESSABILITY @VA13360 00210000 USING DMKCQH,R12 @V200930 00211000 STM R0,R1,SAVER0 SAVE REG 0-1 IN NEW SAVE AREA. 00212000 MVC SAVEWRK1(4),ZEROES ZERO FLAG AREA 00213000 SLR R2,R2 CLEAR R2 @V407466 00214000 ST R2,SAVER2 ZERO RETURN CODE @V407466 00215000 B FCNTBL(R6) BRANCH TO PROPER ROUTINE @VA13360 00215100 * 00215200 FCNTBL B QRYRDR QUERY RDR @VA13360 00215300 B QRYPRT QUERY PRT @VA13360 00215400 B QRYPU QUERY PU @VA13360 00215500 * 00215600 QRYRDR EQU * QUERY READER COMMAND @VA13360 00215700 L R10,ARSPRD ANCHOR OF RDR SFBLOKS @VMI0058 00216000 OI SAVEWRK1,RDRREQ TURN ON RDR REQUEST BIT @VMI0058 00217000 B RPPSCAN GO PROCESS THE REQUEST @VMI0058 00218000 SPACE 2 00219000 QRYPRT EQU * QUERY PRINTER COMMAND @VA13360 00220000 L R10,ARSPPR LOAD ANCHOR OF PRT SFBLOKS @VMI0058 00228000 OI SAVEWRK1,PRTREQ TURN ON PRT REQUEST BIT @VMI0058 00229000 B RPPSCAN GO PROCESS THE REQUEST @VMI0058 00230000 SPACE 2 00231000 QRYPU EQU * QUERY PUNCH COMMAND @VA13360 00232000 L R10,ARSPPU LOAD ANCHOR OF PCH SFBLOKS @VMI0058 00240000 OI SAVEWRK1,PUNREQ SET PUNCH REQUEST BIT @VMI0058 00241000 B RPPSCAN GO PROCESS THE REQUEST @VMI0058 00242000 SPACE 3 00243000 QRYWRIT EQU * WRITE A SINGLE RESPONSE LINE @VM08820 00244000 CALL DMKQCNWT,PARM=NORET GR0, GR1 ALL SET @VM08820 00245000 SPACE 00246000 QRYEXIT EQU * RETURN TO DMKCFM @VM08820 00247000 EXIT @VM08820 00248000 EJECT 00249000 * ROUTINE TO STACK OUTPUT LINES ON VMBLOK 00250000 * THE LINES WILL BE PRINTED BY DMKCFM ON RETURN 00251000 * 00252000 STACK LR R4,R0 GET SIZE OF DATA @V200930 00253000 LR R5,R1 SET DATA ADDRESS @V200930 00254000 LA R0,7(R4) ROUND UP TO DOUBLE WORD @V200930 00255000 SRL R0,3 GET SIZE IN DOUBLE WORDS @V200930 00256000 A R0,F1 ONE MORE FOR CHAINING @V200930 00257000 CALL DMKFREE GET BUFFER @V200930 00258000 MVI 0(R1),BIN0 ZERO ERROR INDICATOR @V407466 00259000 STH R4,4(R1) SAVE LINE SIZE @V200930 00260000 STH R0,6(R1) SAVE BUFFER SIZE @V200930 00261000 BCTR R4,R0 DECREMENT FOR EXECUTE @V200930 00262000 TM QRYBITS,RANGE RANGE PROCESSING @V407466 00263000 BZ EXECUTE NO, MOVE MSG TO STACK BUFFER @V407466 00264000 TM 0(R5),QRYERR ERROR MSG BEING STACKED? @V407466 00265000 LA R5,1(,R5) GO PAST INDICATOR @V407466 00266000 BO EXECUTE2 YES, IDENTIFY AS ERROR MESSAGE @V407466 00267000 EXECUTE EX R4,MVCSTK MOVE DATA TO STACK BUFFER @V407466 00268000 CLR0 SR R0,R0 CLEAR R0 @V407466 00269000 STCM R0,B'0111',1(R1) CLEAR PTR @V407466 00270000 LA R2,VMSTKO GET OUTPUT STACK POINTER @V200930 00271000 STKLOOP SLR R4,R4 CLEAR R4 @V407466 00272000 ICM R4,B'0111',1(R2) GET PTR TO STACK BUFFER @V407466 00273000 LTR R4,R4 TEST FOR END OF CHAIN @V200930 00274000 BZ CHAIN FOUND END, CHAIN THIS BUFFER @V200930 00275000 LR R2,R4 POINT TO THIS BUFFER @V200930 00276000 B STKLOOP LOOP TO FIND END @V200930 00277000 CHAIN STCM R1,B'0111',1(R2) CHAIN AT END @V407466 00278000 BR R3 RETURN @V200930 00279000 * 00280000 MVCSTK MVC 8(*-*,R1),0(R5) EXEC FOR STACK BUFFER MOVE @V407466 00281000 SPACE 00282000 EXECUTE2 EQU * @V407466 00283000 MVI 0(R1),QRYERR INDICATE ERROR IN STACK BUFFER @V407466 00284000 EX R4,MVCSTK MOVE MSG TO BUFFER @V407466 00285000 LR R2,R1 SAVE R1 TEMPORARILY @V407466 00286000 LA R0,ERRSZE SIZE OF WORK AREA IN DWDS @V407466 00287000 LR R1,R5 MSG AREA ADDRESS TO R1 FOR 'FRET'@V407466 00288000 BCTR R1,0 DECREM FOR INDICATOR BYTE @V407466 00289000 CALL DMKFRET RELEASE THE AREA @V407466 00290000 LR R1,R2 RESTORE R1 @V407466 00291000 B CLR0 BR TO ABOVE ROUTINE @V407466 00292000 SPACE 3 00293000 * EQUATES USED IN SAVEWRK1: 00294000 VIRTALL EQU X'02' QUERY VIRTUAL ALL @VM08820 00295000 RDRREQ EQU X'80' QUERY READER @VM08820 00296000 PRTREQ EQU X'40' QUERY PRINTER @VM08820 00297000 PUNREQ EQU X'20' QUERY PUNCH @VM08820 00298000 ALLREQ EQU X'10' QUERY RDR/PRT/PUN ALL @VM08820 00299000 FILIDREQ EQU X'08' QUERY RDR/PRT/PUN FILEID @VM08820 00300000 FILIDFND EQU X'04' SPOOL FILEID HAS BEEN FOUND @VM08820 00301000 HDRSENT EQU X'02' SPOOL FILE HEADER ALREADY SENT @VM08820 00302000 SRCHUSR EQU X'01' QUERY RDR/PRT/PUN USERID @VM08820 00303000 SPACE 00304000 * EQUATES USED IN SAVEWRK1+2 00305000 RANGE EQU X'80' RANGE PROCESSING @V407466 00306000 PASS1 EQU X'40' FIRST PASS SWITCH @V407466 00307000 TBLREQ EQU X'20' QUERY RDR/PRT/PUN TBL SWITCH @V60B9BA 00308000 SPACE 00309000 * MISCELLANEOUS EQUATES 00310000 QRYERR EQU X'80' ERROR MSG INDICATOR @V407466 00311000 BLANK EQU X'40' DELIMITERS @V407466 00312000 BIN0 EQU X'00' RESET INDICATOR @V407466 00313000 EJECT 00314000 RPPSCAN MVC SAVEWRK2(8),VMUSER SET USERID TO SEARCH @V200930 00315000 TM VMCLEVEL,VMCLASSD IS IT CLASS D USER ?? @V200930 00316000 BO *+8 YES DEFAULT TO SEARCH ALL FILES @V200930 00317000 OI SAVEWRK1,SRCHUSR SET TO SEARCH BY USERID @V200930 00318000 CALL DMKSCNFD LOCATE ARGUMENT IF ANY 00319000 BNZ STRTSCN START FILE SCAN @V200930 00320000 STM R0,R1,SAVEWRK8 SAVE ARGUMENT ADDRESS AND LENGTH 00321000 CL R0,F3 POSSIBLY 'ALL' OR 'TBL' @V60B9BA 00322000 BNE FILIDCVT IT COULDN'T BE @V60B9BA 00323000 CLC 0(3,R1),=C'ALL' IS IT 'ALL' ? @V60B9BA 00324000 BNE TSTD1 XFER IF NOT @V60B9BA 00325000 OI SAVEWRK1,ALLREQ TURN ON THE 'ALLREQ' BIT @V60B9BA 00326000 B TSTD2 CONTINUE @V60B9BA 00327000 TSTD1 CLC 0(3,R1),=C'TBL' IS IT 'TBL' ? @V60B9BA 00328000 BNE FILIDCVT NO, MAYBE IT'S A FILEID @V60B9BA 00329000 OI QRYBITS,TBLREQ TURN ON 'TBLREQ' BIT @V60B9BA 00330000 TSTD2 TM VMCLEVEL,VMCLASSD IS IT CLASS D USER ?? @V200930 00331000 BZ STRTSCN START FILE SCAN @V200930 00332000 CALL DMKSCNFD SCAN FOR POSSIBLE USERID @V200930 00333000 BNZ STRTSCN START FILE SCAN @V200930 00334000 TSTUSR LR R3,R0 GET SIZE @VM08771 00335000 BCTR R3,R0 SIZE FOR EXECUTE @V200930 00336000 CL R0,F8 SIZE FOR EXECUTE @VM08771 00337000 BH CQH020 NO, ERROR MESSAGE @V200930 00338000 CL R0,F1 IS IT ONE BYTE ONLY ?? @V200930 00339000 BNE SETBLK1 NO @V200930 00340000 CLI 0(R1),C'*' IS IT SELF ?? @V200930 00341000 BE SETSCH YES, SAVEWRK2 IS SET @V200930 00342000 SETBLK1 MVC SAVEWRK2(8),BLANKS PREP FIELD @V200930 00343000 EX R3,SETUSR SET USERID FOR SEARCH @V200930 00344000 SETSCH OI SAVEWRK1,SRCHUSR SET TO SEARCH BY USERID @V200930 00345000 B STRTSCN START FILE SCAN @V200930 00346000 SPACE 2 00347000 SETUSR MVC SAVEWRK2(0),0(R1) XECUTED @V200930 00348000 CLCLS CLC 0(0,R1),=C'CLASS ' @V200930 00349000 EJECT 00350000 FILIDCVT DS 0H @V200930 00351000 CALL DMKCVTDB CONVERT SPOOLID @V200930 00352000 BZ SETREQ OK, SET FOR FILE REQUEST @V200930 00353000 LM R0,R1,SAVEWRK8 RESTORE REGS @V200930 00354000 CL R0,F2 LESS THAN 2 ?? @V200930 00355000 BL TSTD3 YES, TEST FOR CLASS D @V200930 00356000 LR R3,R0 GET COUNT @V200930 00357000 BCTR R3,R0 SIZE FOR EXECUTE @V200930 00358000 EX R3,CLCLS TEST FOR CLASS @V200930 00359000 BNE TSTD3 NO, TEST FOR CLASS D @V200930 00360000 CALL DMKSCNFD GET CLASS FIELD @V200930 00361000 BNZ CQH028 ERROR, NOT THERE @V200930 00362000 CL R0,F1 IS IT MORE THAN 1 ?? @V200930 00363000 BNE CQH028 YES, ERROR @V200930 00364000 CLI 0(R1),C'A' LESS THAN 'A'? 00365000 BL CQH028 YES, TO BAD. 00366000 TRT 0(1,R1),CLTABLE TRANSLATE IT. 00367000 BNH CQH028 INVALID, TOO BAD. 00368000 MVC SAVEWRK1+1(1),0(R1) GET CLASS FOR SCAN @V200930 00369000 B TSTD2 TEST FOR D CLASS USERID @V200930 00370000 TSTD3 TM VMCLEVEL,VMCLASSD IS IT CLASS D USER ?? @V200930 00371000 BO TSTUSR YES, SEE IF USERID @V200930 00372000 B CQH026 UNKNOWN OPERAND @V200930 00373000 SETREQ LR R9,R5 SET BUFFER ADDRESS @V200930 00374000 OI SAVEWRK1,FILIDREQ TURN ON FILIDREQ BIT 00375000 LR R4,R1 SAVE FILID IN R4 00376000 B STRTSCN START SCAN @V200930 00377000 SPACE 3 00378000 ORG *-193 BACKWARD MOMENTARILY 00379000 CLTABLE EQU * ESTABLISH THE TABLE 00380000 ORG 00381000 DC C'ABCDEFGHI' THESE ARE VALID 00382000 DC XL7'00' THESE ARENT 00383000 DC C'JKLMNOPQR' THESE ARE VALID 00384000 DC XL8'00' THESE ARE NOT 00385000 DC C'STUVWXYZ' THESE ARE VALID 00386000 DC XL6'00' THESE ARE NOT 00387000 DC C'0123456789' THESE ARE OK 00388000 DC XL6'00' THESE ARE NOT 00389000 DS 0H GUARANTEE ALIGNMENT 00390000 EJECT 00391000 USING SFBLOK,R10 @V200930 00392000 SPACE 00393000 FILLOOP CH R4,SFBFILID DO FILE ID'S MATCH 00394000 BNE NXTSFB NO, GET NEXT ONE 00395000 TSTNXT TM SFBFLAG,SFBINUSE IS FILE IN USE ?? @V200930 00396000 BO NXTSFB YES, SKIP THIS ONE @V200930 00397000 TM SAVEWRK1,SRCHUSR SEARCH BY USERID ?? @V200930 00398000 BZ TSTCSH NO, SEE IF CLASS SCAN @V200930 00399000 CLC SFBUSER,SAVEWRK2 THIS FILE FOR THIS USERID ?? @V200930 00400000 BNE NXTSFB NO, CONT @V200930 00401000 TSTCSH CLI SAVEWRK1+1,X'00' SEARCH FOR CLASS ?? @V200930 00402000 BE FILEFND NO, FOUND A FILE @V200930 00403000 CLC SFBCLAS,SAVEWRK1+1 COMPARE FOR CLASS MATCH @V200930 00404000 BNE NXTSFB NO MATCH, CONT @V200930 00405000 FILEFND OI SAVEWRK1,FILIDFND INDICATE ONE WAS FOUND @V200930 00406000 B PRINT FORMAT LINE @V200930 00407000 NXTSFB L R10,SFBPNT LOAD ADDRESS OF NEXT SFBLOK 00408000 LTR R10,R10 ANY MORE IN THE CHAIN ? 00409000 BNZ TESTRET YES, CHECK IT OUT 00410000 REQEND LR R1,R9 GET BUFFER ADDRESS @V200930 00411000 LA R0,15 SIZE @V200930 00412000 CALL DMKFRET FRET BUFFER @V200930 00413000 TM SAVEWRK1,FILIDFND ANY FOUND ? 00414000 BZ NOFILES IF NOT, PRINT MESSAGE 00415000 B QRYEXIT GET OUT 00416000 TESTRET TM SAVEWRK1,FILIDREQ WAS REQUEST FOR FILID ? 00417000 BO FILLOOP YES, BRANCH 00418000 B TSTNXT DO NEXT FILE @V200930 00419000 EJECT 00420000 STRTSCN LA R0,15 BUFFER SIZE @V200930 00421000 CALL DMKFREE GET BUFFER @V200930 00422000 LR R9,R1 BUFFER ADDRESS @V200930 00423000 MVI 0(R9),X'40' SET BYTE ZERO TO A BLANK @VA12778 00423100 MVC 1(119,R9),0(R9) SET BUFFER AREA TO BLANKS @VA12778 00423200 L R10,0(R10) POINT TO FIRST SFBLOK @V200930 00424000 LTR R10,R10 TEST FOR ANY FILES TO START @V200930 00425000 BZ REQEND NO, GET OUT @V200930 00426000 B TESTRET TEST THE FILE @V200930 00427000 SPACE 3 00428000 USING REGSAVE,R9 BUFFER ADDRESSING @VMI0058 00429000 PRINT TM SAVEWRK1,HDRSENT HEADER REC. PRINTED YET ? 00430000 BO FMTDATA YES, DON'T DO IT AGAIN 00431000 OI SAVEWRK1,HDRSENT TURN ON HDRSENT BIT 00432000 MVC DATAREC(HDR1SZ),HDRG MOVE IN 'ALL' HDR @VMI0058 00433000 TM SAVEWRK1,SRCHUSR QUERY BY USERID OR OWNER ?? @V200930 00434000 BO *+10 YES, GUESSED RIGHT @V200930 00435000 MVC DATAREC(8),=CL8'OWNERID' SET OWNER ID @V200930 00436000 TM QRYBITS,TBLREQ IS IT A 'TBL' REQUEST ? @V60B9BA 00437000 BZ PRINT2 XFER IF NOT @V60B9BA 00438000 MVC DATAREC+L'HDRG(L'HDRTBL),HDRTBL MOVE 'TBL' STUFF@VMI0058 00439000 LA R0,HDR1SZ LARGE HEADER @V60B9BA 00440000 B X100 GO STACK IT @V60B9BA 00441000 SPACE 00442000 PRINT2 LA R0,HDR3SZ ASSUME SHORT LINE @V60B9BA 00443000 TM SAVEWRK1,ALLREQ+FILIDREQ IS REQ. FOR ALL OR FILID ? 00444000 BZ X100 NO, BRANCH 00445000 LA R0,HDR1SZ SIZE @V200930 00446000 MVC HDRG1,HDRALL GET THE PROPER HEADER @V60B9BA 00447000 X100 LA R1,DATAREC BUFFER ADDRESS @VMI0058 00448000 WRTHDR BAL R3,STACK STACK OUTPUT LINE @V200930 00449000 SPACE 2 00450000 USING REGSAVE,R9 BUFFER ADDRESSING @V200930 00451000 FMTDATA MVI DATAREC,C' ' @V200930 00452000 MVC DATAREC+1(DATARECL-1),DATAREC CLEAR @V200930 00453000 MVC XUSER,SFBUSER SAVE USERID 00454000 TM QRYBITS,TBLREQ 'TBL' OPTION SPECIFIED ? @V60B9BA 00455000 BZ NOTBL XFER IF NOT @V60B9BA 00456000 OI SFBFLAG,SFBINUSE CURRENTLY IN USE @VA09331 00456100 CALL DMKPGTVG GET SYSTEM VIRTUAL PAGE @V60B9BA 00457000 ST R1,SAVEWRK5 SAVE ITS ADDRESS @V60B9BA 00458000 L R0,SFBSTART DASD ADDRESS TO READ IN @V60B9BA 00459000 CALL DMKRPAGT,PARM=(BRING+SYSTEM) BRING IT IN @V60B9BA 00460000 USING SPLINK,R2 ADDRESSIBILITY @V60B9BA 00461000 MVC XCHAR,SPCHAR MOVE IN CHARS VALUE @V60B9BA 00462000 MVC XFCB,SPFCB MOVE IN THE FCB VALUE @V60B9BA 00463000 MVC XCMOD,SPCMOD MOVE IN THE MODIFY VALUE @V60B9BA 00464000 MVC XFLASH,SFBFLASH MOVE IN THE FLASH NAME @V60B9BA 00465000 OC XFLASH(8),BLANKS MAKE THEM PRINTABLE @V60B9BA 00466000 OC XFLASH+8(8),BLANKS ..... @V60B9BA 00467000 OC XFLASH+16(8),BLANKS ..... @V60B9BA 00468000 SR R1,R1 NOW GET THE FLASH COUNT @V60B9BA 00469000 IC R1,SPFLSHC THIS IS IT @V60B9BA 00470000 CALL DMKCVTBD CONVERT TO EBCDIC @V60B9BA 00471000 STCM R1,B'0011',XFLSHC MOVE IT IN @V60B9BA 00472000 TM SPFLAG1,SPCOPYFG IS FLAG SET ? @V60B9BA 00473000 BZ *+8 XFER IF NOT @V60B9BA 00474000 MVI XCOPY-1,C'*' MULTIPLE COPY TECHNIQUE @V60B9BA 00475000 L R1,SAVEWRK5 ADDRESS OF SPLINK BUFFER @V60B9BA 00476000 SR R0,R0 DUMMY DASD ADDRESS @V60B9BA 00477000 CALL DMKRPAGT,PARM=SYSTEM RELEASE CORE PAGE @V60B9BA 00478000 CALL DMKPGTVR RELEASE THE PAGE @V60B9BA 00479000 NI SFBFLAG,X'FF'-SFBINUSE NOT IN USE ANYMORE @VA09331 00479100 B AFTALL CONTINUE @V60B9BA 00480000 SPACE 00481000 NOTBL MVC XFNAME,SFBFNAME SAVE NAME OF FILE @V60B9BA 00482000 MVC XFTYPE,SFBFTYPE SAVE TYPE OF FILE 00483000 MVC XDATE,SFBDATE SAVE DATE WHEN FILE WAS CREATED 00484000 MVC XTIME,SFBTIME SAVE TIME WHEN FILE WAS CREATED 00485000 MVC XDIST,SFBDIST SAVE DISTRIBUTION CODE 00486000 AFTALL MVC XSTAT,=C'NONE' ASSUME NONE HELD @V60B9BA 00487000 TM SFBFLAG,SFBSHOLD+SFBUHOLD CHECK FOR SYS/USER 00488000 BZ GETCPY BRANCH IF NO FILES HELD 00489000 MVC XSTAT,=C'USYS' ASSUME FILE ARE HELD BY SYS AND USER 00490000 BO GETCPY BR, IF FILES HELD BY BOTH SYS AND USER 00491000 MVC XSTAT,=C'USER' ASSUME USER IS HOLDING HIS ON FILES 00492000 TM SFBFLAG,SFBUHOLD IS USER HOLDING HIS OWN FILES 00493000 BO GETCPY IF YES, BRANCH 00494000 MVC XSTAT,=C'SYS ' NO, SYSTEM IS HOLDING THEM. 00495000 EJECT 00496000 GETCPY LH R1,SFBCOPY PICK UP NUMBER OF COPY FILES 00497000 CALL DMKCVTBD CONVERT 00498000 STCM R1,3,XCOPY SAVE TOTAL 00499000 L R1,SFBRECNO LOAD NUMBER OF RECORDS IN THIS FILE 00500000 CALL DMKCVTBD CONVERT 00501000 STCM R0,3,XRECNO SET NUMBER @V200930 00502000 STCM R1,15,XRECNO+2 .. @V200930 00503000 LH R1,SFBFILID LOAD THE FILE ID 00504000 CALL DMKCVTBD 00505000 STCM R1,15,XFILID SAVE FILE-ID 00506000 MVC XCLAS,SFBCLAS SAVE CLASS CODE. 00507000 MVC XTYPE,=C'DMP' MAYBE IT'S A DUMP FILE @VM08809 00508000 TM SFBFLAG,SFBDUMP SYSTEM OR NCP DUMP ? @VM08809 00509000 BO SETREC YES -- @VM08809 00510000 SPACE 2 00511000 MVC XTYPE,=C'CON' ASSUME CONSOLE @V200930 00512000 CLI SFBTYPE,TYPPRT TEST FOR CONSOLE TYPE @V200930 00513000 BE SETREC OK @V200930 00514000 MVC XTYPE,=C'RDR' ASSUME READER @V200930 00515000 CLI SFBTYPE,TYPRDR IS IT A READER FILE @V200930 00516000 BE SETREC YES, CONT @V200930 00517000 MVC XTYPE,=C'PRT' ASSUME PRINTER @V200930 00518000 TM SFBTYPE,TYPPRT TEST FOR PRINTER @V200930 00519000 BO SETREC OK @V200930 00520000 MVC XTYPE,=C'PUN' MUST BE PUNCH @V200930 00521000 SETREC LA R1,DATAREC SET DATA AREA @V200930 00522000 TM SAVEWRK1,SRCHUSR SEARCH BY USERID ?? @V200930 00523000 BZ X106 NO, OWNER IN USERID @V200930 00524000 X108 MVC XUSER,SFBORIG SET ORIGIN @V200930 00525000 X106 LA R0,36 @V200930 00526000 TM QRYBITS,TBLREQ 'TBL' SPECIFIED ? @V60B9BA 00527000 BO X110 XFER IF SO - LONG MESSAGE @V60B9BA 00528000 TM SAVEWRK1,ALLREQ+FILIDREQ LONG FORM OF RESPONSE ? 00529000 BZ WRITREC NO, PRINT SHORT FORM 00530000 X110 LA R0,80 SIZE @V200930 00531000 WRITREC BAL R3,STACK STACK OUTPUT LINE @V200930 00532000 TM SAVEWRK1,FILIDREQ REQ FOR ONE FILE ?? @V200930 00533000 BO REQEND YES, DONE @V200930 00534000 B NXTSFB DO NEXT FILE @V200930 00535000 EJECT 00536000 NOFILES DS 0H @V200930 00537000 TM SAVEWRK1,FILIDREQ IS THIS AN 'SPOOLID' REQUEST ??? 00538000 BO CQH042 YES - SEND ERROR MESSAGE 00539000 MVC SAVEWRK2(12),=C'NO FILES' FAILURE MESSAGE @VM08820 00540000 LA R1,SAVEWRK2 START OF MESSAGE @VM08820 00541000 LA R0,12(0) . . . LENGTH @VM08820 00542000 MVC SAVEWRK2+3(3),=C'RDR' ASSUME READER QUERY @VM08820 00543000 TM SAVEWRK1,RDRREQ CORRECT ? @VM08820 00544000 BO QRYWRIT YES -- @VM08820 00545000 MVC SAVEWRK2+3(3),=C'PRT' ASSUME PRINTER QUERY @VM08820 00546000 TM SAVEWRK1,PRTREQ CORRECT ? @VM08820 00547000 BO QRYWRIT YES -- @VM08820 00548000 MVC SAVEWRK2+3(3),=C'PUN' MUST BE PUNCH QUERY @VM08820 00549000 B QRYWRIT SEND MESSAGE AND EXIT @VM08820 00550000 DROP R9,R10 @VM08820 00551000 SPACE 2 00552000 HDRG DC C'ORIGINID FILE CLASS RECDS CPY HOLD ' @VMI0058 00553000 HDRG1 DC C'DATE TIME NAME TYPE DIST' @V200930 00554000 HDR1SZ EQU *-HDRG @V200930 00555000 HDR3SZ EQU HDRG1-HDRG @V200930 00556000 HDRALL EQU HDRG1,L'HDRG1 @VMI0058 00557000 HDRTBL DC C'FLASH CHARS FCB MDFY FLSHC ' @V60B9BA 00558000 EJECT 00559000 CQH020 LA R2,20 ERROR CODE 00560000 B NOVAR ... 00561000 SPACE 00562000 CQH026 LA R2,26 ERROR CODE @V200930 00563000 B NOVAR .... @V200930 00564000 SPACE 00565000 CQH028 LA R2,28 ERROR CODE @V200930 00566000 B NOVAR .... @V200930 00567000 SPACE 00568000 CQH042 LA R2,42 ERROR CODE 00569000 LM R0,R1,SAVEWRK8 LOAD ARGUMENT LENGTH AND ADDRESS 00570000 B CALLERM .... 00571000 SPACE 00572000 NOVAR SR R1,R1 INDICATE NO VARIABLE TO MESSAGE ROTUINE 00573000 CALLERM ICM R0,14,MODID+3 INSERT MODULE IDENTITY 00574000 CALL DMKERMSG GO SEND MESSAGE WITH NO RETURN 00575000 * 00576000 * MESSAGE MODULE WILL RETURN DIRECTLY TO DMKCFM 00577000 * 00578000 SPACE 00579000 LTORG 00580000 SPACE 4 00581000 REGSAVE DSECT 00582000 REG1 DS 1F 00583000 REG2 DS 1F 00584000 REG3 DS 1F 00585000 REG4 DS 1F 00586000 REG5 DS 1F 00587000 REG6 DS 1F 00588000 REG7 DS 1F 00589000 REG8 DS 1F 00590000 SPACE 2 00591000 DATAREC DS 0C @V200930 00592000 DATARECD DS 0C @V200930 00593000 XUSER DS CL8 @V200930 00594000 DS C @V200930 00595000 XFILID DS CL4 @V200930 00596000 DS C @V200930 00597000 XCLAS DS CL1 @V200930 00598000 DS C @V200930 00599000 XTYPE DS CL3 @V200930 00600000 DS C @V200930 00601000 XRECNO DS CL6 @V200930 00602000 DS CL2 @V60B9BA 00603000 XCOPY DS CL2 @V200930 00604000 DS C @V60B9BA 00605000 XSTAT DS CL4 @V200930 00606000 DS C @V200930 00607000 XDATE DS CL5 @V200930 00608000 DS C @V200930 00609000 XTIME DS CL8 @V200930 00610000 DS C @V200930 00611000 XFNAME DS CL12 @V200930 00612000 XFTYPE DS CL8 @V200930 00613000 DS C @V200930 00614000 XDIST DS CL8 @V200930 00615000 SPACE 00616000 ORG XDATE @V60B9BA 00617000 XFLASH DS CL4 FLASH NAME @V60B9BA 00618000 DS CL3 @V60B9BA 00619000 XCHAR DS CL4 CHARS VALUE @V60B9BA 00620000 DS CL3 @V60B9BA 00621000 XFCB DS CL4 FCB VALUE @V60B9BA 00622000 DS CL2 @V60B9BA 00623000 XCMOD DS CL4 MODIFY VALUE @V60B9BA 00624000 DS CL3 @V60B9BA 00625000 XFLSHC DS CL2 FLASH COUNT @V60B9BA 00626000 DS CL5 @V60B9BA 00627000 DS CL2 @V60B9BA 00628000 ORG 00629000 DATARECL EQU *-DATAREC @V200930 00630000 SPACE 00631000 MSGERR DSECT @V407466 00632000 ERRIND DS XL1 ERROR MSG INDICATOR @V407466 00633000 ERRHDR DS CL6 ERROR MSG HEADER 'DMKCQH' @V407466 00634000 ERRCODE DS CL3 FOR MSG NUMBER @V407466 00635000 ERRSEV DS CL1 ERROR MSG SEVERITY @V407466 00636000 DS CL1 DELIMITER @V407466 00637000 ERRSZE2 EQU *-MSGERR LENGTH OF HEADER PORTION @V407466 00638000 ERRTEXT DS CL25 MSG TEXT @V407466 00639000 ERRSZE3 EQU *-MSGERR LENGTH OF FULL MSG @V407466 00640000 ERRSZE EQU ((*-MSGERR)+7)/8 SIZE OF ERROR MSG IN DWDS @V407466 00641000 SPACE 2 00642000 EJECT 00643000 PSA , @V306638 00644000 COPY DEVTYPES @V306638 00645000 COPY EQU @V306638 00646000 COPY RBLOKS @V306638 00647000 COPY SAVE @V306638 00648000 SPACE 00649000 RADDR1 EQU SAVEWRK7 FIRST ADDR IN RANGE @V407466 00650000 RADDR2 EQU SAVEWRK7+2 SECOND RADDR IN RANGE @V407466 00651000 SPACE 00652000 QRYBITS EQU SAVEWRK1+2 QUERY FLAGS @V407466 00653000 SPACE 00654000 *RANGE EQU X'80' RANGE PROCESSING 00655000 *PASS1 EQU X'40' FIRST PASS SWITCH 00656000 COPY SPOOL @V306638 00657000 COPY VBLOKS @V306638 00658000 COPY VCTCA @V306638 00659000 COPY VMBLOK @V306638 00660000 END 00661000