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