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 <SPOOLID|ALL> 00148000
* USERID FILE CLASS RECDS CPY HOLD DATE TIME NAME TYPE DIST 00149000
* 00150000
* QUERY READER/PRINTER/PUNCH <TBL> 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