ibm:vm370-lib:cp:dmkcdm.assemble_src
Table of Contents
DMKCDM Source
References
- Fixes Applied : 0
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMKCDM.ASSEMBLE.txt
- CDM TITLE 'DMKCDM (CP) VM/370 - RELEASE 6' 00001000
- ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
- *. 00003000
- * MODULE NAME - 00004000
- * DMKCDM 00005000
- * FUNCTION - 00006000
- * TO EXECUTE THE DUMP AND DMCP COMMANDS. 00007000
- * 00008000
- * ATTRIBUTES - 00009000
- * REENTRANT, PAGEABLE, CALLED VIA SVC 00010000
- * 00011000
- * ENTRY POINTS - 00012000
- * DMKCDMDM - TO DUMP REAL STORAGE TO THE SPOOLED PRINTER. 00013000
- * DMKCDMDU - TO DUMP VIRTUAL STORAGE TO THE SPOOLED PRINTER. 00014000
- * 00015000
- * ENTRY CONDITIONS - 00016000
- * GPR9 - ADDRESS OF THE COMMAND LINE. 00017000
- * GPR11 - ADDRESS OF THE USERS VMBLOK. 00018000
- * GPR12 - ADDRESS OF THE ENTRY POINT. 00019000
- * GPR13 - ADDRESS OF THE STANDARD SAVE AREA. 00020000
- * 00021000
- * EXIT CONDITIONS - 00022000
- * NORMAL - 00023000
- * GPR2 = 0 00024000
- * 00025000
- * ERROR - 00026000
- * GPR2 = ERROR MESSAGE CODE NUMBER 00027000
- * 00028000
- * CALLS TO OTHER ROUTINES - 00029000
- * DMKSCNFD - TO LOCATE THE NEXT ARGUMENT IN THE COMMAND LINE 00030000
- * DMKCVTBD - CONVERT BINARY NUMBER TO DECIMAL 00031000
- * DMKCVTBH - CONVERT BINARY NUMBER TO HEXADECIMAL 00032000
- * DMKCVTDB - CONVERT DECIMAL NUMBER TO BINARY 00033000
- * DMKCVTHB - CONVERT HEXADECIMAL NUMBER TO BINARY 00034000
- * DMKCVTFP - CONVERT FLOATING POINT NUMBER TO PRINTABLE FORM 00035000
- * DMKFREE - TO GET STORAGE FOR AN OUTPUT BUFFER 00036000
- * DMKFRET - TO RETURN STORAGE TO THE SYSTEM 00037000
- * DMKVATAB - TO MAINTAIN SHADOW PAGE AND SEGMENT TABLES 00038000
- * DMKQCNWT - TO SEND MESSAGES TO THE TERMINAL 00039000
- * DMKVSPRT - PRINT LINE OF DUMP TO THE SPOOL PRINTER 00040000
- * DMKPTRAN - TO BRING USER PAGE INTO STORAGE 00041000
- * DMKERMSG - TO TYPE ERROR MESSAGES 00042000
- * 00043000
- * TABLES/WORKAREAS 00044000
- * ECBLOK 00045000
- * PSA 00046000
- * SAVEAREA 00047000
- * VMBLOK 00048000
- * OUTPUT BUFFER CONTAINS CONTROL INFORMATION 00049000
- * USED BY THE DUMP ROUTINES. THE FORMAT AND DESCRIPTION 00050000
- * OF THE BUFFER ARE IN A DSECT BELOW. 00051000
- * 00052000
- * REGISTER USAGE - 00053000
- * GPR0 - FIELD LENGTH REGISTER 00054000
- * GPR1 - POINTER TO NEXT FIELD IN BUFFER AND REAL STORAGE ADDR. 00055000
- * GPR2 - PARAMETER REGISTER FOR CALLED ROUTINES. 00056000
- * GPR3 - ADDRESS OF THE PAGE TABLE 00057000
- * GPR4 - BAL REGISTER (3RD LEVEL) 00058000
- * GPR5 - POINTER TO THE NEXT ARGUMENT IN THE INPUT BUFFER 00059000
- * GPR6 - LENGTH ON NEXT ARGUMENT IN THE INPUT BUFFER 00060000
- * GPR7 - BAL REGISTER (1ST LEVEL) 00061000
- * GPR8 - BAL REGISTER (2ND LEVEL) 00062000
- * GPR9 - ADDRESS OF THE COMMAND LINE 00063000
- * GPR10 - BASE REGISTER FOR THE OUTPUT BUFFER 00064000
- * GPR11 - ADDRESS OF THE VMBLOK 00065000
- * GPR12 - BASE REGISTER FOR THIS PROGRAM 00066000
- * GPR13 - ADDRESS OF THE STANDARD SAVEAREA 00067000
- * GPR14 - LINKAGE REGISTER 00068000
- * GPR15 - LINKAGE REGISTER 00069000
- * 00070000
- * NOTES - 00071000
- * NONE 00072000
- * 00073000
- * OPERATION - 00074000
- * THE COMMAND ROUTINES ARE CALLED BY THE COMMAND 00075000
- * ANALYSIS ROUTINE DMKCFM. 00076000
- * THE FORMAT AND DESCRIPTION OF EACH COMMAND IS LISTED IN 00077000
- * SEPARATE PROLOGUES BELOW. 00078000
- *. 00079000
- EJECT 00080000
- ISEQ 73,80 00081000
- COPY OPTIONS 00082000
- EJECT 00083000
- COPY LOCAL 00084000
- EJECT 00085000
- PUNCH 'SPB' 00086000
- SPACE 2 00087000
- DMKCDM START 00088000
- SPACE 00089000
- MODID DC CL8'DMKCDM' 00090000
- USING PSA,R0 00091000
- USING DISPBFR,R10 **** THIS COVERS AN INTERNAL DSECT **** 00092000
- USING VMBLOK,R11 00093000
- USING SAVEAREA,R13 00094000
- SPACE 3 00095000
- EXTRN DMKERMSG 00096000
- EXTRN DMKVSPRT @V200820 00097000
- EXTRN DMKCVTBD,DMKCVTBH,DMKCVTDB,DMKCVTHB,DMKCVTFP 00098000
- EXTRN DMKSYSRM 00099000
- EXTRN DMKSCNFD 00100000
- EXTRN DMKDMPTR 00101000
- EXTRN DMKVATAB @V200820 00102000
- EXTRN DMKSYSAP @V4075A0 00103000
- EXTRN DMKVMASH @VA08317 00103400
- EJECT 00104000
- * EQUATES FOR SAVEWRK1 ON DUMP OR DISPLAY 00105000
- DISPC EQU X'00' 00106000
- DUMPC EQU X'80' 00107000
- REALC EQU X'00' 00108000
- VIRTC EQU X'40' 00109000
- RANGE EQU X'20' 00110000
- DISLEN EQU X'10' LENGTH RANGE INDICATION @V200930 00111000
- HEXLOC EQU X'08' INDICATES A LOCATION REQUEST 00112000
- BYPGPR EQU X'02' BYPAS DUMP REGS ON NEXT ARG @V200930 00113000
- PROC1 EQU X'01' INDICATE AT LEAST ONE OPERAND PROCESSED 00114000
- SPACE 00115000
- * EQUATES FOR SAVEWRK1+1 ON DUMP OR DISPLAY 00116000
- CONVLEN EQU X'80' INDICATE TO CONVERT LENGTH @V200930 00117000
- MPREF EQU X'08' @V4075A0 00118000
- NPREF EQU X'04' @V4075A0 00119000
- CHEX EQU X'01' 00120000
- SPACE 2 00121000
- ********************************************************************* 00122000
- * SAVEWRK1 SWITCH USAGE DURING DUMP OR DISPLAY 00123000
- * SAVEWRK1 00124000
- * X'80' - 0 = DISPLAY, 1 = DUMP 00125000
- * X'40' - 0 = REAL MACHINE, 1 = VIRTUAL MACHINE 00126000
- * X'20' - 0 = ONLY ONE ADDRESS, 1 = RANGE OF ADDRESSES 00127000
- * X'10' - 0 = NO LENGTH, 1 = LENGTH RANGE 00128000
- * 00129000
- * 00130000
- * 00131000
- * SAVEWRK1+1 00132000
- * X'80' - FIELD CONTAINS AN ARGUMENT 00133000
- * X'40' - LOGICAL CARRIAGE RETURN FOUND 00134000
- * X'08' - 1= TREAT ADDRESS AS MAIN PREFIXED @V4075A0 00135000
- * X'04' - 1= TREAT ADDRESS AS ATTACHED PROC PREFIXED @V4075A0 00136000
- * X'01' - HEXIDECIMAL FIELD CONVERSION 00137000
- ********************************************************************9 00138000
- EJECT 00139000
- *********************************************************************** 00140000
- * * 00141000
- * 'DUMP' * 00142000
- * * 00143000
- *********************************************************************** 00144000
- *. 00145000
- * SUBROUTINE NAME - 00146000
- * DMKCDMDU 00147000
- * FUNCTION - 00148000
- * 00149000
- * TO DUMP TO THE SPOOL PRINTER THE CONTENTS OF THE SPECIFIED 00150000
- * LOCATIONS ALONG WITH THE REGISTERS,PSW,AND STORAGE KEYS. 00151000
- * 00152000
- * COMMAND FORMAT - 00153000
- * +--------+------------------------------------------+ 00154000
- * | DUMP | <M|N>LHEXLOC1 <<-> > | 00155000
- * | DU | <M|N>THEXLOC1 <<:> > <*USERID> | 00156000
- * | | <M|N>HEXLOC1 <<-HEXLOC2> > | 00157000
- * | | 0 <<:HEXLOC2> > | 00158000
- * | | <<-END> > | 00159000
- * | | <<:END> > | 00160000
- * | | <<.> > | 00161000
- * | | <<.BYTECOUNT > | 00162000
- * | | <<.END> > | 00163000
- * +--------+------------------------------------------+ 00164000
- * 00165000
- * THE FOLLOWING EXAMPLES WILL PRODUCE ONE FULL DUMP EACH 00166000
- * 00167000
- * DU L DU T DU - DU : DU . 00168000
- * DU . DU L- DU T- DU L: DU T: 00169000
- * DU L. DU T. DU 0- DU 0: DU 0. 00170000
- * DU 0:END DU L.END DU T.END DU 0.END DU T:END 00171000
- * DU 0:END DU L.END DU T.END DU 0.END 00172000
- * 00173000
- * 00174000
- * THE FOLLOWING WILL PRODUCE 3 FULL DUMPS. 00175000
- * DU T . L 00176000
- * 00177000
- * OPERATION - 00178000
- * 1. SET A BIT IN SAVEWRK1 TO INDICATE THAT A DUMP OF VIRTUAL 00179000
- * STORAGE, REGISTERS, PSW, AND STORAGE KEYS. 00180000
- * CONTROL IS THEN PASSED THRU THE REGISTER, PSW, AND DUMP 00181000
- * SUBROUTINES AS DESCRIBED IN THE PROLOGUE FOR DISPLAY. 00182000
- * 00183000
- * RESPONSES - 00184000
- * 00185000
- * COMMAND COMPLETE 00186000
- * 00187000
- * ERROR MESSAGES - 00188000
- * DMKCDM003E INVALID OPTION - (OPTION) 00189000
- * DMKCDM004E INVALID HEXLOC - (HEXLOC) 00190000
- * DMKCDM009E INVALID RANGE - (RANGE) 00191000
- * DMKCDM033E HEXLOC MISSING OR INVALID 00192000
- * DMKCDM060E DUMP FAILED; VIRTUAL PRINTER UNAVAILABLE 00193000
- * DMKCDM061E DUMP FAILED; VIRTUAL PRINTER ERROR 00194000
- * DMKCDM160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00195000
- *. 00196000
- DMKCDMDU RELOC 00197000
- TM VMOSTAT,VMSHR IS USER RUNNING SHARED SYSTEM ? @VA08317 00197100
- BNO NOCHANGE NO, CONTINUE DUMP PROCESSING @VA08317 00197200
- C R11,LASTUSER DID USER CHANGE ? @VA08317 00197300
- BNE NOCHANGE YES, CONTINUE DUMP PROCESSING @VA08317 00197400
- CALL DMKVMASH PROCESS ANY CHANGED SHARED PAGES @VA08317 00197500
- NOCHANGE EQU * CONTINUE DUMP PROCESSING @VA08317 00197600
- MVI SAVEWRK1,DUMPC+VIRTC REMEMBER TO DUMP VIRTUAL STORAGE 00198000
- B DISGETB 00199000
- EJECT 00200000
- *********************************************************************** 00201000
- * * 00202000
- * 'DUMP' * 00203000
- * * 00204000
- *********************************************************************** 00205000
- *. 00206000
- * SUBROUTINE NAME - 00207000
- * DMKCDMDU 00208000
- * FUNCTION - 00209000
- * TO DUMP TO THE VIRTUAL PRINTER VIRTUAL STORAGE LOCATIONS, 00210000
- * REGISTERS AND PSW 00211000
- * 00212000
- * OPERATION - 00213000
- * 00214000
- * THE FOLLOWING DESCRIBES THE OPERATION OF DUMP AND DMCP 00215000
- * 00216000
- * 1. CALL DMKFREE TO OBTAIN A BUFFER. THIS BUFFER WILL CONTAIN 00217000
- * THE DATA,FLAGS,ADDRESS INCREMENT COUNTS, AND POINTERS USED 00218000
- * IN CONSTRUCTING A LINE OF OUTPUT. 00219000
- * 2. SET UP THE NUMBER OF CHARACTERS PER LINE 00220000
- * 3. GO TO STEP 20 TO OUTPUT A LINE AND REINITIALIZE THE BUFFER. 00221000
- * 4. CALL DMKSCNFD TO LOCATE THE TYPE OF REQUEST (E.G., M,N,L,T) 00222000
- * IF NO ARGUMENTS AT ALL HAVE BEEN PROCESSED, CALL DMKERMSG 00223000
- * TO SEND ERROR MESSAGE DMKCDM033E 00224000
- * 5. CHECK THE ARGUMENT FOR A VALID TYPE. IF NONE FOUND 00225000
- * ASSUME THE SAME TYPE AS THE LAST VALID ARGUMENT. 00226000
- * GO TO THE SUBROUTINE TO HANDLE THE PARTICULAR TYPE. 00227000
- * 6. DUMPPSW - PLACES THE PSW INTO THE DUMP 00228000
- * 7. DUMPGPR - SET THE BEGINNING ADDRESS TO 0, ENDING ADDRESS 00229000
- * TO 15 AND CONTINUE. 00230000
- * 8A. DISCOMM-THIS IS A SUBROUTINE USED BY SEVERAL OTHERS TO 00231000
- * SET UP THE DATA IN THE BUFFER. FIRST CHECK IF AT THE 00232000
- * BEGINNING OF THE BUFFER. IF NOT GO TO STEP 10B. IF SO, 00233000
- * GO TO STEP 19 TO BUILD A LINE HEADER. THEN CONTINUE. 00234000
- * 10B. CONVERT THE NEXT PIECE OF DATA TO BE DISPLAYED VIA A CALL 00235000
- * TO DMKCVTBH. PLACE THIS DATA IN THE BUFFER. ADJUST THE 00236000
- * BUFFER POINTER AND BUFFER COUNT. THEN IF THE BUFFER IS 00237000
- * FULL, GO TO STEP 20 TO OUTPUT THE BUFFER AND REINITIALIZE 00238000
- * IT. IF THE BUFFER IS NOT FULL, GO TO STEP 17 TO GET THE 00239000
- * NEXT ADDRESS TO DISPLAY. 00240000
- * 11. DUMPFPR SET UP BEGINNING AND ENDING ADDRESSES 00241000
- * TO INCLUDE ALL FLOATING POINT REGISTERS. 00242000
- * THEN VIA CALLS TO DMKCVTBH, CONVERT THE VIRTUAL FLOATING 00243000
- * POINT REGISTERS FOUND IN THE VMBLOK TO PRINTABLE 'HEX' AND 00244000
- * ALSO CALL DMKCVTFP TO GET THE FLOATING POINT FORMAT. PLACE 00245000
- * THIS IN THE BUFFER AND GO TO STEP 20 TO OUTPUT. 00246000
- * 12. DUMPECR DEFAULT ADDRESSES TO INCLUDE ALL THE 00247000
- * CONTROL REGISTERS. LOAD THE VALUE OF THE NEXT CONTROL 00248000
- * REGISTER AND GO TO STEP 10B TO FORMAT AND PROCESS. 00249000
- * WHEN THE NEXT REGISTER IS NEEDED CONTROL WILL BE RETURNED 00250000
- * TO THIS ROUTINE TO GET THE DATA. 00251000
- * 13.DUMPLOC-SET A FLAG TO INDICATE A HEXLOC 00252000
- * REQUEST, ZERO SAVEWRK2. THIS WILL BE USED FOR INDEXING 00253000
- * THRU THE DUMP FUNCTIONS. GO TO STEP 18 00254000
- * TO OUTPUT THE DUMPID (IF ANY). THEN GO TO STEP 10 TO 00255000
- * START PROCESSING THE REGISTERS. 00256000
- * 13A. SET UP THE MAXIMUM ENDING ADDRESS FOR EITHER THE VIRTUAL 00257000
- * MACHINE OR REAL MACHINE DEPENDING ON REQUEST. THEN GO TO 00258000
- * STEP 16 TO INITIALIZE BEGINNING AND ENDING ADDRESSES. 00259000
- * IF A VIRTUAL REQUEST, TRANS IN THE NEXT ADDRESS TO BE 00260000
- * DUMPED. IF A REAL REQUEST, JUST PICK UP THE NEXT REAL 00261000
- * ADDRESS. IN AN AP SYSTEM THE ADDRESS IS TRANSLATED 00262000
- * BASED UPON THE M/N SPECIFICATION AND WHICH PROCESSOR WE 00263000
- * ON. THE PURPOSE IS TO REACH THE PROPER PAGE GIVEN THE 00264000
- * VALUES OF THE TWO PREFIX REGISTERS. 00265000
- * GO TO STEP 10A. TO FORMAT THE OUTPUT. CONTROL WILL BE 00266000
- * RETURNED TO THIS STEP FOR EACH ADDRESS UNTIL - 00267000
- * ALL THE REQUESTED LOCATIONS HAVE BEEN DUMPED. 00268000
- * IN AN AP SYSTEM THE PARAMETER PREFIX 'M' CAUSES THE 00269000
- * ADDRESS TO BE TREATED AS SEEN THROUGH THE MAIN PROCESSOR 00270000
- * PREFIX REGISTER. THE LETTER 'N' DESIGNATES THE ATTACHED 00271000
- * PROCESSOR. OTHERWISE THE ADDRESS IS TREATED AS AN ABSOLUT 00272000
- * ADDRESS. 'N' IS VALID ONLY WHEN THE ATTACHED PROCESSOR IS 00273000
- * IN OPERATION. 'M' IS VALID IF THE SYSTEM HAS BEEN GEN'D 00274000
- * FOR AP OPERATION 00275000
- * 16. DISINIT-THIS IS THE SUBROUTINE USED TO INITIALIZE THE 00276000
- * RANGE OF ADDRESSES FOR LOC,REGISTER, AND KEY REQUESTS. 00277000
- * FIRST CHECK IF ANY ADDRESS HAS BEEN SPECIFIED. IF NOT, 00278000
- * SET THE BEGINNING ADDRESS TO ZERO AND RETURN. IF HAVE AN 00279000
- * ADDRESS, SCAN THRU THE ARGUMENT CHECKING FOR ':','_', OR 00280000
- * BLANK. IF BLANK IS FOUND GO TO STEP 16A. IF ':' OR '-' 00281000
- * AND THE ENDING FIELD IS IN THE SAME ARGUMENT, COMPUTE THE 00282000
- * LENGTHS OF THE BEGINNING AND ENDING FIELDS AND GO TO 00283000
- * STEP 16B. 00284000
- * IF THE DELIMITER IS NOT : OR - THEN TEST FOR A DOT '.' 00285000
- * IF IT IS A DOT CHECK NEXT ARGUMENT. IF IT IS BLANK 00286000
- * THEN GO TO STEP 16C FOR DEFUALT END, ELSE CONVERT 00287000
- * THE FIELD AS A HEX LENGTH AND SAVE TO CALCULATE 00288000
- * THE END ADDRESS. 00289000
- * 16A. - CALL DMKSCNFD TO SEE IF HAVE A ':' OR '-' AS THE NEXT 00290000
- * ARGUMENT. IF THERE IS AND THE 'HEXLOC2' IS IN THE 00291000
- * SAME ARGUMENT, GO TO STEP 16B. IF HAVE ':' OR'-' WITH 00292000
- * NOTHING ELSE, CALL DMKSCNFD TO PICK UP NEXT ARGUMENT. 00293000
- * IF NONE FOUND, GO TO STEP 16C. IF HAVE ONE, CONTINUE. 00294000
- * IF THE DELIMITER WAS A DOT '.' THEN THE FIELD IS A 00295000
- * LENGTH SPECIFICATION. CONVERT IT FROM HEX AND GIVE AN 00296000
- * ERROR MESSAGE IF THAT FAILS. IF THE CONVERTION 00297000
- * IS GOOD SAVE THE VALUE TO CALCULATE THE END ADDRESS. 00298000
- * 16B. CHECK IF THE ENDING ADDRESS IS THE WORD 'END'. IF SO GO 00299000
- * TO STEP 16C. IF A 'HEXLOC', CALL DMKCVTHB TO CONVERT 00300000
- * TO BINARY. IF THE CONVERT FAILS, CALL DMKERMSG TO SEND 00301000
- * ERROR MESSAGE DMKCDM004E. IF THE CONVERT IS OK, USE THE 00302000
- * NUMBER TO INITIALIZE THE ENDING ADDRESS AND CONTINUE. 00303000
- * 16C. CALL DMKCVTHB TO CONVERT THE BEGINNING ADDRESS TO BINARY. 00304000
- * IF THE CONVERT FAILS, CALL DMKERMSG TO SEND ERROR 00305000
- * MESSAGE DMKCDM004E. IF CONVERT IS GOOD, INITIALIZE THE 00306000
- * BEGINNING ADDRESS WITH THIS NUMBER. THEN CHECK IF 00307000
- * BEGINNING ADDRESS IS LARGER THAN THE ENDING NUMBER. IF 00308000
- * IT IS , CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDM009E. 00309000
- * IF THE ADDRESS IS LARGER THAN THE MAXIMUM AND IT IS 00310000
- * A HEXLOC, CALL DMKERM TO SEND ERROR MESSAGE DMKCDM160E. 00311000
- * IF IT IS A REGISTER, SEND ERROR MESSAGE DMKCDM010E. IF 00312000
- * ADDRESS IS OK - RETURN. 00313000
- * 17. DISNEXTA-THIS IS THE SUBROUTINE TO GET THE NEXT ADDRESS. 00314000
- * FIRST - ADD THE INCREMENT VALUE TO THE PRESENT ADDRESS. 00315000
- * IF THE RESULT IS LARGER THAN THE ENDING ADDRESS,GO TO 00316000
- * STEP 17A. IF NOT STORE THE NEW ADDRESS IN THE BUFFER AND 00317000
- * RETURN. 00318000
- * 17A. GO TO STEP 20 TO OUTPUT THE LINE. THEN 00319000
- * IF IT IS 'DMCP', EXIT. IF IT IS DUMP VIRTUAL, LOAD THE 00320000
- * INDEX VALUE FROM SAVEWRK2. BUMP IT AND STORE BACK FOR 00321000
- * THE NEXT TIME. USE THE ORIGINAL VALUE TO INDEX INTO A 00322000
- * BRANCH TABLE WHICH WILL GO TO THE NEXT PART 00323000
- * OF THE DUMP FUNCTION. 00324000
- * 18. DISDMPID-THIS SUBROUTINE IS USED TO OUTPUT THE DUMPID. 00325000
- * FIRST SAVE THE 'BUFNXT' AND 'BUFCNT' OUT OF THE COMMAND 00326000
- * LINE BUFFER. THEN VIA CALLS TO DMKSCNFD SCAN DOWN THE 00327000
- * COMMAND LINE SEARCHING FOR A DUMPID. IF NONE IS FOUND, 00328000
- * RESTORE THE 'BUFNXT' AND 'BUFCNT' IN THE COMMAND 00329000
- * LINE AND RETURN. IF A DUMPID IS FOUND, PLACE IT IN THE 00330000
- * OUTPUT BUFFER AND GO TO STEP 20 TO OUTPUT. THEN RESTORE 00331000
- * THE 'BUFNXT' AND 'BUFCNT' AND RETURN. 00332000
- * 19. DISHEAD-THIS SUBROUTINE FORMATS THE LINE HEADER AND 00333000
- * TRAILER. FIRST CHECK IF THIS IS A LOCATION REQUEST. IF IT 00334000
- * IS, GO TO STEP 19A. IF NOT, CALL DMKCVTBD TO CONVERT THE 00335000
- * REGISTER NUMBER TO DECIMAL. SET REGISTER NUMBER IN THE 00336000
- * BUFFER AND RETURN. 00337000
- * 19A. IF THIS IS THE FIRST LINE, GO TO STEP 19C. IF LINES ARE 00338000
- * ALREADY BEING SUPPRESSED, GO TO STEP 19D. IF NEITHER OF 00339000
- * THESE, CHECK IF THIS LINE IS THE SAME AS THE LAST. IF NOT 00340000
- * GO TO STEP 19C. IF IT IS, SET UP THE SUPPRESSED LINES 00341000
- * MESSAGE. 00342000
- * 19B. DUMP THE ADDRESS TO THE NEXT LINE. CALL DMKCVTBH 00343000
- * TO CONVERT THIS ADDRESS TO HEX AND INSERT THIS ADDRESS 00344000
- * INTO THE BUFFER. THEN GO TO STEP 17 TO CONTINUE. 00345000
- * 19C. CALL DMKCVTBH TO CONVERT THE ADDRESS TO HEX. 00346000
- * TRANSLATE THE LINE TO EBCDIC AND RETURN 00347000
- * 19D. IF THIS LINE IS THE SAME AS THE LAST ONE, GO TO STEP 19B. 00348000
- * IF NOT, GO TO STEP 20 TO OUTPUT THE SUPPRESSED LINES 00349000
- * MESSAGE. THEN GO TO STEP 19C. 00350000
- * 20. DISWRITE-THIS SUBROUTINE WILL OUTPUT A LINE OF DATA TO 00351000
- * EITHER A TERMINAL(DISPLAY) OR THE PRINTER(DUMP). IF THE 00352000
- * BYTE COUNT FOR THE DATA IN THE BUFFER IS ZERO, GO TO 00353000
- * STEP 20B. IF THE OUTPUT IS FOR A PRINTER, GO TO STEP 00354000
- * 20A. ELSE SET UP FOR A TERMINAL AND CALL DMKQCNWT TO SEND 00355000
- * THE LINE OF DATA. THEN GO TO STEP 20B. 00356000
- * 20A. SET UP FOR A PRINTER AND CALL DMKVSPRT TO OUTPUT THE 00357000
- * LINE TO THE USERS VIRTUAL PRINTER. 00358000
- * 20B. RESET THE BUFFER POINTER TO THE START OF THE BUFFER. 00359000
- * BLANK OUT THE DATA PORTION OF THE BUFFER AND RETURN. 00360000
- * 00361000
- * RESPONSES - 00362000
- * 00363000
- * THE FOLLOWING ARE TYPICAL RESPONSES TO THE VARIOUS 00364000
- * DUMP COMMANDS: 00365000
- * 00366000
- * HEXLOCS - 00367000
- * XXXXXX = WORD1 WORD2 WORD3 WORD4 * EBCIDIC TRANSLATION * 00368000
- * 00369000
- * 00370000
- * ERROR MESSAGES - 00371000
- * DMKCDM004E INVALID HEXLOC - (HEXLOC) 00372000
- * DMKCDM009E INVALID RANGE - (RANGE) 00373000
- * DMKCDM010E INVALID REGISTER - (REGISTER) 00374000
- * DMKCDM026E OPERAND MISSING OR INVALID 00375000
- * DMKCDM160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00376000
- *. 00377000
- EJECT 00378000
- *********************************************************************** 00379000
- * * 00380000
- * 'DMCP' * 00381000
- * * 00382000
- *********************************************************************** 00383000
- *. 00384000
- * SUBROUTINE NAME - 00385000
- * DMKCDMDM 00386000
- * 00387000
- * FUNCTION - 00388000
- * TO DUMP TO THE VIRTUAL SPOOL PRINTER THE CONTENTS OF 00389000
- * THE REAL STORAGE LOCATIONS SPECIFIED. 00390000
- * 00391000
- * COMMAND FORMAT - 00392000
- * +--------+------------------------------------------+ 00393000
- * | DMCP | <M|N>LHEXLOC1 <<-> > | 00394000
- * | DMCP | <M|N>LHEXLOC1 <<:> > <*DUMPID> | 00395000
- * | | <M|N>HEXLOC1 <<-HEXLOC2> > | 00396000
- * | | 0 <<:HEXLOC2> > | 00397000
- * | | <<-END> > | 00398000
- * | | <<:END> > | 00399000
- * | | <<.> > | 00400000
- * | | <<.BYTECOUNT>> | 00401000
- * | | <<.END> > | 00402000
- * +--------+------------------------------------------+ 00403000
- * 00404000
- * OPERATION - 00405000
- * 1. SET A BIT IN SAVEWRK1 TO INDICATE THAT THIS IS A DUMP 00406000
- * REAL STORAGE REQUEST.THEN A BRANCH IS MADE TO COMMON ROUTIN 00407000
- * DESCRIBED IN THE PROLOGUE FOR DISPLAY. 00408000
- * 00409000
- * RESPONSES - 00410000
- * 00411000
- * COMMAND COMPLETE 00412000
- * 00413000
- * ERROR MESSAGES - 00414000
- * DMKCDM003E INVALID OPTION - (OPTION) 00415000
- * DMKCDM004E INVALID HEXLOC - (HEXLOC) 00416000
- * DMKCDM009E INVALID RANGE - (RANGE) 00417000
- * DMKCDM033E HEXLOC MISSING OR INVALID 00418000
- * DMKCDM060E DUMP FAILED; VIRTUAL PRINTER UNAVAILABLE 00419000
- * DMKCDM061E DUMP FAILED; VIRTUAL PRINTER ERROR 00420000
- * DMKCDM160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00421000
- *. 00422000
- SPACE 4 00423000
- DMKCDMDM RELOC 00424000
- MVI SAVEWRK1,DUMPC+REALC REMEMBER TO DUMP REAL STORAGE 00425000
- B DISGETB 00426000
- EJECT 00427000
- DISGETB LA R0,BFRSIZE LOAD SIZE OF BUFFER 00428000
- CALL DMKFREE GET OUTPUT BUFFER 00429000
- STCM R1,7,SAVEWRK4+1 SAVE ADDRESS OF BUFFER 00430000
- STC R0,SAVEWRK4 AND THE LENGTH IN DOUBLE WORDS 00431000
- LR R10,R1 LOAD BASE REGISTER 00432000
- MVI SAVEWRK1+1,X'00' CLEAR @V200930 00433000
- MVI SAVEWRK1+2,X'00' CLEAR LAST REQ @V200930 00434000
- XC BFRCNT(8),BFRCNT ZERO COUNT AND FLAGS 00435000
- SPACE 00436000
- DISGPRT OI BUFLAG,PRINTER INDICATE OUTPUT GOES TO THE PRINTER 00437000
- MVC BUFMAX,=H'92' SET MAX BYTE COUNT 00438000
- MVC BUFTRC,=H'32' SET TRANSLATE COUNT 00439000
- SPACE 00440000
- DISGETN BAL R4,DISWRITE WRITE OUT BUFFER & REINITIALIZE 00441000
- CALL DMKSCNFD GET NEXT OPERAND @VM08515 00442000
- BNZ DISEND NO MORE ARGUMENTS 00443000
- OI SAVEWRK1,PROC1 FLAG AS PROCESS AT LEAST ONE 00444000
- TM SAVEWRK1,BYPGPR TEST FOR NEXT DUMP ARG @V200930 00445000
- BZ DISRSTFL NO, START FIELD @V200930 00446000
- CLI 0(R1),C'*' IS THIS THE DUMP ID ?? @V200930 00447000
- BE DISEND YES, ALL DONE @V200930 00448000
- SPACE 00449000
- DISRSTFL STM R0,R1,SAVEWRK8 SAVE ARG. LENGTH AND ADDRESS 00450000
- MVC FLDLEN(4),F6 SET MAX FIELD LENGTH @VM08524 00451000
- NI SAVEWRK1,X'FF'-HEXLOC RESET FLAG @V200930 00452000
- LR R5,R1 STARTING ADDRESS TO R5 00453000
- LR R6,R0 LENGTH TO R6 00454000
- * 00455000
- * GPR 5 CONTAINS THE ADDRESS OF THE FIRST BYTE OF THE FIELD. 00456000
- * GPR 6 CONTAINS THE LENGTH (IN BYTES) OF THE FIELD. 00457000
- * 00458000
- TM VMRSTAT,VMLOGOFF GONE INTO LOGOFF WHILE OUT? 00459000
- BO EXIT YES, GET OUT 00460000
- NI BUFLAG,PRINTER RESET ALL BUT PRINTER FLAG 00461000
- OI BUFLAG,TRANSLAT INDICATE TRANSLATE LINE TO EBCDIC 00462000
- MVC BFRCNT,F1+2 SET BYTE COUNT = 1 @V4075A0 00463000
- BAL R4,DISWRITE PRINT A BLANK LINE 00464000
- DISGTYPE EQU * 00465000
- CLI 0(R5),C'L' LOCATION REQUEST ? 00466000
- BE DUMPTEST YES 00467000
- CLI 0(R5),C'T' STORAGE LOCATION(S) + EBCDIC ? 00468000
- BE DUMPTEST YES 00469000
- CLI 0(R5),C'N' IF USER SPECIFIED M|N, @V4075A0 00470000
- BE ITSN @V4075A0 00471000
- CLI 0(R5),C'M' @V4075A0 00472000
- BE ITSM CHECK VALIDITY AND SET FLAGS @V4075A0 00473000
- CLI SAVEWRK1+2,X'00' PREVIOUS REQ VALID ?? @V200930 00474000
- BNE SETR5 YES, DEFAULT TO LAST REQ @V200930 00475000
- DEFAULTL EQU * @V4075A0 00476000
- MVI SAVEWRK1+2,C'L' DEFAULT TO LOCATION @V200930 00477000
- SETR5 BCTR R5,R0 BACKUP 1 POSITION @V200930 00478000
- LA R6,1(R6) UP COUNT BY ONE @V200930 00479000
- MVC 0(1,R5),SAVEWRK1+2 SET REQ CHARACTER @V200930 00480000
- B DISGTYPE ANALYSE TYPE @V200930 00481000
- SPACE 4 00482000
- DISEND EQU * 00483000
- TM SAVEWRK1,PROC1 ANY PROCESSING DONE ??? 00484000
- BZ CDM033 NO - GO SEND ERR MSG @V4075A0 00485000
- B CONFMSG YES, JUST EXIT @V4075A0 00486000
- SPACE 4 00487000
- ITSM L R15,=A(DMKSYSAP) CHECK USER SPEC @V4075A0 00488000
- CLI 0(R15),C'Y' IF NOT GEN'D FOR AP, @V4075A0 00489000
- BNE CDM026 M,N NOT ACCEPTABLE @V4075A0 00490000
- OI SAVEWRK1+1,MPREF USER SPECIFIED 'M' @V4M0120 00491000
- MNCOMM TM SAVEWRK1,VIRTC M,N ONLY FOR CP STORAGE @V4075A0 00492000
- BO CDM026 ERROR IF VIRTUAL DIS/DUMP @V4075A0 00493000
- LA R5,1(R5) POINT TO NEXT CHAR IN PARM @V4075A0 00494000
- BCT R6,DISGTYPE REDUCE COUNT & RESCAN PARM @V4075A0 00495000
- B DEFAULTL NO MORE CHARS, DEFAULT TO 'L'@V4075A0 00496000
- SPACE 2 @V4075A0 00497000
- ITSN TM APSTAT1,APUOPER 'N' IS NOT VALID WHEN THE @V4075A0 00498000
- BNO CDM026 ATTACHED PROCESSOR NOT UP @V4075A0 00499000
- OI SAVEWRK1+1,NPREF USER SPECIFIED 'N' @V4075A0 00500000
- B MNCOMM @V4075A0 00501000
- SPACE 2 @V4075A0 00502000
- EJECT 00503000
- * 00504000
- * THE FOLLOWING POINT DUMPS THE PSW 00505000
- * 00506000
- DUMPPSW MVC BUFBUF(5),CPSWEQ PUT IN 'PSW =' @V4075A0 00507000
- L R1,VMPSW LOAD 1ST HALF OF VIRTUAL PSW 00508000
- TM VMESTAT,VMEXTCM IN EXTENDED-MODE? 00509000
- BO *+8 YES - DISPLAY ENTIRE PSW 00510000
- N R1,=XL4'FFFF0000' ZERO INTERUPTION CODE 00511000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00512000
- STCM R0,B'1111',BUFBUF+6 STORE IN 1ST QUARTER PSW @V4075A0 00513000
- STCM R1,B'1111',BUFBUF+10 THEN 2ND QUARTER @V4075A0 00514000
- L R1,VMPSW+4 LOAD 2ND HALF OF VIRTUAL PSW 00515000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00516000
- STCM R0,B'1111',BUFBUF+15 3RD QUARTER OF PSW @V4075A0 00517000
- STCM R1,B'1111',BUFBUF+19 FINAL QUARTER @V4075A0 00518000
- MVC BFRCNT,=H'23' SET LINE LENGTH 00519000
- B DUMPCHEK GO PRINT LINE AND CONTINUE 00520000
- EJECT 00521000
- * 00522000
- * DUMP THE GENERAL PURPOSE REGISTERS 00523000
- * 00524000
- DUMPGPR MVC IDCHAR,=C'GPR' SAVE IDENTIFICATION CHARACTERS 00525000
- LA R1,15 SET DEFAULT END REGISTER @V4075A0 00526000
- ST R1,ENDADD INTO ENDING CONTROL FIELD @V4075A0 00527000
- ST R1,ENDMAX AND MAXIMUM END FIELD @V4075A0 00528000
- MVC INCRMT(2),F1+2 SET ADDRESS INCREMENT 00529000
- MVC FLDLEN(4),F2 SET MAX FIELD LENGTH @VM08524 00530000
- SR R1,R1 SIMULATE DISINIT DEFAULT 00531000
- ST R1,NXTADD SET NEXT ADDRESS TO ZERO @V4075A0 00532000
- LA R7,GPRRET SET UP RETURN FOR OUTPUT LOOP 00533000
- GPRRET SLA R1,2 CONVERT TO FULL WORD DISPLACEMENT 00534000
- L R3,VMGPRS(R1) LOAD VALUE IN REGISTER 00535000
- SPACE 2 00536000
- DISCOMM CL R10,BUFPNT IS POINTER AT BEGINNING OF BUFFER ? 00537000
- BNE DISCOMMC BRANCH IF NO 00538000
- L R1,NXTADD LOAD DATA ADDRESS 00539000
- BAL R8,DISHEAD YES - BUILD LINE HEADER 00540000
- DISCOMMC LR R1,R3 LOAD DATA TO BE DISPLAYED 00541000
- CALL DMKCVTBH CONVERT DATA TO PRINTABLE CHARACTERS 00542000
- STM R0,R1,FIELD STORE IN WORK AREA 00543000
- L R1,BUFPNT LOAD BUFFER POINTER 00544000
- MVC 0(8,R1),FIELD MOVE DATA 00545000
- LA R1,10(R1) BUMP POINTER BY 10 00546000
- LH R14,BFRCNT GET BUFFER COUNT 00547000
- LA R14,10(R14) UP THE COUNT 00548000
- CH R14,=H'50' AT THE MID POINT ?? 00549000
- BNE NOSHFT NO, CONT 00550000
- LA R14,2(R14) TWO MORE 00551000
- LA R1,2(R1) TWO MORE 00552000
- NOSHFT ST R1,BUFPNT SET NEW POINTER 00553000
- STH R14,BFRCNT SET NEW COUNT 00554000
- CH R14,BUFMAX AT END OF BUFFER ?? 00555000
- BL DISNEXTA NO - CONTINUE DISPLAY 00556000
- SH R14,F2+2 ADJUST LENGTH 00557000
- STH R14,BFRCNT SET COUNT 00558000
- LA R4,DISNEXTA LOAD RETURN ADDRESS 00559000
- B DISWRITE YES - OUTPUT LINE 00560000
- EJECT 00561000
- * 00562000
- * ENTER HERE WHEN PROCESSING DUMP FUNCTION 00563000
- * 00564000
- DUMPFPR MVC IDCHAR,=C'FPR' SAVE IDENTIFICATION CHARACTERS 00565000
- LA R1,6 BIGGEST FPR @V4075A0 00566000
- ST R1,ENDADD SET DEFAULT END REGISTER @V4075A0 00567000
- ST R1,ENDMAX SET MAXIMUM END REGISTER @V4075A0 00568000
- MVC INCRMT(2),F2+2 SET ADDR INCREMENT 00569000
- MVC FLDLEN(4),F1 SET MAX FIELD LENGTH @VM08524 00570000
- SR R1,R1 SIMULATE DISINIT DEFAULT 00571000
- ST R1,NXTADD SET NEXT ADDRESS TO ZERO @V4075A0 00572000
- LA R7,FPRRET SET UP RETURN 00573000
- FPRRET BAL R8,DISHEAD BUILD LINE HEADER 00574000
- L R1,NXTADD RELOAD REGISTER NUMBER 00575000
- SLA R1,2 CONVERT TO DOUBLE WORD BISPLACEMENT 00576000
- LA R2,VMFPRS(R1) POINT TO VIRTUAL FPR 00577000
- L R1,0(R2) LOAD 1ST HALF OF VIRTUAL REGISTER 00578000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00579000
- STCM R0,B'1111',BUFBUF+10 @V4075A0 00580000
- STCM R1,B'1111',BUFBUF+14 @V4075A0 00581000
- L R1,4(R2) LOAD 2ND HALF OF VIRTUAL REGISTER 00582000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00583000
- STCM R0,B'1111',BUFBUF+18 @V4075A0 00584000
- STCM R1,B'1111',BUFBUF+22 @V4075A0 00585000
- LA R1,BUFBUF+30 LOAD OUTPUT POINTER 00586000
- CALL DMKCVTFP CONVERT TO PRINTABLE FLOATING OINT 00587000
- MVC BFRCNT,=H'54' SET LINE LENGTH 00588000
- LA R4,DISNEXTA LOAD RETURN ADDRESS 00589000
- B DISWRITE OUTPUT LINE 00590000
- EJECT 00591000
- * 00592000
- * ENTER HERE WHEN DUMPING CONTROL REGISTERS 00593000
- * 00594000
- DUMPECR MVC IDCHAR,=C'ECR' SAVE IDENTIFICATION CHARACTERS 00595000
- MVC INCRMT,F1+2 SET BYTE COUNT = 1 @V4075A0 00596000
- LA R1,15 DEFAULT END REG = 15 @VA07527 00597100
- ST R1,ENDADD DEFAULT END REG @V4075A0 00598000
- ST R1,ENDMAX SAVE MAXIMUM REG ADDRESS @V4075A0 00599000
- MVC FLDLEN(4),F2 SET MAX FIELD LENGTH @VM08524 00600000
- SR R1,R1 SIMULATE DISINIT DEFAULT 00601000
- MVC NXTADD(4),ZEROES SET NEXT ADDRESS TO ZERO 00602000
- LA R7,CRRET SET UP RETURN 00603000
- CRRET EQU * 00604000
- TM VMPSTAT,VMV370R IS THIS A VIRTUAL 370 ??? 00605000
- BZ DISECR0 NO- DISPLAY CREG 0 ONLY 00606000
- SLA R1,2 CONVERT TO FULL WORD DISPLACMENT 00607000
- L R14,VMECEXT LOAD VMBLOK EXTENTION ADDRESS 00608000
- USING ECBLOK,R14 00609000
- L R3,EXTCR0(R1) LOAD VALUE IN REGISTER 00610000
- DROP R14 00611000
- B DISCOMM PUT IN BUFFER & DISPLAY 00612000
- DISECR0 EQU * DISPLAY ONLY C-REG 0 00613000
- SLR R1,R1 C-REG 0 00614000
- ST R1,ENDADD ...ONLY 00615000
- ST R1,NXTADD ... 00616000
- LA R7,DUMPCHEK RETURN ADDRESS 00617000
- L R3,VMVCR0 DATA TO BE DISPLAYED 00618000
- B DISCOMM PUT IN BUFFER + DISPLAY 00619000
- EJECT 00620000
- * 00621000
- * DUMP STORAGE 00622000
- * 00623000
- DUMPTEST OI SAVEWRK1,HEXLOC INDICATE A LOCATION REQUEST 00624000
- MVI SAVEWRK1+2,C'L' DEFAULT TO LOC @V200930 00625000
- DMPTST DS 0H @V200930 00626000
- TM SAVEWRK1,VIRTC DISPLAY VIRTUAL STORAGE ? 00627000
- BZ DISLOCR BRANCH IF NO - REAL STORAGE 00628000
- L R2,VMSIZE LOAD VIRTUAL MACHINE SIZE 00629000
- DISLOCS BCTR R2,0 -1 @VM08524 00630000
- ST R2,TENDADD SAVE MAX ADDRESS @VM08524 00631000
- ST R2,ENDMAX .. @VM08524 00632000
- S R2,F3 SUBTRACT 3 @VA03720 00633000
- ST R2,ENDADD SET DEFAULT ENDING ADDRESS 00634000
- OI SAVEWRK1+1,CHEX HEX ADDRESS CONVERT @V200930 00635000
- MVC INCRMT(2),F4+2 SET WORD INCREMENT @V200930 00636000
- BAL R7,DISINIT INITIALIZE BEGINNING & ENDING ADDRESSES 00637000
- NI SAVEWRK1+1,255-CHEX TURN OFF HEX CONVERSION SWITCH 00638000
- BAL R7,DISDMPID GET AND PRINT DUMP ID IF ANY @V200930 00639000
- L R0,ENDADD GET END ADDRESS @V200930 00640000
- L R1,NXTADD GET NEXT ADDRESS @V200930 00641000
- STM R0,R1,SAVEWRK8 SAVE FOR AFTER DUMP REGS @V200930 00642000
- SR R2,R2 CLEAR FOR INDEX @V200930 00643000
- ST R2,SAVEWRK2 INDEX THROUGH DUMP FUNCTIONS @V200930 00644000
- TM SAVEWRK1,VIRTC DUMP VIRTUAL ?? @V200930 00645000
- BO DUMPSTRT START DUMP OUTPUT @V200930 00646000
- OI SAVEWRK1,BYPGPR INDICATE START FIELD FOUND @VM08525 00647000
- DISLOC OI BUFLAG,TRANSLAT TRANSLATE HEX DATA FOR DUMP @V200930 00648000
- LM R0,R1,SAVEWRK8 GET END AND START VALUES @V200930 00649000
- ST R0,ENDADD SET END ADDRESS @V200930 00650000
- ST R1,NXTADD SET START ADDRESS @V200930 00651000
- DISLOCD MVC INCRMT(2),F4+2 SET WORD INCREMENT @V200930 00652000
- OI BUFLAG,FIRSTL FLAG FIRST LINE @V200930 00653000
- MVC IDCHAR,CLOC 'LOC' ID FOR DATA @V4075A0 00654000
- L R1,ENDADD GET END ADDRESS 00655000
- LH R0,BUFTRC GET TRANSLATE COUNT 00656000
- BCTR R0,R0 DECREMENT BY 1 00657000
- OR R1,R0 ALIGN TO END 00658000
- ST R1,ENDADD SET NEW END 00659000
- L R1,NXTADD GET START ADDRESS 00660000
- LH R0,BUFTRC LOAD TRANSLATE COUNT 00661000
- LCR R0,R0 LOAD ITS COMPLEMENT 00662000
- NR R1,R0 TRUNCATE TO 16 OR 32 BYTE BOUNDARY 00663000
- ST R1,NXTADD STORE NEW BEGINNING ADDRESS 00664000
- DISLOCA LA R7,DISLOCA+4 RESET RETURN ADDRESS 00665000
- LR R2,R1 LOAD ADDRESS TO BE DISPLAYED 00666000
- TM SAVEWRK1,VIRTC DISPLAY VIRTUAL STORAGE ? 00667000
- BZ PREFLOC NO, REAL, MAY HAVE TO RECOMP ADDR@V4075A0 00668000
- TRANS 2,1,OPT=(BRING,DEFER) GET USER PAGE ADDRESS 00669000
- DISLOCL L R3,0(R2) LOAD WORD TO BE DISPLAYED 00670000
- BZ DISCOMM PUT DATA INTO BUFFER & DISPLAY @V304635 00671000
- OI BUFLAG,INVLD INDICATE INVALID PAGE @V304635 00672000
- BAL R4,DISWRITE OUTPUT LINE @V304635 00673000
- L R1,NXTADD CONVERT ADDRESS TO PRINTABLE @V304635 00674000
- CALL DMKCVTBH @V304635 00675000
- STCM R0,B'0011',BUFBUF MOVE BEGINNING ADDRESS @V4075A0 00676000
- STCM R1,B'1111',BUFBUF+2 TO OUTPUT BUFFER @V4075A0 00677000
- MVC BUFBUF+7(2),=C'TO' @V304635 00678000
- MVC BUFBUF+19(23),=C'NON-ADDRESSABLE STORAGE' @V304635 00679000
- MVC BFRCNT,=AL2(19+23) SET BYTE COUNT @V304635 00680000
- L R1,NXTADD RELOAD ADDRESS @V304635 00681000
- NXTINVLD AL R1,F4096 BUMP TO NEXT PAGE ADDRESS @V304635 00682000
- N R1,XPAGNUM DROP DISPLACEMENT @V304635 00683000
- ST R1,NXTADD SAVE IT AS CURRENT ADDRESS @V304635 00684000
- CALL DMKCVTBH CONVERT IT TO HEX PRINTABLE @V304635 00685000
- STCM R0,B'1111',BUFBUF+10 PUT ENDING ADDRESS @V4075A0 00686000
- STCM R1,B'1111',BUFBUF+12 INTO OUTPUT BUFFER @V4075A0 00687000
- L R1,NXTADD RESTORE CURRENT ADDRESS @V304635 00688000
- CL R1,VMSIZE STILL WITHIN VM STORAGE SIZE @V304635 00689000
- BNL GETOUT IF NOT - GET OUT @V304635 00690000
- LCTL C1,C1,VMSEG GET SEGMENT TABLE @V304635 00691000
- LRA R0,0(,R1) EXAMINE NEXT PAGE @V304635 00692000
- BC 8+2,NXTINV1 CONTINUE IF NOT A SEG EXCEPTION @V408246 00693000
- CALL DMKPTRAN,PARM=DEFER OTHERWISE LET PTRAN HANDLE @V408246 00694000
- BC 2,NXTINVLD ADDRESSING ERROR @V408246 00695000
- NXTINV1 DS 0H @V408246 00696000
- CL R1,ENDADD AT END OF DISPLAY ? @V304635 00697000
- BNL GETOUT IF YES - FINISH UP @V304635 00698000
- BAL R4,DISWRITE NOW DISPLAY THIS LINE @V304635 00699000
- BAL R7,DISNCOMM IF DUMPING DISPLAY RESPONSE @VA04637 00700000
- B DISLOCA LOAD UP THE DATA @V304635 00701000
- GETOUT BAL R4,DISWRITE DISPLAY THE LINE AND FRET THE @V304635 00702000
- * BUFFER 00703000
- B DUMPCHEK CHECK FOR DUMP FUNCTION @V304635 00704000
- SPACE 00705000
- DISLOCR L R2,=A(DMKSYSRM) GET REAL MACHINE SIZE 00706000
- L R2,0(R2) .. 00707000
- B DISLOCS 00708000
- SPACE 3 00709000
- PREFLOC EQU * 00710000
- L R15,=A(DMKSYSAP) SEE WHAT USER PUT IN @V4075A0 00711000
- CLI 0(R15),C'Y' THE SYSCOR MACRO @V4075A0 00712000
- BNE FETCHRL AP OPTION, WE CHECK AND@V4075A0 00713000
- L R0,XPAGNUM @V4075A0 00714000
- TM SAVEWRK1+1,MPREF+NPREF PERHAPS RECOMPUTE THE @V4075A0 00715000
- BZ ABSPEC EFFECTIVE ADDRESS @V4075A0 00716000
- TM SAVEWRK1+1,NPREF DID USER SAY 'M' OR 'N' @V4075A0 00717000
- BO RWEN GO FIX UP FOR 'N' SPECIFIED @V4075A0 00718000
- RWEM TM APSTAT1,PROCIO HE SAID 'M', ARE WE 'M' ? @V4075A0 00719000
- BO FETCHRL YES, DO NOT RECOMPUTE ADDRES@V4075A0 00720000
- PFIXCOMP NR R0,R1 GET PAGE NUMBER @V4075A0 00721000
- BZ ADDPREFB OTHER PROCESSOR'S PSA. POINT 2 IT@V4075A0 00722000
- C R0,PREFIXB ABSOLUTE 0 IN OTHER PROCESSOR'S @V4075A0 00723000
- BNE ISITPRFA NO. GO SEE IF IT IS OUR PSA! @V4075A0 00724000
- GETABS0 S R1,PREFIXB YES, POINT TO ABSOLUTE 0 VIA OUR @V4075A0 00725000
- ADDPREFA A R1,PREFIXA PREFIX REGISTER @V4075A0 00726000
- B FETCHRL @V4075A0 00727000
- SPACE 2 @V4075A0 00728000
- ADDPREFB A R1,PREFIXB POINT TO OTHER PROCESSOR PSA @V4075A0 00729000
- B FETCHRL @V4075A0 00730000
- SPACE 2 @V4075A0 00731000
- RWEN TM APSTAT1,PROCIO USER SAID 'N'. ARE WE 'N' ? @V4075A0 00732000
- BNO FETCHRL YES @V4075A0 00733000
- B PFIXCOMP NO. SEE ABOUT RECOMPUTING @V4075A0 00734000
- SPACE 2 @V4075A0 00735000
- ABSPEC NR R0,R1 ABSOLUTE 0 ? @V4075A0 00736000
- BZ ADDPREFA YES, UNDO EFFECT OF PREFIX REG @V4075A0 00737000
- ISITPRFA C R0,PREFIXA OUR PSA ? @V4075A0 00738000
- BNE FETCHRL NO @V4075A0 00739000
- SUBPREFA S R1,PREFIXA YES, UNDO OUR PREFIX REG @V4075A0 00740000
- FETCHRL L R3,0(R1) FETCH THE DATA WORD ! @V4075A0 00741000
- B DISCOMM PUT DATA INTO BUFFER & SHOW IT @V4075A0 00742000
- EJECT 00743000
- * 00744000
- * DUMP STORAGE KEY 00745000
- * 00746000
- DUMPKEY OI SAVEWRK1+1,CHEX TURN ON HEX CONVERSION SWITCH 00747000
- OI SAVEWRK1,HEXLOC FLAG AS BEING HEXLOC REQUEST 00748000
- OI BUFLAG,FIRSTL TURN ON FIRST LINE SWITCH 00749000
- MVC IDCHAR,KEYEQ SAVE IDENTIFICATION CHARACTERS 00750000
- LA R15,2048 LOAD ADDRESS INCREMENT @VA03720 00751000
- STH R15,INCRMT SET INCREMENT VALUE 00752000
- L R2,VMSIZE LOAD VIRTUAL MACHINE SIZE 00753000
- BCTR R2,0 MAKE IT LAST ADDRESS @VM08524 00754000
- ST R2,TENDADD SAVE END ADDRESS @VM08524 00755000
- ST R2,ENDMAX SET MAXIMUM ADDRESS @VM08524 00756000
- S R2,=F'2047' BACK UP TO LAST PAGE ADDR @VM08854 00757000
- ST R2,ENDADD SET DEFAULT ENDING ADDRESS 00758000
- SR R1,R1 SIMULATE DISINIT DEFAULT 00759000
- ST R1,NXTADD SET START ADDRESS TO ZERO 00760000
- LA R7,KEYRET SET UP RETURN 00761000
- KEYRET NI SAVEWRK1+1,255-CHEX TURN OFF HEX CONVERSION SWITCH 00762000
- LA R15,HAVEKEY SET RETURN ADDRESS @VM08553 00763000
- GETKEY EQU * HERE TO CALCULATE KEY VALUES @VM08553 00764000
- ST R15,SAVEWRK5 SAVE RETURN ADDR @VM08553 00765000
- LR R14,R1 LOAD CURRENT ADDRESS 00766000
- L R3,VMSEG OBTAIN STO @V408246 00767000
- SRDL R14,16 GET SEGMENT NUMBER 00768000
- SLL R14,2 MULTIPLY BY 4 00769000
- LA R3,0(R14,R3) INDEX TO STE FOR THIS SEGMENT @V408246 00770000
- TM 3(R3),1 IS THE STE INVALID? @V408246 00771000
- BZ VLDKEY NO, PNTR ALL RIGHT @V408246 00772000
- LR R0,R15 SAVE 2ND PART @V408246 00773000
- TRANS 2,1,OPT=(DEFER) LET PTR CHECK ON SEGMENT @V408246 00774000
- LR R15,R0 RESTORE 2ND PART @V408246 00775000
- TM 3(R3),1 DID PTR CLEAR UP PAGE TABLE @V408246 00776000
- * POINTER? 00777000
- BZ VLDKEY NO, RETURN ZERO KEY @V408246 00778000
- L R1,FFS INDICATE MINUS IF NON-ADDRESSABLE@V304635 00779000
- B NOKEY PROCESS NON-ADDRESSABLE KEY @V304635 00780000
- VLDKEY EQU * HERE FOR ADDRESSABLE STORAGE @V304635 00781000
- L R3,0(,R3) GET PAGE TABLE POINTER @V408246 00782000
- LA R2,16*2+8(,R3) GET SWAPTABLE ORIGIN @V408246 00783000
- SR R14,R14 ZERO WORK REGISTER 00784000
- SLDL R14,4 GET PAGE NUMBER 00785000
- SLL R14,2 MULTIPLY BY 8 AND 00786000
- SLDL R14,1 ADD 1 IF 2ND HALF OF PAGE 00787000
- SR R1,R1 ZERO REGISTER 00788000
- IC R1,2(R14,R2) INSERT STORAGE KEY 00789000
- SRDL R14,1 GET PAGE NUMBER X 2 00790000
- SRL R14,1 .. 00791000
- LA R3,0(R14,R3) LOAD PAGE TABLE ENTRY ADDRESS 00792000
- SR R2,R2 CLEAR FOR ISK (OR LACK OF IT) @VM08553 00793000
- TM 1(R3),X'08' IS THE PAGE IN STORAGE ? 00794000
- BO GOTPART BRANCH IF NO @VM08553 00795000
- LH R14,0(,R3) LOAD REAL PAGE ADDRESS 00796000
- SRL R14,4 .. 00797000
- SLDL R14,12 ADD DISPLACEMENT ADDRESS 00798000
- ISK R2,R14 GET THE REAL STORAGE KEY 00799000
- GOTPART TM VMOSTAT,VMSHR IS THIS A SHARED SYSTEM? @VA01666 00800000
- BZ *+8 NOPE, SKIP @VA01666 00801000
- N R2,=A(X'0E') SHUT OFF PHONEY KEY @VA01666 00802000
- OR R1,R2 PUT REAL AND VIRT TOGETHER @VA01666 00803000
- LA R3,X'FE' SET FOR ECMODE @VA01666 00804000
- TM VMPSTAT,VMV370R DOES THIS MACHINE HAVE EC? @VA01666 00805000
- BO *+8 YES, MASK OK @VA01666 00806000
- LA R3,X'F8' SET MASK FOR BC TYPE MACHINE @VA01666 00807000
- NR R1,R3 SHUT OFF WHATEVER IS NECESSARY. @VA01666 00808000
- NOKEY L R15,SAVEWRK5 RESTORE RETURN ADDRESS @V304635 00809000
- BR R15 RETURN @VM08553 00810000
- HAVEKEY EQU * @VM08553 00811000
- TM BUFLAG,FIRSTL IS THIS THE FIRST LINE ? 00812000
- BO DISK1STL BRANCH IF YES 00813000
- CL R1,LNSAVE SAME AS LAST KEY ? 00814000
- BE DISKBUMP BRANCH IF YES 00815000
- BAL R4,DISWRITE OUTPUT PREVIOUS LINE 00816000
- DISK1STL NI BUFLAG,NFIRSTL TURN OFF IST LINE SWITCH 00817000
- MVC BUFBUF+18(5),KEYEQ MOVE 'KEY =' TO BUFFER 00818000
- ST R1,LNSAVE SAVE KEY 00819000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00820000
- STH R1,BUFBUF+24 STORE KEY IN BUFFER 00821000
- LA R1,26 STANDARD LINE LENGTH @V304635 00822000
- CLI LNSAVE,X'FF' IS IT NON-ADDRESSABLE STORAGE ? @V304635 00823000
- BNE SETBUFLG NO - SET UP BUFFER LENGTH @V304635 00824000
- MVC BUFBUF+18(23),=C'NON-ADDRESSABLE STORAGE' @V304635 00825000
- LA R1,15(,R1) LENGTH-EN MESSAGE LINE @V304635 00826000
- SETBUFLG STH R1,BFRCNT SET LINE LENGTH. @V304635 00827000
- L R1,NXTADD LOAD BEGINNING ADDRESS 00828000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00829000
- STCM R0,B'0011',BUFBUF MOVE IT TO @V4075A0 00830000
- STCM R1,B'1111',BUFBUF+2 OUTPUT BUFFER @V4075A0 00831000
- MVC BUFBUF+7(2),=C'TO' 00832000
- DISKBUMP L R1,NXTADD LOAD CURRENT ADDRESS 00833000
- LA R1,2047(R1) ADD 2047 00834000
- CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00835000
- STM R0,R1,FIELD STORE IN WORK AREA 00836000
- MVC BUFBUF+10(6),FIELD+2 MOVE TO BUFFER 00837000
- B DISNEXTA GET NEXT ADDRESS 00838000
- EJECT 00839000
- * THE FOLLOWING TWO SUBROUTINES ARE USED TO INITIALIZE AND 00840000
- * CONTROL THE DUMPING OF A RANGE OF ADDRESSES. REGISTER 7 IS 00841000
- * LOADED BY A BAL TO DISINIT FROM THE VARIOUS DUMP ROUTINES. 00842000
- * IT IS LATER USED BY DISNEXTA TO RETURN TO THE ROUTINE THAT 00843000
- * LAST CALLED DISINIT TO DISPLAY THE NEXT ADDRESS. 00844000
- * 00845000
- * INITIALIZE BEGINNING AND ENDING ADDRESSES SUBROUTINE 00846000
- * 00847000
- DISINIT EQU * 00848000
- MVC TENDADD(4),ENDMAX SET UP TRUE END DEFAULT @VM08524 00849000
- NI SAVEWRK1,X'FF'-RANGE-DISLEN RESET FLAGS @V200930 00850000
- LA R1,1(,R5) BUMP PAST TYPE CODE 00851000
- CH R6,F1+2 ANY ADDRESS SPECIFIED ???? 00852000
- BH DISISCAN BRANCH IF YES 00853000
- SPACE 00854000
- OI SAVEWRK1,RANGE INDICATE RANGE OF OPERANDS @VM08515 00855000
- B DISIBLNK GO SET DEFAULTS 00856000
- SPACE 00857000
- * NOW CHECK FOR A COLON OR HYPHEN 00858000
- SPACE 00859000
- DISISCAN EQU * 00860000
- LR R14,R6 LENGTH TO R14 00861000
- BCTR R14,0 MINUS ONE FOR TYPE CODE BYPASS 00862000
- DISICOLN CLI 0(R1),C':' CHECK FOR A COLON 00863000
- BE DISIHYPH BRANCH IF YES 00864000
- CLI 0(R1),C'-' HYPHEN ???? 00865000
- BE DISIHYPH YES --- 00866000
- CLI 0(R1),C'.' IS IT A LENGTH ?? @V200930 00867000
- BE DISDOT YES, FLAG AND CONTINUE @V200930 00868000
- CLI 0(R1),C' ' BLANK ??? 00869000
- BNH DISIBLNK BRANCH IF IT IS @VM08515 00870000
- LA R1,1(,R1) BUMP TO NEXT CHAR. 00871000
- BCT R14,DISICOLN LOOP BACK IF HAVE MORE CHARACTERS TO CHK. 00872000
- B DISIBLNK NO MORE - TREAT AS BLANK @VM08515 00873000
- SPACE 00874000
- DISDOT OI SAVEWRK1,DISLEN FLAG LENGTH RANGE @V200930 00875000
- DISIHYPH OI SAVEWRK1,RANGE SET RANGE SWITCH 00876000
- BCTR R6,0 MINUS ONE FROM LENGTH FOR HYPHEN 00877000
- LA R0,1(R5,R6) COMPUTE LENGTH OF ENDING FIELD 00878000
- LA R1,1(,R1) . . . 00879000
- SR R0,R1 . . . 00880000
- BNP DISIBLNK NO ENDING FIELD - TREAT AS BLANK @VM08515 00881000
- SR R6,R0 COMPUTE LENGTH OF BEGINNING FIELD 00882000
- SPACE 00883000
- CL R0,F3 THREE CHARACTERS ???? 00884000
- BNE DISICNVT NOT 'END' - BRANCH @VM08515 00885000
- LR R14,R0 COUNT TO GPR 14 00886000
- BCTR R14,0 LESS ONE FOR 'EX' 00887000
- EX R14,ENDCOMP IS IT 'END' ???? 00888000
- BE DISIBLNK BRANCH IF IT IS 00889000
- DISICNVT STM R0,R1,SAVEWRK8 SAVE FOR POSSIBLE ERROR MSG 00890000
- NI SAVEWRK1+1,X'FF'-CONVLEN RESET FLAG @V200930 00891000
- TM SAVEWRK1,RANGE+DISLEN LENGTH RANGE ?? @V200930 00892000
- BNO *+8 NO, NOT LENGTH FIELD @V200930 00893000
- OI SAVEWRK1+1,CONVLEN INDICATE CONVERT LENGTH @V200930 00894000
- BAL R4,CNVTBIN CONVERT END ADDRESS TO BINARY 00895000
- BNZ BADADDR BRANCH IF BAD CONVERT 00896000
- ST R15,TENDADD SAVE TRUE END ADDRESS @VM08524 00897000
- CLI SAVEWRK1+2,C'Y' FLOATING POINT FUNCTION @VM08524 00898000
- BNE REMEND NO -- @VM08524 00899000
- TM SAVEWRK1,DISLEN+RANGE REG COUNT @VM08524 00900000
- BO YREGCNT YES - VALIDATE REG COUNT @VM08524 00901000
- TM TENDADD+3,X'01' VALID Y REG NUMBER @VM08524 00902000
- BO CDM010 NO - REG ODD ERROR @VA01634 00903000
- CL R15,F6 Y REG 0 2 4 6 @VM08524 00904000
- BH CDM010 NO - Y REG ERROR @VA01634 00905000
- B REMEND CONT @VM08524 00906000
- YREGCNT SLL R15,1 X 2 (0 2 4 6) @VA01634 00907000
- BCTR R15,0 -1 FOR LENGTH COUNT @VM08524 00908000
- ST R15,TENDADD UPDATE NEW LENGTH COUNT @VM08524 00909000
- LR R1,R15 CORRECT LENGTH REG @VM08524 00910000
- REMEND LR R2,R1 REMEMBER END ADDRESS @VM08524 00911000
- NI SAVEWRK1+1,X'FF'-CONVLEN RESET LENGTH FLAG @V200930 00912000
- DISTRT LR R0,R6 GET LENGTH OF START CODE @VM08524 00913000
- BCT R0,DISIBGNA SUBTRACT 1 FROM LENGTH FOR TYPE CODE 00914000
- SR R1,R1 SET DEFAULT BEGINNING ADDRESS TO ZERO 00915000
- ST R1,NXTADD .. 00916000
- ST R1,TBEGADD SAVE TRUE BEGIN ADDRESS @VM08524 00917000
- B DISTDOT TEST FOR LENGTH RANGE @V200930 00918000
- DISIBGNA LA R1,1(R5) LOAD ADDRESS OF BEGINNING FIELD 00919000
- STM R0,R1,SAVEWRK6 SAVE FOR POSSIBLE ERROR @VM08524 00920000
- BAL R4,CNVTBIN CONVERT BEGINNING ADDRESS 00921000
- BNZ BADADDR1 BRANCH IF BAD CONVERSION @VM08524 00922000
- ST R15,TBEGADD SAVE TRUE BEGIN ADDRESS @VM08524 00923000
- CL R15,ENDMAX IS IT ABOVE MAXIMUM ? @VM08524 00924000
- BNH RANGOK1 NO, CONTINUE... @VA01634 00925000
- MVC SAVEWRK8(8),SAVEWRK6 FOR ERROR MESSAGE @VA03060 00926000
- TM SAVEWRK1,HEXLOC WHICH KIND OF ERROR? @VA01634 00927000
- BO CDM160 HEXADDR ERROR @VA01634 00928000
- B CDM010 REG ERROR. @VA01634 00929000
- RANGOK1 EQU * @VA01634 00930000
- ST R1,NXTADD INITIALIZE BEGINNING ADDRESS 00931000
- CLI SAVEWRK1+2,C'Y' YREG PROCESSING @VM08524 00932000
- BNE DISTDOT NO -- @VM08524 00933000
- TM TBEGADD+3,X'01' YREG 0 2 4 6 @VM08524 00934000
- BO BADADDR1 NO - YREG ERROR @VM08524 00935000
- DISTDOT TM SAVEWRK1,RANGE+DISLEN IS IT LENGTH RANGE ?? @V200930 00936000
- BNO DISENDA NO, SAVE END ADDRESS @V200930 00937000
- L R15,TENDADD GET BYTE OR REG COUNT VALUE @VM08524 00938000
- A R15,TBEGADD UPDATE TRUE END ADDRESS @VM08524 00939000
- BCTR R15,0 -1 @VM08524 00940000
- ST R15,TENDADD .. @VM08524 00941000
- AL R2,TBEGADD ADD TO THE TRUE BEGIN ADDR @VA03502 00942000
- DISENDA ST R2,ENDADD SET END ADDRESS @VM08524 00943000
- CLC TBEGADD(4),TENDADD START LARGER THAN END @VM08524 00944000
- BH CKRANGE YES, ERROR @VM08524 00945000
- CLC TENDADD(4),ENDMAX END ADDRESS ABOVE MAXIMUM @VM08524 00946000
- BH CKRANGE YES, ERROR @VM08524 00947000
- TM SAVEWRK1,RANGE DISPLAY A RANGE OF ADDRESSES ? 00948000
- BCR 1,R7 YES - RETURN 00949000
- MVC ENDADD,NXTADD MAKE ENDING ADDRESS SAME AS BEGINNING 00950000
- BR R7 RETURN 00951000
- SPACE 00952000
- CKRANGE TM SAVEWRK1,RANGE RANGE OF ADDRESSES ??? 00953000
- BO CDM009 SEND BAD RANGE MESSAGE 00954000
- MVC SAVEWRK8(8),SAVEWRK6 FOR ERROR MESSAGE @VA03060 00955000
- TM SAVEWRK1,HEXLOC LOCATION OR REGISTER ???? 00956000
- BO CDM160 BRANCH IF LOCATION 00957000
- B CDM010 MUST BE REGISTER 00958000
- DISIBLNK L R2,ENDADD SET DEFAULT END ADDRESS @V200930 00959000
- NI SAVEWRK1,X'FF'-DISLEN NO LENGTH ON DEFAULT @V200930 00960000
- B DISTRT CONTINUE @V200930 00961000
- EJECT 00962000
- * 00963000
- * GET NEXT ADDRESS SUBROUTINE 00964000
- * 00965000
- DISNEXTA TM VMRSTAT,VMLOGOFF IS USER LOGGING OFF? @VA03502 00966000
- BO EXIT YES--TERMINATE IT @VA03502 00967000
- L R1,NXTADD LOAD CURRENT ADDRESS @VA03502 00968000
- AH R1,INCRMT GET NEXT ADDRESS @VA03720 00969000
- CL R1,ENDADD GREATER THAN ENDING ADDRESS? @VA03720 00970000
- BH DUMPCHEK YES, GO OUTPUT IF DUMP FUNCTION @VA03720 00971000
- ST R1,NXTADD STORE NEXT ADDR @VA03502 00972000
- B CKDUMP @VA03502 00973000
- DISNCOMM TM VMRSTAT,VMLOGOFF IS USER LOGGING OFF ? 00974000
- BO EXIT YES TERMINATE THE DUMP OR DISPLAY 00975000
- CL R1,ENDADD GREATER THAN ENDING ADDRESS ? 00976000
- BH DUMPCHEK YES-GO SEE IF DUMP FUNCTION 00977000
- ST R1,NXTADD STORE NEXT ADDRESS 00978000
- CKDUMP EQU * @VA03502 00979000
- LH R4,INCRMT GET CURRENT INCREMENT @V200930 00980000
- CH R4,F4+2 IS IT STORAGE INCREMENT ?? @V200930 00981000
- BCR 7,R7 NO, CONT @V200930 00982000
- LR R4,R1 GET NEXT ADDRESS .... ASSUME @V200930 00983000
- * LOCATION 00984000
- N R4,XRIGHT16 TEST FOR SEG BOUND START @V200930 00985000
- BCR 7,R7 NO, CONT @V200930 00986000
- CALL DMKCVTBH CONVERT ADDRESS @V200930 00987000
- MVC FIELD(L'DUMPMSG),DUMPMSG SET IN MSG @V4075A0 00988000
- STCM R0,B'0011',FIELD+L'DUMPMSG PUT INTO USER MSG @V4075A0 00989000
- STCM R1,B'1111',FIELD+L'DUMPMSG+2 6 BYTES OF VAR INF @V4075A0 00990000
- LA R0,L'DUMPMSG+6 SIZE @V4075A0 00991000
- LA R1,FIELD MESSAGE FOR DUMPING @V4075A0 00992000
- CALL DMKQCNWT,PARM=0 WIAT FOR WRITE @V200930 00993000
- BNZ EXIT STOP THE DUMP @V200930 00994000
- L R1,NXTADD SET NEXT ADDRESS FOR DISPLAY @V200930 00995000
- BR R7 CONTINUE 00996000
- DUMPCHEK EQU * 00997000
- BAL R4,DISWRITE OUTPUT LINE 00998000
- MVC BFRCNT(2),BUFMAX PUT SOMETHING IN BFRCNT 00999000
- BAL R4,DISWRITE PRINT BLANK LINE 01000000
- TM SAVEWRK1,DUMPC+VIRTC IS THIS A VIRTUAL DUMP ???? 01001000
- BNO DISGETN GET NEXT FILED @V200930 01002000
- TM SAVEWRK1,BYPGPR FINISHED NEXT DUMP FIELD ?? @V200930 01003000
- BO DISGETN YES, GET NEXT FIELD @V200930 01004000
- L R15,SAVEWRK2 LOAD INDEX 01005000
- LA R15,4(,R15) BUMP INDEX COUNT 01006000
- ST R15,SAVEWRK2 STORE NEW INDEX COUNT 01007000
- B DUMPINDX(R15) DO NEXT DUMP FUNCTION @V200930 01008000
- DUMPSTRT TM SAVEWRK1,BYPGPR DOING NEXT DUMP FILED ?? @V200930 01009000
- BO DISLOC YES, LOCATIONS ONLY @V200930 01010000
- DUMPINDX B DUMPGPR GO DUMP GENERAL REGISTERS @V200930 01011000
- B DUMPECR GO DUMP CONTROL REGISTERS 01012000
- B DUMPFPR GO DUMP FLOATING POINT REGISTERS 01013000
- B DUMPKEY GO DUMP THE STORAGE KEYS 01014000
- B DUMPPSW GO DUMP THE PSW 01015000
- B DISLOC DUMP LOCATIONS 01016000
- OI SAVEWRK1,BYPGPR DONE REGS,DONT DO AGAIN @V200930 01017000
- B DISGETN GET NEXT FIELD @V200930 01018000
- SPACE 01019000
- DUMPMSG DC C'DUMPING LOC ' @V200930 01020000
- EJECT 01021000
- USING BUFFER,R9 01022000
- SPACE 01023000
- DISDMPID LM R0,R1,BUFNXT SAVE NEXT AND COUNT FOR COMMAND LINE 01024000
- STM R0,R1,SAVEWRK8 . . . 01025000
- GETDMPID CALL DMKSCNFD GET FIELD NEXT @V200930 01026000
- BNZ DMPIDAD NONE, SET DUMP ADDRESSES @V200930 01027000
- CLI 0(R1),C'*' IS IT THE DUMP ID ?? @V200930 01028000
- BNE GETDMPID NO, LOOP TIL FOUND OR END @V200930 01029000
- LR R3,R1 REMEMBER START OF FIELD @V200930 01030000
- DMPID CALL DMKSCNFD GET MORE FILEDS OF ID @V200930 01031000
- BZ DMPID LOOP TIL END @V200930 01032000
- L R2,BUFNXT GET LAST POSITION ADDRESS @V200930 01033000
- SR R2,R3 MINUS BEGGINING IS THE LENGTH @V200930 01034000
- BNP DMPIDAD NONE SET DUMP ADDRESSES @V200930 01035000
- CL R2,=F'100' ONLY 100 CHARACTERS ALLOWED @V200930 01036000
- BL *+8 OK, CONT @V200930 01037000
- LA R2,100 SET MAX @V200930 01038000
- BCTR R2,R0 SET FOR EXECUTE @V200930 01039000
- EX R2,MOVEID SET DUMP ID @V200930 01040000
- DMPIDAD MVC BUFBUF(8),CDUMPLOC 'DUMP LOC' FOR HEADER @V4075A0 01041000
- L R1,NXTADD GET DUMP START @V200930 01042000
- CALL DMKCVTBH CONVERT @V200930 01043000
- STCM R0,B'0011',BUFBUF+9 PUT START ADDRESS (6 @V4075A0 01044000
- STCM R1,B'1111',BUFBUF+11 BYTES) INTO OUTPUT @V4075A0 01045000
- MVI BUFBUF+15,C'-' EDIT @V200930 01046000
- L R1,ENDADD GET END ADDRESS @V200930 01047000
- CALL DMKCVTBH CONVERT @V200930 01048000
- STCM R0,B'0011',BUFBUF+16 @V4075A0 01049000
- STCM R1,B'1111',BUFBUF+18 PUT END ADDRESS INTO BUF@V4075A0 01050000
- MVC BFRCNT(2),BUFMAX PUT COUNT IN BFRCNT FOR DISWRITE 01051000
- BAL R4,DISWRITE GO OUTPUT LINE 01052000
- MVC BFRCNT(2),BUFMAX PUT COUNT IN BFRCNT AGAIN 01053000
- BAL R4,DISWRITE NOW PRINT BLANK LINE 01054000
- SPACE 01055000
- LM R0,R1,SAVEWRK8 RESTORE BUFNXT AND BUFCOUNT @VM08515 01056000
- STM R0,R1,BUFNXT . . . 01057000
- BR R7 RETURN 01058000
- SPACE 01059000
- ENDCOMP CLC 0(0,R1),=C'END ' EXECUTED COMPARE 01060000
- EJECT 01061000
- ********************************************************************* 01062000
- * 01063000
- * SUBROUTINE TO FORMAT LINE HEADER & TRAILER 01064000
- * 01065000
- ********************************************************************* 01066000
- DISHEAD L R1,NXTADD GET NEXT ADDRESS 01067000
- CLC IDCHAR,CLOC DISPLAY OR DUMP STORAGE COMMAND? @V4075A0 01068000
- BE DISHCORE BRANCH IF YES 01069000
- MVC BUFBUF(3),IDCHAR MOVE IDENTIFICATION TO BUFFER 01070000
- CALL DMKCVTBD CONVERT REGISTER NUMBER TO DECIMAL 01071000
- STH R1,BUFBUF+4 STORE IN BUFFER 01072000
- CLI BUFBUF+4,C'0' LEADING ZERO ? 01073000
- BNE DISHSETP BRANCH IF NO 01074000
- MVI BUFBUF+4,C' ' YES - REPLACE WITH A BLANK 01075000
- DISHSETP MVI BUFBUF+7,C'=' 01076000
- DISHSETC LA R1,BUFBUF+10 SET ADDRESS 01077000
- ST R1,BUFPNT STORE POINTER 01078000
- MVC BFRCNT,F10+2 SET COUNT = 10 @V4075A0 01079000
- BR R8 RETURN 01080000
- SPACE 2 01081000
- DISHCORE EQU * 01082000
- TM BUFLAG,FIRSTL IS THIS THE 1ST LINE ? 01083000
- BO DISH1STL BRANCH IF YES 01084000
- TM BUFLAG,SAMEL LINES ALREADY SUPPRESSED ? 01085000
- BO DISHSUPP BRANCH IF YES 01086000
- BAL R15,SETR14 GO SET UP 'EX' REG. 01087000
- L R1,NXTADD RELOAD NEXT ADDRESS 01088000
- EX R14,DISHCLCL SAME AS LAST LINE ? 01089000
- BNE DISHSAVE BRANCH IF NO 01090000
- OI BUFLAG,SAMEL TURN ON SAME AS LAST LINE SWITCH 01091000
- CALL DMKCVTBH CONVERT ADDRESS TO HEX 01092000
- STCM R0,B'0011',BUFBUF @V4075A0 01093000
- STCM R1,B'1111',BUFBUF+2 MOVE ADDR (6 BYTES) TO BUF@V4075A0 01094000
- L R1,NXTADD RELOAD CURRENT ADDRESS 01095000
- MVC BUFBUF+7(2),=C'TO' 01096000
- MVC BUFBUF+19(L'SUPPLMSG),SUPPLMSG MOVE MESSAGE TEXT 01097000
- MVC BFRCNT,=AL2(L'SUPPLMSG+19) SET BYTE COUNT 01098000
- DISHBUMP AH R1,BUFTRC BUMP TO NEXT LINE ADDRESS 01099000
- TM SAVEWRK1,VIRTC REAL OR VIRTUAL 01100000
- BO DISHVIRT BRANCH AROUND IF IT'S VIRTUAL 01101000
- L R14,=A(DMKSYSRM) GET ADDRESS OF TOP 01102000
- L R14,0(,R14) LOAD THE ADDRESS 01103000
- B DISHCKR1 GO SEE IF IT WILL FIT 01104000
- DISHVIRT EQU * 01105000
- L R14,VMSIZE LOAD VIRTUAL MACHINE SIZE 01106000
- DISHCKR1 EQU * 01107000
- CR R1,R14 ADDRESS IN R1 TOO HIGH 01108000
- BNH DISHSTR1 BRANCH IF IT ISN'T 01109000
- LR R1,R14 MAKE IT VALID 01110000
- DISHSTR1 EQU * 01111000
- ST R1,NXTADD SAVE NEW ADDRESS 01112000
- CALL DMKCVTBH CONVERT ADDRESS TO HEX 01113000
- STCM R0,B'0011',BUFBUF+10 AND STORE INTO OUTPUT @V4075A0 01114000
- STCM R1,B'1111',BUFBUF+12 @V4075A0 01115000
- L R1,NXTADD RELOAD NEXT ADDRESS 01116000
- B DISNCOMM CHECK NEXT ADDRESS 01117000
- EJECT 01118000
- DISH1STL NI BUFLAG,NFIRSTL TURN OFF 1ST LINE SWITCH 01119000
- DISHSAVE NI BUFLAG,NSAMEL TURN OFF SUPPRESSED LINES SWITCH 01120000
- CALL DMKCVTBH CONVERT ADDRESS TO HEX @VM08515 01121000
- STCM R0,B'0011',BUFBUF @V4075A0 01122000
- STCM R1,B'1111',BUFBUF+2 PLACE INTO OUTPUT BUFFER @V4075A0 01123000
- BAL R15,SETR14 GO SET UP 'EX' REG. 01124000
- EX R14,DISHMVCL SAVE NEXT 16 OR 32 BYTES 01125000
- LA R1,BUFBUF+92 POINT TO KEY AREA 01126000
- CH R14,=H'31' LONG LINE ?? 01127000
- BE *+8 YES 01128000
- LA R1,BUFBUF+49 POINT TO KEY IN SHORT LINE @V200930 01129000
- LR R4,R1 SAVE BUFFER ADDRESS 01130000
- LR R1,R2 GET DATA ADDRESS 01131000
- N R1,=F'2047' AT 2K BOUNDARY ?? 01132000
- BNZ BUFUP NO .. 01133000
- ST R14,REGSAVE SAVE ACROSS SUBROUTINE @VM08553 01134000
- STM R2,R3,REGSAVE+4 ... @VM08553 01135000
- L R1,NXTADD GET THE ADDRESS OF THIS PAGE @VM08854 01136000
- TM SAVEWRK1,VIRTC IS THIS VIRT STORAGE? @VM08854 01137000
- BO CDMK01 VIRT, LET SUBROUTINE DO IT @VM08854 01138000
- SR R1,R1 CLEAR OUT FOR CVT ROUTINE @VM08854 01139000
- ISK R1,R2 GET THE REAL STUFF @VM08854 01140000
- B CDMK02 AND CONTINUE NORMALLY @VM08854 01141000
- SPACE 01142000
- CDMK01 BAL R15,GETKEY GO GET THE KEY @VM08854 01143000
- CDMK02 CALL DMKCVTBH CONVERT @VM08854 01144000
- L R14,REGSAVE RESTORE FOR RETURN 01145000
- LM R2,R3,REGSAVE+4 RESTORE THE REGS @VM08553 01146000
- STH R1,0(R4) PUT KEY IN LINE 01147000
- BUFUP LR R1,R4 RESTORE BUFFER ADDRESS 01148000
- LA R1,4(R1) POINT TO TRANSLATE AREA 01149000
- MVI 0(R1),C'*' 01150000
- EX R14,DISHMVCB MOVE LINE TO BUFFER 01151000
- L R15,=A(DMKDMPTR) LOAD TRANSLATE TABLE ADDRESS 01152000
- EX R14,DISHTRLN TRANSLATE TO PRINTABLE CHARACTERS 01153000
- LA R1,2(R14,R1) BUMP POINTER TO NEXT BYTE 01154000
- MVI 0(R1),C'*' 01155000
- B DISHSETC SET POINTER AND COUNT 01156000
- SPACE 2 01157000
- DISHSUPP EQU * 01158000
- BAL R15,SETR14 GO SET UP 'EX' REG. 01159000
- L R1,NXTADD RELOAD NEXT ADDRESS 01160000
- EX R14,DISHCLCL SAME AS LAST LINE ? 01161000
- BE DISHBUMP BRANCH IF YES 01162000
- BAL R4,DISWRITE OUTPUT SUPPRESSED LINES MESSAGE 01163000
- TM SAVEWRK1,VIRTC VIRTUAL REQUEST ????? 01164000
- BZ DISHSAVE NO -- NO NEED TO DO TRANS 01165000
- TRANS 2,1,OPT=(BRING,DEFER) MAKE SURE ADDRESS STILL IN !! 01166000
- B DISHSAVE SAVE THIS LINE 01167000
- SPACE 2 01168000
- ********************************************************************* 01169000
- * * 01170000
- * THIS SUBROUTINE INSURES THAT R14 WHICH IS USED FOR EXECUTED * 01171000
- * COMPARES AND MOVES DOES NOT CONTAIN A COUNT THAT WILL * 01172000
- * GO PAST THE END OF REAL STORAGE * 01173000
- * * 01174000
- ********************************************************************** 01175000
- SPACE 2 01176000
- SETR14 LH R14,BUFTRC LOAD NORMAL TRANSLAT COUNT 01177000
- L R1,=A(DMKSYSRM) ADDRESS OF TOP OF STORAGE CONST. 01178000
- L R0,0(,R1) TOP OF STORAGE TO R0 01179000
- SR R0,R2 DIFFERENCE BETWEEN PRESENT AND TOP 01180000
- CR R0,R14 COMPARE THE COUNTS 01181000
- BH R14OK R14 IS VALID IF BRANCH 01182000
- LR R14,R0 IF NOT - MAKE IT VALID 01183000
- R14OK BCTR R14,0 MINUS ONE FOR THE EXECUTES 01184000
- BR R15 GO BACK 01185000
- SPACE 6 01186000
- * EXECUTED INSTRUCTIONS 01187000
- SPACE 01188000
- DISHCLCL CLC LNSAVE(0),0(R2) 01189000
- DISHMVCL MVC LNSAVE(0),0(R2) 01190000
- DISHMVCB MVC 1(0,R1),0(R2) 01191000
- DISHTRLN TR 1(0,R1),0(R15) 01192000
- MOVEID MVC BUFBUF+25(*-*),0(R3) EXECUTED FOR DUMP ID @V200930 01193000
- EJECT 01194000
- * 01195000
- * OUTPUT SUBROUTINE 01196000
- * 01197000
- DISWRITE TM VMRSTAT,VMLOGOFF IS USER LOGGING OFF ? 01198000
- BO EXIT YES TERMINATE THE DUMP OR DISPLAY 01199000
- TM VMOSTAT,VMKILL IS USER BEING FORCED OFF @VA05493 01200000
- BO EXIT YES, TERMINATE DUMP OR DISPLAY @VA05493 01201000
- STM R0,R3,REGSAVE SAVE REGISTERS 01202000
- LH R0,BFRCNT LOAD BUFFER BYTE COUNT 01203000
- LTR R0,R0 IS IT ZERO ? 01204000
- BZ DISWRTOK YES - NOTHING TO OUTPUT 01205000
- LR R1,R10 LOAD BUFFER ADDRESS 01206000
- DISWPRT EQU * 01207000
- TM LINECNT,X'FF' TEST IF LINECOUNT IS ZERO 01208000
- BZ DISSKIP BRANCH IF IT IS 01209000
- DISWPRTA LA R0,132 SIZE OF LINE 01210000
- CALL DMKVSPRT OUTPUT LINE 01211000
- LTR R2,R2 GOOD RETURN FROM VSPOOL @VA01024 01212000
- BZ DISBMPLC YES - GO BUMP LINE COUNT @VA01024 01213000
- CL R2,F4 PRINTER NOT AVAILABLE ????? @VA01024 01214000
- BE CDM060 YEP - GO SEND MESSAGE @VA01024 01215000
- B CDM061 MUST BE SPOOL PROBLEM @VA01024 01216000
- DISBMPLC EQU * @VA01024 01217000
- IC R2,LINECNT INSERT LINECOUNT 01218000
- BCTR R2,0 SUBTRACT ONE 01219000
- STC R2,LINECNT STORE DECREMENTED COUNT 01220000
- DISWRTOK ST R10,BUFPNT RESET BUFFER POINTER 01221000
- MVC BFRCNT(2),ZEROES ZERO THE BYTE COUNT 01222000
- MVI BUFBUF,C' ' CLEAR BUFFER 01223000
- MVC BUFBUF+1(131),BUFBUF 01224000
- LM R0,R3,REGSAVE RESTORE REGISTERS 01225000
- BR R4 RETURN 01226000
- SPACE 01227000
- DISSKIP SR R0,R0 ZERO GPR0 01228000
- CALL DMKVSPRT SKIP TO NEXT PAGE 01229000
- MVI LINECNT,60 SET NUMBER OF LINES TO 60/PAGE 01230000
- B DISWPRTA NOW GO OUTPUT LINE 01231000
- EJECT 01232000
- ********************************************************************* 01233000
- * SUBROUTINE TO CONVERT AN ADDRESS TO BINARY 01234000
- * 01235000
- * ON ENTRY - R0 = LENGTH OF FIELD 01236000
- * R1 = LOCATION OF FIELD 01237000
- * ON EXIT - R1 = RESULT OF CONVERSION TRUNCATED 01238000
- * TO INCREMENT BOUNDARY 01239000
- * CC = 0 IF CONVERSION IS SUCCESSFUL 01240000
- * CC = 1 IF CONVERSION ERROR 01241000
- * 01242000
- ********************************************************************* 01243000
- CNVTBIN CL R0,FLDLEN LENGTH GREATER THAN MAX ? @VM08524 01244000
- BH CDM003 YES - ERROR DMKCDM003 @VM08524 01245000
- STM R0,R1,REGSAVE SAVE INPUT CONDITIONS @VM08524 01246000
- TM SAVEWRK1+1,CHEX HEXADECIMAL FIELD ? 01247000
- BO CNVTHEX BRANCH IF YES 01248000
- CALL DMKCVTDB CONVERT TO BINARY 01249000
- BZ CNVTCOMM BRANCH IF CONVERSION OK 01250000
- LM R0,R1,REGSAVE RESTORE INPUT CONDITIONS 01251000
- CNVTHEX CALL DMKCVTHB CONVERT TO BINARY 01252000
- BCR 7,R4 RETURN IF BAD CONVERSION 01253000
- CNVTCOMM LH R0,INCRMT LOAD ADDRESS INCREMENT 01254000
- LCR R0,R0 LOAD COMPLEMENT OF INCREMENT 01255000
- LR R15,R1 SAVE TRUE ADDRESS @VM08524 01256000
- TM SAVEWRK1+1,CONVLEN CONVERT LENGTH FIELD ?? @V200930 01257000
- BZ TRUNC NO, TRUNC FOR ALIGN @V200930 01258000
- LTR R1,R1 IS LENGTH ZERO ?? @V200930 01259000
- BZ BADADDR YES, INVALID LENGTH @VM08524 01260000
- BCTR R1,R0 ONE LESS IN R1 FOR RANGE @V200930 01261000
- TRUNC DS 0H @V200930 01262000
- NR R1,R0 TRUNCATE TO INCREMENT BOUNDARY 01263000
- SR R0,R0 SET CC = 0 01264000
- BR R4 RETURN TO CALLER 01265000
- EJECT 01266000
- CONFMSG MSG 'COMMAND COMPLETE' 01267000
- CALL DMKQCNWT,PARM=NORET 01268000
- B EXIT 01269000
- BADADDR1 LM R0,R1,SAVEWRK6 LEN AND ADDRESS OF STARTING FIELD@VM08524 01270000
- B *+8 CHECK WHICH ERROR @VM08524 01271000
- BADADDR LM R0,R1,SAVEWRK8 LOAD LEN. AND ADDRESS OF BAD ARGUMENT 01272000
- TM SAVEWRK1+1,CONVLEN CONVERT LENGTH ERROR? @VA03060 01273000
- BO CDM003 BRANCH IF YES @VA03060 01274000
- TM SAVEWRK1,HEXLOC LOCATION REQUEST 01275000
- BO CDM004 BR. IF YES 01276000
- CDM003 LA R2,3 ERROR CODE 01277000
- B PARMLEN SET PARM LENGTH @VM08524 01278000
- SPACE 01279000
- CDM004 LA R2,4 ERROR CODE 01280000
- B PARMLEN SET PARM LENGTH @VM08524 01281000
- SPACE 01282000
- CDM009 LA R2,009 ERROR CODE 01283000
- L R1,TBEGADD GET TRUE BEGIN ADDRESS @VM08524 01284000
- TM SAVEWRK1,HEXLOC HEX LOC OR REGISTER ?? @V200930 01285000
- BO CVTH1 HEX @V200930 01286000
- CALL DMKCVTBD CONVERT TO DEC @V200930 01287000
- B STCM1 SAVE VALUES @V200930 01288000
- CVTH1 CALL DMKCVTBH CONVERT TO HEX @V200930 01289000
- STCM1 DS 0H @V200930 01290000
- STCM R0,3,BUFBUF STORE HEXLOC 01291000
- STCM R1,15,BUFBUF+2 . . . 01292000
- MVI BUFBUF+6,C'-' INSERT HYPHEN 01293000
- L R1,TENDADD LOAD TRUE END ADDRESS @VM08524 01294000
- TM SAVEWRK1,HEXLOC HEX OR DEC CONVERT ?? @V200930 01295000
- BO CVTH2 HEX @V200930 01296000
- CALL DMKCVTBD CONVERT TO DEC @V200930 01297000
- B STCM2 SAVE VALUES @V200930 01298000
- CVTH2 CALL DMKCVTBH CONVERT TO HEX @V200930 01299000
- STCM2 DS 0H @V200930 01300000
- STCM R0,3,BUFBUF+7 STORE AWAY 01301000
- STCM R1,15,BUFBUF+9 . . . 01302000
- TM SAVEWRK1,HEXLOC HEX LOCATION ?? @V200930 01303000
- BO STCM3 YES, CONT @V200930 01304000
- STCM R1,3,BUFBUF+7 SET VALUE FOR REG @V200930 01305000
- LA R0,5 SIZE @V200930 01306000
- LA R1,BUFBUF+4 DATA ADDRESS @V200930 01307000
- B CALLERM DO ERROR MESSAGE @V200930 01308000
- STCM3 DS 0H @V200930 01309000
- LA R0,13 LENGTH OF FIELD 01310000
- LA R1,BUFBUF SET DATA ADDRESS @V200930 01311000
- B CALLERM 01312000
- SPACE 01313000
- CDM010 LA R2,010 ERROR CODE - MESSAGE DMKCDM010 @VM08524 01314000
- B ERRPARM GO SET UP ERROR PARM @VM08524 01315000
- SPACE 01316000
- CDM026 LA R2,26 ERROR CODE 01317000
- B NOVAR . . . 01318000
- SPACE 01319000
- CDM033 LA R2,33 ERROR CODE 01320000
- B NOVAR . . . 01321000
- SPACE 01322000
- CDM060 LA R2,60 ERROR CODE @VA01024 01323000
- B NOVAR . . . @VA01024 01324000
- SPACE 01325000
- CDM061 LA R2,61 ERROR CODE @VA01024 01326000
- B NOVAR . . . @VA01024 01327000
- SPACE 01328000
- CDM160 LA R2,160 ERROR CODE - MESSAGE DMKCDM160 @VM08524 01329000
- ERRPARM LM R0,R1,SAVEWRK8 COUNT AND ADDRESS OF ERROR OPTION@VM08524 01330000
- PARMLEN C R0,F24 COUNT OVER MAX @VM08524 01331000
- BNH *+8 NO - @VM08524 01332000
- LA R0,24 SET MAX COUNT @VM08524 01333000
- B CALLERM . . . 01334000
- SPACE 01335000
- NOVAR SR R1,R1 ZERO PARM REG 01336000
- SPACE 01337000
- SPACE 01338000
- CALLERM ICM R0,14,MODID+3 INSERT MODULE ID 01339000
- ICM R2,B'1000',X40FFS FLAG TO FRET BUFFER, NOT RTN@V4075A0 01340000
- L R3,SAVEWRK4 LOAD ADDRESS AND LENGTH OF BUFFER 01341000
- CALL DMKERMSG . . . 01342000
- * 01343000
- * DMKERM MODULE WILL FRET THE BUFFER, SVC16 THE SAVEAREA OUT, 01344000
- * AND RETURN DIRECTLY TO DMKCFM TO PROCESS THE NEXT COMMAND. 01345000
- * 01346000
- EJECT 01347000
- EXIT EQU * 01348000
- TM VMPSTAT,VMV370R EXTENDED-CONTROL MACHINE? 01349000
- BZ EXITOUT NO - CONTINUE 01350000
- TM VMESTAT,VMNEWCR0+VMINVSEG+VMINVPAG 01351000
- BZ EXITOUT NOTHING NEEDS CLEANUP 01352000
- CALL DMKVATAB CLEAN UP SHADOW TABLES 01353000
- EXITOUT LA R0,BFRSIZE FRET OUTPUT BUFFER @VM08524 01354000
- LR R1,R10 ADDRESS OF BUFFER @VM08524 01355000
- CALL DMKFRET .. @VM08524 01356000
- EXIT @VM08515 01357000
- EJECT 01358000
- *********************************************************************** 01359000
- * 01360000
- * CONSTANTS * 01361000
- * * 01362000
- KEYEQ DC C'KEY =' 01363000
- SUPPLMSG DC C'SUPPRESSED LINE(S) SAME AS ABOVE .....' 01364000
- CPSWEQ DC C'PSW =' @V4075A0 01365000
- CDUMPLOC DC C'DUMP LOC' @V4075A0 01366000
- CLOC EQU CDUMPLOC+5 @V4075A0 01367000
- SPACE 01368000
- LTORG 01369000
- EJECT 01370000
- * 01371000
- * OUTPUT BUFFER DSECT 01372000
- * 01373000
- SPACE 3 01374000
- DISPBFR DSECT 01375000
- BUFBUF DS CL132 132 CHARACTER BUFFER 01376000
- BUFPNT DS F POINTER TO NEXT AVAILABLE BYTE 01377000
- BFRCNT DS H BYTE COUNT OF CHARACTERS IN BUFFER 01378000
- BUFMAX DS H MAXIMUM VALUE OF BUFCNT 01379000
- BUFTRC DS H NUMBER OF BYTES TO BE TRANSLATED 01380000
- BUFLAG DS XL1 FLAG BYTE 01381000
- * 01382000
- * X'80' - THE OUTPUT IS TO BE PRINTED 01383000
- * X'40' - THIS IS THE 1ST LINE OF OUTPUT 01384000
- * X'20' - THIS DUMP LINE IS THE SAME AS THE LAST LINE 01385000
- * X'10' - THIS LINE HAS BEEN TRANSLATED TO EBCDIC 01386000
- * X'08' - INVALID VIRTUAL PAGE WITHIN ADDRESS RANGE 01387000
- * 01388000
- LINECNT DS XL1 COUNT OF LINES ON PAGE OF DUMP 01389000
- INCRMT DS H ADDRESS INCREMENT 01390000
- DS H 01391000
- IDCHAR DS CL3 LINE IDENTIFICATION CHARACTERS 01392000
- DS XL1 01393000
- NXTADD DS F NEXT ADDRESS TO BE DISPLAYED 01394000
- ENDADD DS F LAST ADDRESS TO BE DISPLAYED 01395000
- TBEGADD DS F TRUE BEGIN ADDRESS @VM08524 01396000
- TENDADD DS F TRUE END ADDRESS @VM08524 01397000
- ENDMAX DS F MAXIMUM END ADDRESS @VM08524 01398000
- FLDLEN DS F MAXIMUM ADDRESS LENGTH @VM08524 01399000
- FIELD DS 3D WORK AREA 01400000
- DUMPLOC EQU FIELD+L'DUMPMSG VARIABLE LOC ADDR GOES HERE @V4075A0 01401000
- LNSAVE DS XL32 DUMP SAVE AREA 01402000
- REGSAVE DS 4F TEMPORARY SAVE AREA FOR R0-R3 01403000
- BFRSIZE EQU (*-BUFBUF+7)/8 BUFFER SIZE IN DOUBLE WORDS @VM08524 01404000
- SPACE 3 01405000
- * EQUATES FOR BUFLAG 01406000
- PRINTER EQU X'80' 01407000
- FIRSTL EQU X'40' 01408000
- NFIRSTL EQU X'BF' 01409000
- SAMEL EQU X'20' 01410000
- NSAMEL EQU X'DF' 01411000
- TRANSLAT EQU X'10' 01412000
- INVLD EQU X'08' INVALID VIRTUAL PAGE WITHIN @V304635 01413000
- * ADDRESS RANGE 01414000
- EJECT 01415000
- DMKCDM CSECT 01416000
- EJECT 01417000
- PSA , @V306638 01418000
- COPY CONBUF @V306638 01419000
- COPY EQU @V306638 01420000
- COPY SAVE @V306638 01421000
- COPY VMBLOK @V306638 01422000
- END 01423000
ibm/vm370-lib/cp/dmkcdm.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator