CDB TITLE 'DMKCDB (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* MODULE NAME - 00004000
* DMKCDB 00005000
* FUNCTION - 00006000
* TO EXECUTE THE DISPLAY AND DCP COMMANDS 00007100
* 00008000
* ATTRIBUTES - 00009000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00010000
* 00011000
* ENTRY POINTS - 00012000
* DMKCDBDC - TO DISPLAY REAL STORAGE. 00013000
* DMKCDBDI - TO DISPLAY VIRTUAL STORAGE. 00014000
* 00017000
* ENTRY CONDITIONS - 00018000
* GPR9 - ADDRESS OF THE COMMAND LINE. 00019000
* GPR11 - ADDRESS OF THE USERS VMBLOK. 00020000
* GPR12 - ADDRESS OF THE ENTRY POINT. 00021000
* GPR13 - ADDRESS OF THE STANDARD SAVE AREA. 00022000
* 00023000
* EXIT CONDITIONS - 00024000
* NORMAL - 00025000
* GPR2 = 0 00026000
* 00027000
* ERROR - 00028000
* GPR2 = ERROR MESSAGE CODE NUMBER 00029000
* 00030000
* CALLS TO OTHER ROUTINES - 00031000
* DMKSCNFD - TO LOCATE THE NEXT ARGUMENT IN THE COMMAND LINE 00032000
* DMKCVTBD - CONVERT BINARY NUMBER TO DECIMAL 00033000
* DMKCVTBH - CONVERT BINARY NUMBER TO HEXADECIMAL 00034000
* DMKCVTDB - CONVERT DECIMAL NUMBER TO BINARY 00035000
* DMKCVTHB - CONVERT HEXADECIMAL NUMBER TO BINARY 00036000
* DMKCVTFP - CONVERT FLOATING POINT NUMBER TO PRINTABLE FORM 00037000
* DMKFREE - TO GET STORAGE FOR AN OUTPUT BUFFER 00038000
* DMKFRET - TO RETURN STORAGE TO THE SYSTEM 00039000
* DMKVATAB - TO MAINTAIN SHADOW PAGE AND SEGMENT TABLES 00040000
* DMKQCNWT - TO SEND MESSAGES TO THE TERMINAL 00041000
* DMKVSPRT - PRINT LINE OF DUMP TO THE SPOOL PRINTER 00042000
* DMKPTRAN - TO BRING USER PAGE INTO STORAGE 00043000
* DMKERMSG - TO TYPE ERROR MESSAGES 00044000
* 00045000
* TABLES/WORKAREAS 00046000
* ECBLOK 00047000
* PSA 00048000
* SAVEAREA 00049000
* VMBLOK 00050000
* OUTPUT BUFFER CONTAINS CONTROL INFORMATION 00051000
* THE FORMAT AND DESCRIPTION OF THE BUFFER ARE IN A DSECT BELOW 00052100
* 00054000
* REGISTER USAGE - 00055000
* GPR0 - FIELD LENGTH REGISTER 00056000
* GPR1 - POINTER TO NEXT FIELD IN BUFFER AND REAL STORAGE ADDR. 00057000
* GPR2 - PARAMETER REGISTER FOR CALLED ROUTINES. 00058000
* GPR3 - ADDRESS OF THE PAGE TABLE 00059000
* GPR4 - BAL REGISTER (3RD LEVEL) 00060000
* GPR5 - POINTER TO THE NEXT ARGUMENT IN THE INPUT BUFFER 00061000
* GPR6 - LENGTH ON NEXT ARGUMENT IN THE INPUT BUFFER 00062000
* GPR7 - BAL REGISTER (1ST LEVEL) 00063000
* GPR8 - BAL REGISTER (2ND LEVEL) 00064000
* GPR9 - ADDRESS OF THE COMMAND LINE 00065000
* GPR10 - BASE REGISTER FOR THE OUTPUT BUFFER 00066000
* GPR11 - ADDRESS OF THE VMBLOK 00067000
* GPR12 - BASE REGISTER FOR THIS PROGRAM 00068000
* GPR13 - ADDRESS OF THE STANDARD SAVEAREA 00069000
* GPR14 - LINKAGE REGISTER 00070000
* GPR15 - LINKAGE REGISTER 00071000
* 00072000
* NOTES - 00073000
* NONE 00074000
* 00075000
* OPERATION - 00076000
* THE COMMAND ROUTINES ARE CALLED BY THE COMMAND 00077000
* ANALYSIS ROUTINE DMKCFM. 00078000
* THE FORMAT AND DESCRIPTION OF EACH COMMAND IS LISTED IN 00079000
* SEPARATE PROLOGUES BELOW. 00080000
*. 00081000
EJECT 00082000
ISEQ 73,80 00083000
COPY OPTIONS 00084000
EJECT 00085000
COPY LOCAL 00086000
EJECT 00087000
PUNCH 'SPB' 00088000
SPACE 2 00089000
DMKCDB START 00090000
SPACE 00091000
MODID DC CL8'DMKCDB' 00092000
USING PSA,R0 00093000
USING VMBLOK,R11 00094000
USING SAVEAREA,R13 00095000
SPACE 3 00096000
EXTRN DMKERMSG 00097000
EXTRN DMKVSPRT @V200820 00098000
EXTRN DMKCVTBD,DMKCVTBH,DMKCVTDB,DMKCVTHB,DMKCVTFP 00099000
EXTRN DMKSYSRM 00100000
EXTRN DMKSCNFD 00101000
EXTRN DMKDMPTR 00102000
EXTRN DMKVATAB @V200820 00103000
EXTRN DMKSYSAP @V4075A0 00103100
EJECT 00104000
* 00105000
* OUTPUT BUFFER DSECT 00106000
* 00107000
SPACE 00108000
USING DISPBFR,R10 00109000
SPACE 00110000
DISPBFR DSECT 00111000
BUFBUF DS CL132 132 CHARACTER BUFFER 00112000
BUFPNT DS F POINTER TO NEXT AVAILABLE BYTE 00113000
BFRCNT DS H BYTE COUNT OF CHARACTERS IN BUFFER 00114000
BUFMAX DS H MAXIMUM VALUE OF BUFCNT 00115000
BUFTRC DS H NUMBER OF BYTES TO BE TRANSLATED 00116000
BUFLAG DS XL1 FLAG BYTE 00117000
* 00118000
* X'80' - THE OUTPUT IS TO BE PRINTED 00119000
* X'40' - THIS IS THE 1ST LINE OF OUTPUT 00120000
* X'20' - THIS DUMP LINE IS THE SAME AS THE LAST LINE 00121000
* X'10' - THIS LINE HAS BEEN TRANSLATED TO EBCDIC 00122000
* X'08' - INVALID VIRTUAL PAGE WITHIN ADDRESS RANGE 00123000
* 00124000
LINECNT DS XL1 COUNT OF LINES ON PAGE OF DUMP 00125000
INCRMT DS H ADDRESS INCREMENT 00126000
DS H 00127000
IDCHAR DS CL3 LINE IDENTIFICATION CHARACTERS 00128000
DS XL1 00129000
NXTADD DS F NEXT ADDRESS TO BE DISPLAYED 00130000
ENDADD DS F LAST ADDRESS TO BE DISPLAYED 00131000
TBEGADD DS F TRUE BEGIN ADDRESS @VM08524 00132000
TENDADD DS F TRUE END ADDRESS @VM08524 00133000
ENDMAX DS F MAXIMUM END ADDRESS @VM08524 00134000
FLDLEN DS F MAXIMUM ADDRESS LENGTH @VM08524 00135000
FIELD DS 3D WORK AREA 00136000
LNSAVE DS XL32 DUMP SAVE AREA 00137000
WRKLINE DS XL32 WORK AREA FOR LINE COMP TEST @VA05405 00137500
REGSAVE DS 4F TEMPORARY SAVE AREA FOR R0-R3 00138000
BFRSIZE EQU (*-BUFBUF+7)/8 BUFFER SIZE IN DOUBLE WORDS @VM08524 00139000
SPACE 3 00140000
* EQUATES FOR BUFLAG 00141000
PRINTER EQU X'80' 00142000
FIRSTL EQU X'40' 00143000
NFIRSTL EQU X'BF' 00144000
SAMEL EQU X'20' 00145000
NSAMEL EQU X'DF' 00146000
TRANSLAT EQU X'10' 00147000
INVLD EQU X'08' INVALID VIRTUAL PAGE WITHIN @V304635 00148000
* ADDRESS RANGE 00149000
EJECT 00150000
DMKCDB CSECT 00151000
SPACE 2 00152000
* EQUATES FOR SAVEWRK1 ON DUMP OR DISPLAY 00153000
DISPC EQU X'00' 00154000
DUMPC EQU X'80' 00155000
REALC EQU X'00' 00156000
VIRTC EQU X'40' 00157000
RANGE EQU X'20' 00158000
DISLEN EQU X'10' LENGTH RANGE INDICATION @V200930 00159000
HEXLOC EQU X'08' INDICATES A LOCATION REQUEST 00160000
BYPGPR EQU X'02' BYPAS DUMP REGS ON NEXT ARG @V200930 00161000
PROC1 EQU X'01' INDICATE AT LEAST ONE OPERAND PROCESSED 00162000
SPACE 00163000
* EQUATES FOR SAVEWRK1+1 ON DUMP OR DISPLAY 00164000
CONVLEN EQU X'80' INDICATE TO CONVERT LENGTH @V200930 00165000
MPREF EQU X'08' @V4075A0 00165100
NPREF EQU X'04' @V4075A0 00165200
CHEX EQU X'01' 00166000
SPACE 2 00167000
********************************************************************* 00168000
* SAVEWRK1 SWITCH USAGE DURING DUMP OR DISPLAY 00169000
* SAVEWRK1 00170000
* X'80' - 0 = DISPLAY, 1 = DUMP 00171000
* X'40' - 0 = REAL MACHINE, 1 = VIRTUAL MACHINE 00172000
* X'20' - 0 = ONLY ONE ADDRESS, 1 = RANGE OF ADDRESSES 00173000
* X'10' - 0 = NO LENGTH, 1 = LENGTH RANGE 00174000
* 00175000
* 00176000
* 00177000
* SAVEWRK1+1 00178000
* X'80' - FIELD CONTAINS AN ARGUMENT 00179000
* X'40' - LOGICAL CARRIAGE RETURN FOUND 00180000
* X'08' - 1= TREAT ADDRESS AS MAIN PREFIXED @V4075A0 00180100
* X'04' - 1= TREAT ADDRESS AS ATTACHED PROC PREFIXED @V4075A0 00180200
* X'01' - HEXIDECIMAL FIELD CONVERSION 00181000
********************************************************************9 00182000
EJECT 00183000
*********************************************************************** 00245000
* * 00246000
* 'DISPLAY' * 00247000
* * 00248000
*********************************************************************** 00249000
*. 00250000
* SUBROUTINE NAME - 00251000
* DMKCDBDI 00252000
* FUNCTION - 00253000
* TO DISPLAY AT THE TERMINAL VIRTUAL STORAGE LOCATIONS, REGISTER 00254000
* AND PSW. 00255000
* 00256000
* COMMAND FORMAT - 00257000
* +---------+-----------------------------------------+ 00258000
* | DISPLAY | LHEXLOC1 <<-> > | 00259000
* | D | THEXLOC1 <<:> > | 00260000
* | | KHEXLOC1 <<-HEXLOC2> > | 00261000
* | | 0 <<:HEXLOC2> > | 00262000
* | | <<-END> > | 00263000
* | | <<:END> > | 00264000
* | | <<.> > | 00265000
* | | <<.BYTECOUNT> > | 00266000
* | | <<.END> > | 00267000
* | | | 00268000
* | | GREG1 <<-> > | 00269000
* | | XREG1 <<:> > | 00270000
* | | YREG1 <<-REG2> > | 00271000
* | | 0 <<:REG2> > | 00272000
* | | <<-END> > | 00273000
* | | <<:END> > | 00274000
* | | <<.> > | 00275000
* | | <<.REGCOUNT> > | 00276000
* | | <<.END> > | 00277000
* | | | 00278000
* | | PSW | 00279000
* | | CSW | 00280000
* | | CAW | 00281000
* +---------+-----------------------------------------+ 00282000
* 00283000
* OPERATION - 00284000
* 00285000
* 1. SET A FLAG IN SAVEWRK1 TO INDICATE A VIRTUAL DISPLAY 00286000
* OPERATION. THEN BRANCH TO THE ROUTINES COMMON TO ALL 00287000
* 00289000
* THE FOLLOWING IS A DESCRIPTION OF THE OPERATION OF 00290100
* DISPLAY REFERED TO BY THE OTHER PROLOGS IN THIS LISTING. 00291000
* 00292000
* 2. CALL DMKFREE TO OBTAIN A BUFFER. THIS BUFFER WILL CONTAIN 00293000
* THE DATA,FLAGS,ADDRESS INCREMENT COUNTS, AND POINTERS USED 00294000
* IN CONSTRUCTING A LINE OF OUTPUT. 00295000
* 3. SET UP THE NUMBER OF CHARACTERS PER LINE AND TRANSLATE COUN 00296100
* 4. GO TO STEP 20 TO OUTPUT A LINE AND REINITIALIZE THE BUFFER. 00298000
* 5. CALL DMKSCNFD TO LOCATE THE TYPE OF REQUEST(E.G. PSW,X,T). 00299000
* IF NO ARGUMENTS AT ALL HAVE BEEN PROCESSED, CALL DMKERMSG 00300000
* TO SEND ERROR MESSAGE DMKCDB026E ON A DISPLAY OR DMKCDB033E 00301000
* FOR A DCP. IF PROCESSING HAS BEEN DONE, EXIT. 00302100
* 6. CHECK THE ARGUMENT FOR A VALID TYPE. IF NONE FOUND 00305000
* ASSUME THE SAME TYPE AS THE LAST VALID ARGUMENT. 00306000
* IF LAST ARGUMENT WAS PSW, CSW, OR CAW THAN ASSUME TYPE L 00307000
* AND INSERT THE VALID TYPE AND RESCAN. 00308000
* GO TO THE SUBROUTINE TO HANDLE THE PARTICULAR TYPE. 00309000
* 7. DISCSW-CHECK IF THIS IS A DISPLAY VIRTUAL REQUEST. IF NOT, 00310000
* CALL DMKERMSG TO OUTPUT ERROR MESSAGE DMKCDB003E. IF OK, 00311000
* TRANS IN USER PAGE ZERO. CONVERT THE DOUBLE WORD AT LOC. 00312000
* 64 TO PRINTABLE FORM VIA CALLS TO DMKCVTBH. PLACE CONVERTED 00313000
* DATA INTO BUFFER, SET UP BYTE COUNT, AND GO TO STEP 4. 00314000
* 8. DISCAW-CHECK IF DISPLAY VIRTUAL COMMAND. IF NOT, CALL 00315000
* DMKERMSG TO SEND ERROR MESSAGE DMKCDB003E. IF OK, TRANS IN 00316000
* USER PAGE ZERO. CONVERT THE DATA AT LOCATION 72 TO 00317000
* PRINTABLE FORM VIA CALL TO DMKCVTBH. PLACE THIS DATA INTO 00318000
* THE BUFFER, SET UP THE BYTE COUNT, AND GO TO STEP 4. 00319000
* 9. DISPSW WHEN 'P' IS ENTERED IN THE COMMAND LINE, CHECK 00320100
* TO SEE IF THIS A VIRTUAL DISPLAY REQUEST. IF NOT, CALL 00324000
* DMKERMSG TO SEND ERROR MESSAGE DMKCDB003E. IF OK, CONVERT 00325000
* THE PSW FROM THE VMBLOK TO PRINTABLE FORM VIA CALLS TO 00326000
* DMKCVTBH. PLACE THIS DATA IN THE OUTPUT BUFFER,SET THE BYTE 00327000
* COUNT, AND GO TO STEP 4. 00328000
* 10. DISGPR WHEN 'G' IS ENTERED IN THE COMMAND LINE, CHECK 00332100
* IF THIS IS A DISPLAY VIRTUAL DISPLAY REQUEST. IF NOT, CALL 00336000
* DMKERMSG TO SEND ERROR MESSAGE DMKCDB003E. THEN GOSTEP 16 00337100
* TO INITIALIZE THE BEGINNING END ENDING ADDRESSES. GO 00337200
* TO STEP 10A. 00337300
* 10A. DISCOMM-THIS IS A SUBROUTINE USED BY SEVERAL OTHERS TO 00344000
* SET UP THE DATA IN THE BUFFER. FIRST CHECK IF AT THE 00345000
* BEGINNING OF THE BUFFER. IF NOT GO TO STEP 10B. IF SO, 00346000
* GO TO STEP 19 TO BUILD A LINE HEADER. THEN CONTINUE. 00347000
* 10B. CONVERT THE NEXT PIECE OF DATA TO BE DISPLAYED VIA A CALL 00348000
* TO DMKCVTBH. PLACE THIS DATA IN THE BUFFER. ADJUST THE 00349000
* BUFFER POINTER AND BUFFER COUNT. THEN IF THE BUFFER IS 00350000
* FULL, GO TO STEP 20 TO OUTPUT THE BUFFER AND REINITIALIZE 00351000
* IT. IF THE BUFFER IS NOT FULL, GO TO STEP 17 TO GET THE 00352000
* NEXT ADDRESS TO DISPLAY. 00353000
* 11. DISFPR-IF ENTERED FROM FINDING 'Y' REQUEST IN THE COMMAND 00354000
* LINE, CHECK IF THIS IS A VIRTUAL DISPLAY. IF NOT, CALL 00355000
* DMKERMSG TO SEND ERROR MESSAGE DMKCDB003E. GO TO 16 00356100
* TO INITIALIZE THE BEGINNING AND ENDING ADDRESSES. 00356200
* THEN VIA CALLS TO DMKCVTBH, CONVERT THE VIRTUAL FLOATING 00361000
* POINT REGISTERS FOUND IN THE VMBLOK TO PRINTABLE 'HEX' AND 00362000
* ALSO CALL DMKCVTFP TO GET THE FLOATING POINT FORMAT. PLACE 00363000
* THIS IN THE BUFFER AND GO TO STEP 20 TO OUTPUT. 00364000
* 12. DISECR-IF 'X' WAS FOUND IN THE COMMAND LINE, CHECK IF THIS 00365000
* IS A VIRTUAL DISPLAY. IF NOT, CALL DMKERMSG TO SEND 00366000
* ERROR MESSAGE DMKCDB003E. THEN CHECK IF RUNNING A 00367100
* VIRTUAL CP SYSTEM. IF NOT, CONVERT CR0 FOUND IN THE VMBLOK 00369000
* AND GO TO STEP 20 TO OUTPUT IT. IF RUNNING A VIRTUAL CP, 00370000
* GO TO STEP 16 TO INITIALIZE BEGINNING AND ENDING ADDRESS. 00371000
* LOAD THE VALUE OF THE NEXT CONTROL 00373100
* REGISTER AND GO TO STEP 10B TO FORMAT AND PROCESS. 00374000
* WHEN THE NEXT REGISTER IS NEEDED CONTROL WILL BE RETURNED 00375000
* TO THIS ROUTINE TO GET THE DATA. 00376000
* 13. DISLOC SET A FLAG TO INDICATE A HEXLOC REQUEST. SET UP 00377100
* THE MAXIMUM ENDING ADDRESS FOR EITHER THE VIRTUAL 00377200
* MACHINE OR REAL MACHINE DEPENDING ON REQUEST. THEN GO TO 00385000
* STEP 16 TO INITIALIZE BEGINNING AND ENDING ADDRESSES. 00386000
* IF A VIRTUAL REQUEST, TRANS IN THE NEXT ADDRESS TO BE 00387000
* DISPLAYED. IF A REAL REQUEST, JUST PICK UP THE NEXT REAL 00388000
* ADDRESS. IN AN AP SYSTEM THE ADDRESS IS TRANSLA 00389100
* BASED UPON THE M/N SPECIFICATION AND WHICH PROC R WE ARE 00389200
* ON. THE PURPOSE IS TO REACH THE PROPER PAGE GIV HE 00389300
* VALUES OF THE TWO PREFIX REGISTERS. 00389400
* GO TO STEP 10A. TO FORMAT THE OUTPUT. CONTROL W BE 00389500
* RETURNED TO THIS STEP FOR EACH ADDRESS UNTIL HAVE DIS- 00390000
* PLAYED ALL THE REQUESTED LOCATIONS. 00391000
* IN AN AP SYSTEM THE PARAMETER PREFIX 'M' CAUSES 00391100
* ADDRESS TO BE TREATED AS SEEN THROUGH THE MAIN ESSOR'S 00391200
* PREFIX REGISTER. THE LETTER 'N' DESIGNATES THE CHED 00391300
* PROCESSOR. OTHERWISE THE ADDRESS IS TREATED AS BSOLUTE 00391400
* ADDRESS. 'N' IS VALID ONLY WHEN THE ATTACHED PR SOR IS 00391500
* IN OPERATION. 'M' IS VALID IF THE SYSTEM HAS BE EN'D 00391600
* FOR AP OPERATION 00391700
* 14. DISLOCT - IF A 'T' REQUEST IS FOUND, SET A FLAG TO 00392000
* INDICATE THAT EBCDIC TRANSLATION FOR EACH LINE OF PRINT 00393000
* IS TO TAKE PLACE. THEN GO TO STEP 13. 00394000
* 15. DISKEY-IF ENTERED VIA FINDING 'K' IN THE COMMAND, CHECK 00395000
* IF THIS IS A DISPLAY VIRTUAL. IF NOT, CALL DMKERMSG TO 00396000
* SEND ERROR MESSAGE DMKCDB003E. GO TO STEP 16 TO ILIZE THE 00397100
* ADDRESSES.THEN SCAN THE SWPTABLES FOR THE REQUESTED 00401000
* ADDRESSES FORMATTING THE LINES OF OUTPUT. FOR EACH LINE 00402000
* GO TO STEP 20 TO OUTPUT. 00403000
* 16. DISINIT-THIS IS THE SUBROUTINE USED TO INITIALIZE THE 00404000
* RANGE OF ADDRESSES FOR LOC,REGISTER, AND KEY REQUESTS. 00405000
* FIRST CHECK IF ANY ADDRESS HAS BEEN SPECIFIED. IF NOT, 00406000
* SET THE BEGINNING ADDRESS TO ZERO AND RETURN. IF HAVE AN 00407000
* ADDRESS, SCAN THRU THE ARGUMENT CHECKING FOR ':','_', OR 00408000
* BLANK. IF BLANK IS FOUND GO TO STEP 16A. IF ':' OR '-' 00409000
* AND THE ENDING FIELD IS IN THE SAME ARGUMENT, COMPUTE THE 00410000
* LENGTHS OF THE BEGINNING AND ENDING FIELDS AND GO TO 00411000
* STEP 16B. 00412000
* IF THE DELIMITER IS NOT : OR - THEN TEST FOR A DOT '.' 00413000
* IF IT IS A DOT CHECK NEXT ARGUMENT. IF IT IS BLANK 00414000
* THEN GO TO STEP 16C FOR DEFUALT END, ELSE CONVERT 00415000
* THE FIELD AS A HEX LENGTH AND SAVE TO CALCULATE 00416000
* THE END ADDRESS. 00417000
* 16A. - CALL DMKSCNFD TO SEE IF HAVE A ':' OR '-' AS THE NEXT 00418000
* ARGUMENT. IF THERE IS AND THE 'HEXLOC2' IS IN THE 00419000
* SAME ARGUMENT, GO TO STEP 16B. IF HAVE ':' OR'-' WITH 00420000
* NOTHING ELSE, CALL DMKSCNFD TO PICK UP NEXT ARGUMENT. 00421000
* IF NONE FOUND, GO TO STEP 16C. IF HAVE ONE, CONTINUE. 00422000
* IF THE DELIMITER WAS A DOT '.' THEN THE FIELD IS A 00423000
* LENGTH SPECIFICATION. CONVERT IT FROM HEX AND GIVE AN 00424000
* ERROR MESSAGE IF THAT FAILS. IF THE CONVERTION 00425000
* IS GOOD SAVE THE VALUE TO CALCULATE THE END ADDRESS. 00426000
* 16B. CHECK IF THE ENDING ADDRESS IS THE WORD 'END'. IF SO GO 00427000
* TO STEP 16C. IF A 'HEXLOC', CALL DMKCVTHB TO CONVERT 00428000
* TO BINARY. IF THE CONVERT FAILS, CALL DMKERMSG TO SEND 00429000
* ERROR MESSAGE DMKCDB004E. IF THE CONVERT IS OK, USE THE 00430000
* NUMBER TO INITIALIZE THE ENDING ADDRESS AND CONTINUE. 00431000
* 16C. CALL DMKCVTHB TO CONVERT THE BEGINNING ADDRESS TO BINARY. 00432000
* IF THE CONVERT FAILS, CALL DMKERMSG TO SEND ERROR 00433000
* MESSAGE DMKCDB004E. IF CONVERT IS GOOD, INITIALIZE THE 00434000
* BEGINNING ADDRESS WITH THIS NUMBER. THEN CHECK IF 00435000
* BEGINNING ADDRESS IS LARGER THAN THE ENDING NUMBER. IF 00436000
* IT IS , CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDB009E. 00437000
* IF THE ADDRESS IS LARGER THAN THE MAXIMUM AND IT IS 00438000
* A HEXLOC, CALL DMKERM TO SEND ERROR MESSAGE DMKCDB160E. 00439000
* IF IT IS A REGISTER, SEND ERROR MESSAGE DMKCDB010E. IF 00440000
* ADDRESS IS OK - RETURN. 00441000
* 17. DISNEXTA-THIS IS THE SUBROUTINE TO GET THE NEXT ADDRESS. 00442000
* FIRST - ADD THE INCREMENT VALUE TO THE PRESENT ADDRESS. 00443000
* IF THE RESULT IS LARGER THAN THE ENDING ADDRESS,GO TO 00444000
* STEP 17A. IF NOT STORE THE NEW ADDRESS IN THE BUFFER AND 00445000
* RETURN. 00446000
* 19. DISHEAD-THIS SUBROUTINE FORMATS THE LINE HEADER AND 00462000
* TRAILER. FIRST CHECK IF THIS IS A LOCATION REQUEST. IF IT 00463000
* IS, GO TO STEP 19A. IF NOT, CALL DMKCVTBD TO CONVERT THE 00464000
* REGISTER NUMBER TO DECIMAL. SET REGISTER NUMBER IN THE 00465000
* BUFFER AND RETURN. 00466000
* 19A. IF THIS IS THE FIRST LINE, GO TO STEP 19C. IF LINES ARE 00467000
* ALREADY BEING SUPPRESSED, GO TO STEP 19D. IF NEITHER OF 00468000
* THESE, CHECK IF THIS LINE IS THE SAME AS THE LAST. IF NOT 00469000
* GO TO STEP 19C. IF IT IS, SET UP THE SUPPRESSED LINES 00470000
* MESSAGE. 00471000
* 19B. DUMP THE ADDRESS TO THE NEXT LINE. CALL DMKCVTBH 00472000
* TO CONVERT THIS ADDRESS TO HEX AND INSERT THIS ADDRESS 00473000
* INTO THE BUFFER. THEN GO TO STEP 17 TO CONTINUE. 00474000
* 19C. CALL DMKCVTBH TO CONVERT THE ADDRESS TO HEX. THEN IF 00475000
* THIS IS A TRANSLATE REQUEST, TRANSLATE THE LINE TO EBCDIC 00476000
* AND RETURN. IF NOT TRANSLATE, JUST RETURN. 00477000
* 19D. IF THIS LINE IS THE SAME AS THE LAST ONE, GO TO STEP 19B. 00478000
* IF NOT, GO TO STEP 20 TO OUTPUT THE SUPPRESSED LINES 00479000
* MESSAGE. THEN GO TO STEP 19C. 00480000
* 20. DISWRITE-THIS SUBROUTINE WILL OUTPUT A LINE OF DATA TO 00481000
* THE TERMINAL. IF THE BYTE COUNT FOR THE DATA IN THFFER IS 00482100
* GREATER THAN ZERO, CALL DMKQCNWT TO SEND THE DATA. 00482200
* 20B. RESET THE BUFFER POINTER TO THE START OF THE BUFFER. 00489000
* BLANK OUT THE DATA PORTION OF THE BUFFER AND RETURN. 00490000
* 00491000
* RESPONSES - 00492000
* 00493000
* THE FOLLOWING ARE TYPICAL RESPONSES TO THE VARIOUS 00494000
* DISPLAY COMMANDS: 00495000
* 00496000
* HEXLOCS - 00497000
* XXXXXX = WORD1 WORD2 WORD3 WORD4 * EBCIDIC TRANSLATION * 00498000
* 00499000
* KEYS - 00500000
* XXXXXX TO XXXXXX KEY = XX 00501000
* 00502000
* GREG - 00503000
* GPR 0 = GREG0 GREG1 GREG2 GREG3 00504000
* GPR 4 = GREG4 GREG5 00505000
* 00506000
* YREGS - 00507000
* FPR 0 = XXXXXXXXXXXXXXXX .XXXXXXXXXXXXXXXXX E XX 00508000
* FPR 2 = XXXXXXXXXXXXXXXX .XXXXXXXXXXXXXXXXX E XX 00509000
* 00510000
* XREGS - 00511000
* ECR 0 = XXXXXXXX 00512000
* 00513000
* PSW - 00514000
* PSW = XXXXXXXX XXXXXXXX 00515000
* 00516000
* CAW - 00517000
* CAW XXXXXXXX 00518000
* 00519000
* CSW - 00520000
* CSW XXXXXXXX XXXXXXXX 00521000
* 00522000
* 00523000
* ERROR MESSAGES - 00524000
* DMKCDB004E INVALID HEXLOC - (HEXLOC) 00525000
* DMKCDB009E INVALID RANGE - (RANGE) 00526000
* DMKCDB010E INVALID REGISTER - (REGISTER) 00527000
* DMKCDB026E OPERAND MISSING OR INVALID 00528000
* DMKCDB160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00529000
*. 00530000
SPACE 4 00531000
DMKCDBDI RELOC DISPLAY VIRTUAL MACHINE 00532000
MVI SAVEWRK1,DISPC+VIRTC REMEMBER TO DISPLAY VIRTUAL STORAG 00533000
B DISGETB 00534000
EJECT 00535000
*********************************************************************** 00585000
* * 00586000
* 'DCP' * 00587000
* * 00588000
*********************************************************************** 00589000
*. 00590000
* 00591000
* SUBROUTINE NAME - 00592000
* DMKCDBDC 00593000
* FUNCTION - 00594000
* 00595000
* TO DISPLAY REAL STORAGE LOCATIONS. 00596000
* 00597000
* COMMAND FORMATS - 00598000
* +--------+------------------------------------------+ 00599000
* | DCP | <M|N>LHEXLOC1 <<-> > | 00600000
* | DCP | <M|N>THEXLOC1 <<:> > | 00601000
* | | <M|N>HEXLOC1 <<-HEXLOC2> > | 00602000
* | | 0 <<:HEXLOC2> > | 00603000
* | | <<-END> > | 00604000
* | | <<:END> > | 00605000
* | | <<.> > | 00606000
* | | <<.BYTECOUNT>> | 00607000
* | | <<.END> > | 00608000
* +--------+------------------------------------------+ 00609000
* 00610000
* OPERATION - 00611000
* 1. SET A BIT IN SAVEWRK1 TO INDICATE THAT THIS IS A 00612000
* DISPLAY OF REAL STORAGE. THE SAME ROUTINES 00613000
* FOR DISPLAY ARE USED FOR DCP AND ARE DESCRIBED IN 00614000
* THE PROLOGUE FOR DISPLAY. 00615000
* 00616000
* ERROR MESSAGES - 00617000
* DMKCDB003E INVALID OPTION - (OPTION) 00618000
* DMKCDB004E INVALID HEXLOC - (HEXLOC) 00619000
* DMKCDB009E INVALID RANGE - (RANGE) 00620000
* DMKCDB033E HEXLOC MISSING OR INVALID 00621000
* DMKCDB160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00622000
*. 00623000
EJECT 00624000
DMKCDBDC RELOC DISPLAY REAL STORAGE 00625000
MVI SAVEWRK1,DISPC+REALC REMEMBER TO DISPLAY REAL STORAGE 00626000
B DISGETB 00627000
EJECT 00628000
DISGETB LA R0,BFRSIZE LOAD SIZE OF BUFFER 00629000
CALL DMKFREE GET OUTPUT BUFFER 00630000
STCM R1,7,SAVEWRK4+1 SAVE ADDRESS OF BUFFER 00631000
STC R0,SAVEWRK4 AND THE LENGTH IN DOUBLE WORDS 00632000
LR R10,R1 LOAD BASE REGISTER 00633000
MVI SAVEWRK1+1,X'00' CLEAR @V200930 00634000
MVI SAVEWRK1+2,X'00' CLEAR LAST REQ @V200930 00635000
XC BFRCNT(8),BFRCNT ZERO COUNT AND FLAGS 00636000
MVC BUFMAX,=H'50' SET MAX BYTE COUNT 00639000
MVC BUFTRC,F16+2 SET TRANSLATE COUNT @VA03720 00640000
DISGETN BAL R4,DISWRITE WRITE OUT BUFFER & REINITIALIZE 00647000
CALL DMKSCNFD GET NEXT OPERAND @VM08515 00648000
BNZ DISEND NO MORE ARGUMENTS 00649000
OI SAVEWRK1,PROC1 FLAG AS PROCESS AT LEAST ONE 00650000
DISRSTFL STM R0,R1,SAVEWRK8 SAVE ARG. LENGTH AND ADDRESS 00656000
MVC FLDLEN(4),F6 SET MAX FIELD LENGTH @VM08524 00657000
NI SAVEWRK1,X'FF'-HEXLOC RESET FLAG @V200930 00658000
LR R5,R1 STARTING ADDRESS TO R5 00659000
LR R6,R0 LENGTH TO R6 00660000
* 00661000
* GPR 5 CONTAINS THE ADDRESS OF THE FIRST BYTE OF THE FIELD. 00662000
* GPR 6 CONTAINS THE LENGTH (IN BYTES) OF THE FIELD. 00663000
* 00664000
TM VMRSTAT,VMLOGOFF GONE INTO LOGOFF WHILE OUT? 00665000
BO EXIT YES, GET OUT 00666000
NI BUFLAG,0 RESET ALL FLAGS @V4075A0 00667100
DISGTYPE CLI 0(R5),C'P' MAYBE PSW ? 00674000
BE DISPSWX YES 00675000
CLI 0(R5),C'G' GENERAL PURPOSE REGISTER(S) ? 00676000
BE DISGPR YES 00677000
CLI 0(R5),C'Y' FLOATING POINT REGISTER(S) ? 00678000
BE DISFPR YES 00679000
CLI 0(R5),C'L' LOCATION REQUEST ? 00680000
BE DISPTEST YES @V4075A0 00681100
CLI 0(R5),C'T' PREVENT D T COMMAND WITHOUT HRC023DK 00681200
BNE DISPT STARTING LOCATION HRC023DK 00681300
LA R0,1 HRC023DK 00681400
CR R0,R6 HRC023DK 00681500
BE CDB026 HRC023DK 00681600
DISPT EQU * HRC023DK 00681700
CLI 0(R5),C'T' STORAGE LOCATION(S) + EBCDIC ? 00682000
BE DISLOCT YES 00683000
CLI 0(R5),C'K' STORAGE KEY(S) ? 00684000
BE DISKEY YES 00685000
CLC 0(3,R5),=C'CSW=' CSW ? 00686000
BE DISCSW YES 00687000
CLC 0(3,R5),=C'CAW=' CAW ? 00688000
BE DISCAW YES 00689000
CLI 0(R5),C'X' CONTROL REGISTERS ? 00690000
BE DISECR YES 00691000
CLI 0(R5),C'N' IF USER SPECIFIED M|N, @V4075A0 00691100
BE ITSN @V4075A0 00691150
CLI 0(R5),C'M' @V4075A0 00691200
BE ITSM CHECK VALIDITY AND SET FLAGS @V4075A0 00691250
CLI SAVEWRK1+2,X'00' PREVIOUS REQ VALID ?? @V200930 00692000
BNE SETR5 YES, DEFAULT TO LAST REQ @V200930 00693000
DEFAULTL EQU * @V4075A0 00693100
MVI SAVEWRK1+2,C'L' DEFAULT TO LOCATION @V200930 00694000
SETR5 BCTR R5,R0 BACKUP 1 POSITION @V200930 00695000
LA R6,1(R6) UP COUNT BY ONE @V200930 00696000
MVC 0(1,R5),SAVEWRK1+2 SET REQ CHARACTER @V200930 00697000
B DISGTYPE ANALYSE TYPE @V200930 00698000
SPACE 4 00699000
DISEND EQU * 00700000
TM SAVEWRK1,PROC1 ANY PROCESSING DONE ??? 00701000
BO EXIT YES, JUST EXIT WITHOUT ERROR MSG @V4075A0 00702100
TM SAVEWRK1,VIRTC WAS IT DCP? (NOT VIRTC) @V4075A0 00702200
BZ CDB033 YES - SEND CDB033 MESSAGE 00708000
B CDB026 MUST BE DISPLAY 00711000
SPACE 2 00711100
ITSM L R15,=A(DMKSYSAP) IF NOT GEN'D FOR AP, @V4075A0 00711125
CLI 0(R15),C'Y' VIA SYSCOR MACRO @V4075A0 00711150
BNE CDB026 M,N NOT ACCEPTABLE @V4075A0 00711175
OI SAVEWRK1+1,MPREF USER SPECIFIED 'M' @V4M0120 00711210
MNCOMM TM SAVEWRK1,VIRTC M,N ONLY FOR CP STORAGE @V4075A0 00711225
BO CDB026 ERROR IF VIRTUAL DIS/DUMP @V4075A0 00711250
LA R5,1(R5) POINT TO NEXT CHAR IN PARM @V4075A0 00711275
BCT R6,DISGTYPE REDUCE COUNT & RESCAN PARM @V4075A0 00711300
B DEFAULTL NO MORE CHARS, DEFAULT TO 'L'@V4075A0 00711325
SPACE 2 @V4075A0 00711350
ITSN TM APSTAT1,APUOPER 'N' IS NOT VALID WHEN THE @V4075A0 00711375
BNO CDB026 ATTACHED PROCESSOR NOT UP @V4075A0 00711400
OI SAVEWRK1+1,NPREF USER SPECIFIED 'N' @V4075A0 00711425
B MNCOMM @V4075A0 00711450
SPACE 2 @V4075A0 00711475
EJECT 00712000
* 00713000
* DISPLAY CSW 00714000
* 00715000
DISCSW TM SAVEWRK1,VIRTC DCP? (NOT VIRTC) @V4075A0 00716100
BZ CDB003 YES - CSW NOT ALLOWED 00717000
MVI SAVEWRK1+2,X'00' DEFAULT TO LOC @V200930 00720000
CL R6,F3 OVER THREE CHARACTERS IN ARGUMENT ???? 00721000
BH CDB003 BRANCH TO ERROR MESSAGE IF THERE IS 00722000
MVC BUFBUF(4),=C'CSW=' . . 00723000
LA R1,0 SET UP TO BRING IN PAGE ZERO 00724000
TRANS 2,1,OPT=(BRING,DEFER) BRING IN PAGE ZERO 00725000
L R1,64(,R2) LOAD FIRST HALF OF CSW 00726000
CALL DMKCVTBH CONVERT TO PRINTABLE FORM 00727000
STCM R0,B'1111',BUFBUF+6 @V4075A0 00728100
STCM R1,B'1111',BUFBUF+10 @V4075A0 00729100
L R1,68(,R2) LOAD SECOND HALF OF CSW 00730000
CALL DMKCVTBH CONVERT 00731000
STCM R0,B'1111',BUFBUF+15 @V4075A0 00732100
STCM R1,B'1111',BUFBUF+19 @V4075A0 00733100
MVC BFRCNT,=H'23' SET UP BYTE COUNT 00734000
B DISGETN OUTPUT BUFFER & GET NEXT ARGUMENT 00735000
EJECT 00736000
* 00737000
* DISPLAY CAW 00738000
* 00739000
DISCAW TM SAVEWRK1,VIRTC DCP? (NOT VIRTC) @V4075A0 00740100
BZ CDB003 YES - NOT ALLOWED 00741000
MVI SAVEWRK1+2,X'00' DEFUALT TO LOC @V200930 00744000
CL R6,F3 OVER THREE CHARACTERS IN THE ARGUMENT 00745000
BH CDB003 BRANCH TO ERROR MESSAGE IF THERE IS 00746000
MVC BUFBUF(4),=C'CAW=' 00747000
LA R1,0 SET UP TO BRING IN PAGE ZERO 00748000
TRANS 2,1,OPT=(BRING,DEFER) BRING IN USER PAGE ZERO 00749000
L R1,72(,R2) LOAD CAW 00750000
CALL DMKCVTBH CONVERT TO PRINTABLE FORM 00751000
STCM R0,B'1111',BUFBUF+6 @V4075A0 00752100
STCM R1,B'1111',BUFBUF+10 @V4075A0 00753100
MVC BFRCNT,=H'14' SET UP BYTE COUNT 00754000
B DISGETN OUTPUT LINE & GET NEXT ARGUMENT 00755000
EJECT 00756000
* 00757000
* DISPLAY PSW 00758000
* 00759000
DISPSWX BCTR R6,0 MINUS ONE FOR 'EX' 00760000
EX R6,CLCPSW IS IT REALLY PSW REQUEST ???? 00761000
BNE CDB003 BRANCH IF IN ERROR 00762000
TM SAVEWRK1,VIRTC VIRTUAL REQUEST ???? 00763000
BZ CDB003 PSW NOT ALLOWED FOR THIS 00764000
MVI SAVEWRK1+2,X'00' DEFAULT TO LOC @V200930 00767000
MVC BUFBUF(5),CPSWEQ PUT IN 'PSW =' @V4075A0 00771100
L R1,VMPSW LOAD 1ST HALF OF VIRTUAL PSW 00772000
TM VMESTAT,VMEXTCM IN EXTENDED-MODE? 00773000
BO *+8 YES - DISPLAY ENTIRE PSW 00774000
N R1,=XL4'FFFF0000' ZERO INTERUPTION CODE 00775000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00776000
STCM R0,B'1111',BUFBUF+6 @V4075A0 00777100
STCM R1,B'1111',BUFBUF+10 @V4075A0 00778100
L R1,VMPSW+4 LOAD 2ND HALF OF VIRTUAL PSW 00779000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00780000
STCM R0,B'1111',BUFBUF+15 @V4075A0 00781100
STCM R1,B'1111',BUFBUF+19 @V4075A0 00782100
MVC BFRCNT,=H'23' SET LINE LENGTH 00783000
B DISGETN GO FLUSH BUFFER AND CONTINUE @V4075A0 00784100
EJECT 00787000
* 00788000
* DISPLAY GENERAL PURPOSE REGISTER(S) 00789000
* 00790000
DISGPR TM SAVEWRK1,VIRTC IS COMMAND DCP OR DMCP ? 00791000
BZ CDB003 GPR NOT ALLOWED 00792000
MVI SAVEWRK1+2,C'G' DEFAULT TO G @V200930 00795000
MVC IDCHAR,=C'GPR' SAVE IDENTIFICATION CHARACTERS @V4075A0 00799100
MVC ENDADD(4),F15 SET DEFUALT END REGISTER 00800000
MVC INCRMT(2),F1+2 SET ADDRESS INCREMENT 00801000
MVC ENDMAX(4),F15 SET MAXIMUM REG VALUE @VM08524 00802000
MVC FLDLEN(4),F2 SET MAX FIELD LENGTH @VM08524 00803000
BAL R7,DISINIT INITIALIZE BEGIN & END ADDRESSES @V4075A0 00810100
GPRRET SLA R1,2 CONVERT TO FULL WORD DISPLACEMENT 00811000
L R3,VMGPRS(R1) LOAD VALUE IN REGISTER 00812000
SPACE 2 00813000
DISCOMM CL R10,BUFPNT IS POINTER AT BEGINNING OF BUFFER ? 00814000
BNE DISCOMMC BRANCH IF NO 00815000
L R1,NXTADD LOAD DATA ADDRESS 00816000
BAL R8,DISHEAD YES - BUILD LINE HEADER 00817000
DISCOMMC LR R1,R3 LOAD DATA TO BE DISPLAYED 00818000
CALL DMKCVTBH CONVERT DATA TO PRINTABLE CHARACTERS 00819000
STM R0,R1,FIELD STORE IN WORK AREA 00820000
L R1,BUFPNT LOAD BUFFER POINTER 00821000
MVC 0(8,R1),FIELD MOVE DATA 00822000
LA R1,10(R1) BUMP POINTER BY 10 00823000
LH R14,BFRCNT GET BUFFER COUNT 00824000
LA R14,10(R14) UP THE COUNT 00825000
NOSHFT ST R1,BUFPNT SET NEW POINTER 00832000
STH R14,BFRCNT SET NEW COUNT 00833000
CH R14,BUFMAX AT END OF BUFFER ?? 00834000
BL DISNEXTA NO - CONTINUE DISPLAY 00835000
SH R14,F2+2 ADJUST LENGTH 00836000
STH R14,BFRCNT SET COUNT 00837000
LA R4,DISNEXTA LOAD RETURN ADDRESS 00838000
B DISWRITE YES - OUTPUT LINE 00839000
EJECT 00840000
* 00841000
* DISPLAY FLOATING POINT REGISTER(S) 00842000
* 00843000
DISFPR TM SAVEWRK1,VIRTC IS COMMAND DCP ? (NOT VIRTC) @V4075A0 00844100
BZ CDB003 FPR NOT ALLOWED 00845000
MVI SAVEWRK1+2,C'Y' DEFAULT TO Y @V200930 00848000
MVC IDCHAR,=C'FPR' SAVE IDENTIFICATION CHARACTERS @V4075A0 00852100
MVC ENDADD(4),F6 SET DEFAULT END REGISTER 00853000
MVC INCRMT(2),F2+2 SET ADDR INCREMENT 00854000
MVC ENDMAX(4),F6 SET MAXIMUM REG VALUE @VM08524 00855000
MVC FLDLEN(4),F1 SET MAX FIELD LENGTH @VM08524 00856000
BAL R7,DISINIT INITIALIZE BEGIN & END ADDRESSES @V4075A0 00863100
FPRRET BAL R8,DISHEAD BUILD LINE HEADER 00864000
L R1,NXTADD RELOAD REGISTER NUMBER 00865000
SLA R1,2 CONVERT TO DOUBLE WORD BISPLACEMENT 00866000
LA R2,VMFPRS(R1) POINT TO VIRTUAL FPR 00867000
L R1,0(R2) LOAD 1ST HALF OF VIRTUAL REGISTER 00868000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00869000
STCM R0,B'1111',BUFBUF+10 @V4075A0 00870100
STCM R1,B'1111',BUFBUF+14 @V4075A0 00871100
L R1,4(R2) LOAD 2ND HALF OF VIRTUAL REGISTER 00872000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 00873000
STCM R0,B'1111',BUFBUF+18 @V4075A0 00874100
STCM R1,B'1111',BUFBUF+22 @V4075A0 00875100
LA R1,BUFBUF+30 LOAD OUTPUT POINTER 00876000
CALL DMKCVTFP CONVERT TO PRINTABLE FLOATING POINT 00877000
MVC BFRCNT,=H'54' SET LINE LENGTH 00878000
LA R4,DISNEXTA LOAD RETURN ADDRESS 00879000
B DISWRITE OUTPUT LINE 00880000
EJECT 00881000
* 00882000
* DISPLAY CONTROL REGISTER(S) 00883000
* 00884000
DISECR EQU * DISPLAY C-REG VALUES 00885000
TM SAVEWRK1,VIRTC IS COMMAND DCP ? (NOT VIRTC) @V4075A0 00886100
BZ CDB003 CREG REQUEST NOT ALLOWED 00887000
MVI SAVEWRK1+2,C'X' DEFAULT TO X @V200930 00890000
MVC IDCHAR,=C'ECR' SAVE IDENTIFICATION CHARACTERS @V4075A0 00894100
MVC INCRMT,F1+2 SET BYTE COUNT = 1 @V4075A0 00895100
MVC ENDADD,F15 DEFAULT END REG 00896000
MVC ENDMAX(4),F15 SAVE MAXIMUM REG ADDRESS @VM08524 00897000
MVC FLDLEN(4),F2 SET MAX FIELD LENGTH @VM08524 00898000
BAL R7,DISINIT INITIALIZE BEGIN & END ADDRESSES @V4075A0 00905100
CRRET EQU * 00906000
TM VMPSTAT,VMV370R IS THIS A VIRTUAL 370 ??? 00907000
BZ DISECR0 NO- DISPLAY CREG 0 ONLY 00908000
SLA R1,2 CONVERT TO FULL WORD DISPLACMENT 00909000
L R14,VMECEXT LOAD VMBLOK EXTENTION ADDRESS 00910000
USING ECBLOK,R14 00911000
L R3,EXTCR0(R1) LOAD VALUE IN REGISTER 00912000
DROP R14 00913000
B DISCOMM PUT IN BUFFER & DISPLAY 00914000
DISECR0 EQU * DISPLAY ONLY C-REG 0 00915000
SLR R1,R1 C-REG 0 00916000
ST R1,ENDADD ...ONLY 00917000
ST R1,NXTADD ... 00918000
LA R7,DISGETN @V4075A0 00919100
L R3,VMVCR0 DATA TO BE DISPLAYED 00920000
B DISCOMM PUT IN BUFFER + DISPLAY 00921000
EJECT 00922000
* 00923000
* DISPLAY STORAGE 00924000
* 00925000
DISPTEST OI SAVEWRK1,HEXLOC INDICATE A LOCATION REQUEST@V4075A0 00926100
MVI SAVEWRK1+2,C'L' DEFAULT TO LOC @V200930 00927000
DISPTST DS 0H @V4075A0 00928100
TM SAVEWRK1,VIRTC DISPLAY VIRTUAL STORAGE ? 00929000
BZ DISLOCR BRANCH IF NO - REAL STORAGE 00930000
L R2,VMSIZE LOAD VIRTUAL MACHINE SIZE 00931000
DISLOCS BCTR R2,0 -1 @VM08524 00932000
ST R2,TENDADD SAVE MAX ADDRESS @VM08524 00933000
ST R2,ENDMAX .. @VM08524 00934000
S R2,F3 SUBTRACT 3 @VA03720 00935000
ST R2,ENDADD SET DEFAULT ENDING ADDRESS 00936000
OI SAVEWRK1+1,CHEX HEX ADDRESS CONVERT @V200930 00937000
MVC INCRMT(2),F4+2 SET WORD INCREMENT @V200930 00938000
BAL R7,DISINIT INITIALIZE BEGINNING & ENDING ADDRESSES 00939000
NI SAVEWRK1+1,255-CHEX TURN OFF HEX CONVERSION SWITCH 00940000
DISLOCD MVC INCRMT(2),F4+2 SET WORD INCREMENT @V200930 00956000
OI BUFLAG,FIRSTL FLAG FIRST LINE @V200930 00957000
MVC IDCHAR,=C'LOC' 'LOC' ID FOR DATA @V4075A0 00958100
TM BUFLAG,TRANSLAT IS OUTPUT TO BE TRANSLATED ? 00959000
BZ DISLOCA BRANCH IF NO 00960000
L R1,ENDADD GET END ADDRESS 00961000
LH R0,BUFTRC GET TRANSLATE COUNT 00962000
BCTR R0,R0 DECREMENT BY 1 00963000
OR R1,R0 ALIGN TO END 00964000
ST R1,ENDADD SET NEW END 00965000
L R1,NXTADD GET START ADDRESS 00966000
LH R0,BUFTRC LOAD TRANSLATE COUNT 00967000
LCR R0,R0 LOAD ITS COMPLEMENT 00968000
NR R1,R0 TRUNCATE TO 16 OR 32 BYTE BOUNDARY 00969000
ST R1,NXTADD STORE NEW BEGINNING ADDRESS 00970000
DISLOCA LA R7,DISLOCA+4 RESET RETURN ADDRESS 00971000
LR R2,R1 LOAD ADDRESS TO BE DISPLAYED 00972000
TM SAVEWRK1,VIRTC DISPLAY VIRTUAL STORAGE ? 00973000
BZ PREFLOC NO, REAL, MAY HAVE TO RECOMP ADDR@V4075A0 00974100
TRANS 2,1,OPT=(BRING,DEFER) GET USER PAGE ADDRESS 00975000
DISLOCL L R3,0(R2) LOAD WORD TO BE DISPLAYED 00976000
BZ DISCOMM PUT DATA INTO BUFFER & DISPLAY @V304635 00977000
OI BUFLAG,INVLD INDICATE INVALID PAGE @V304635 00978000
BAL R4,DISWRITE OUTPUT LINE @V304635 00979000
L R1,NXTADD CONVERT ADDRESS TO PRINTABLE @V304635 00980000
CALL DMKCVTBH @V304635 00981000
STCM R0,B'0011',BUFBUF @V4075A0 00982100
STCM R1,B'1111',BUFBUF+2 @V4075A0 00983100
* BUFFER 00984000
MVC BUFBUF+7(2),=C'TO' @V304635 00985000
MVC BUFBUF+19(23),=C'NON-ADDRESSABLE STORAGE' @V304635 00986000
MVC BFRCNT,=AL2(19+23) SET BYTE COUNT @V304635 00987000
L R1,NXTADD RELOAD ADDRESS @V304635 00988000
NXTINVLD AL R1,F4096 BUMP TO NEXT PAGE ADDRESS @V304635 00989000
N R1,XPAGNUM DROP DISPLACEMENT @V304635 00990000
ST R1,NXTADD SAVE IT AS CURRENT ADDRESS @V304635 00991000
CALL DMKCVTBH CONVERT IT TO HEX PRINTABLE @V304635 00992000
STCM R0,B'0011',BUFBUF+10 @V4075A0 00993100
STCM R1,B'1111',BUFBUF+12 @V4075A0 00994100
L R1,NXTADD RESTORE CURRENT ADDRESS @V304635 00995000
CL R1,VMSIZE STILL WITHIN VM STORAGE SIZE @V304635 00996000
BNL GETOUT IF NOT - GET OUT @V304635 00997000
LCTL C1,C1,VMSEG GET SEGMENT TABLE @V304635 00998000
LRA R0,0(,R1) EXAMINE NEXT PAGE @V304635 00999000
BC 8+2,NXTINV1 CONTINUE IF NOT A SEG EXCEPTION @V408246 01000100
CALL DMKPTRAN,PARM=DEFER OTHERWISE LET PTRAN HANDLE @V408246 01000300
BC 2,NXTINVLD ADDRESSING ERROR @V408246 01000500
NXTINV1 DS 0H @V408246 01000700
CL R1,ENDADD AT END OF DISPLAY ? @V304635 01001000
BNL GETOUT IF YES - FINISH UP @V304635 01002000
BAL R4,DISWRITE NOW DISPLAY THIS LINE @V304635 01003000
BAL R7,DISNCOMM IF DUMPING DISPLAY RESPONSE @VA04637 01003100
B DISLOCA LOAD UP THE DATA @V304635 01004000
GETOUT BAL R4,DISWRITE DISPLAY THE LINE AND FRET THE @V304635 01005000
* BUFFER 01006000
B DISGETN BACK TO USER'S INPUT LINE @V4075A0 01007100
SPACE 01008000
DISLOCR L R2,=A(DMKSYSRM) GET REAL MACHINE SIZE 01009000
L R2,0(R2) .. 01010000
B DISLOCS 01011000
SPACE 3 01012000
* 01013000
* DISPLAY STORAGE + EBCDIC TRANSLATION 01014000
* 01015000
DISLOCT OI BUFLAG,TRANSLAT INDICATE TRANSLATE TO EBCDIC 01016000
OI SAVEWRK1,HEXLOC HEX LOC REQUEST @V200930 01017000
MVI SAVEWRK1+2,C'T' DEFAULT TO T @V200930 01018000
B DISPTST CONTINUE @V4075A0 01019100
SPACE 2 01019115
PREFLOC EQU * @V4075A0 01019130
L R15,=A(DMKSYSAP) CHECK THAT @V4075A0 01019145
CLI 0(R15),C'Y' USER'S SYSCOR MACRO HA@V4075A0 01019160
BNE FETCHRL AP OPTION, WE CHECK AND@V4075A0 01019175
L R0,XPAGNUM @V4075A0 01019190
TM SAVEWRK1+1,MPREF+NPREF PERHAPS RECOMPUTE THE @V4075A0 01019205
BZ ABSPEC EFFECTIVE ADDRESS @V4075A0 01019220
TM SAVEWRK1+1,NPREF DID USER SAY 'M' OR 'N' @V4075A0 01019235
BO RWEN GO FIX UP FOR 'N' SPECIFIED @V4075A0 01019250
RWEM TM APSTAT1,PROCIO HE SAID 'M', ARE WE 'M' ? @V4075A0 01019265
BO FETCHRL YES, DO NOT RECOMPUTE ADDRES@V4075A0 01019280
PFIXCOMP NR R0,R1 GET PAGE NUMBER @V4075A0 01019295
BZ ADDPREFB OTHER PROCESSOR'S PSA. POINT 2 IT@V4075A0 01019310
C R0,PREFIXB ABSOLUTE 0 IN OTHER PROCESSOR'S @V4075A0 01019325
BNE ISITPRFA NO. GO SEE IF IT IS OUR PSA! @V4075A0 01019340
GETABS0 S R1,PREFIXB YES, POINT TO ABSOLUTE 0 VIA OUR @V4075A0 01019355
ADDPREFA A R1,PREFIXA PREFIX REGISTER @V4075A0 01019370
B FETCHRL @V4075A0 01019385
SPACE 2 @V4075A0 01019400
ADDPREFB A R1,PREFIXB POINT TO OTHER PROCESSOR PSA @V4075A0 01019415
B FETCHRL @V4075A0 01019430
SPACE 2 @V4075A0 01019445
RWEN TM APSTAT1,PROCIO USER SAID 'N'. ARE WE 'N' ? @V4075A0 01019460
BNO FETCHRL YES @V4075A0 01019475
B PFIXCOMP NO. SEE ABOUT RECOMPUTING @V4075A0 01019490
SPACE 2 @V4075A0 01019505
ABSPEC NR R0,R1 ABSOLUTE 0 ? @V4075A0 01019520
BZ ADDPREFA YES, UNDO EFFECT OF PREFIX REG @V4075A0 01019535
ISITPRFA C R0,PREFIXA OUR PSA ? @V4075A0 01019550
BNE FETCHRL NO @V4075A0 01019565
SUBPREFA S R1,PREFIXA YES, UNDO OUR PREFIX REG @V4075A0 01019580
FETCHRL L R3,0(R1) FETCH THE DATA WORD ! @V4075A0 01019595
LR R2,R1 SAVE ADDR IN R2 FOR LATER USE @VA09347 01019596
B DISCOMM PUT DATA INTO BUFFER & SHOW IT @V4075A0 01019610
EJECT 01020000
* 01021000
* DISPLAY STORAGE KEY 01022000
* 01023000
DISKEY TM SAVEWRK1,VIRTC IS COMMAND DCP ? (NOT VIRTC) @V4075A0 01024100
BZ CDB003 KEY NOT ALLOWED 01025000
MVI SAVEWRK1+2,C'K' DEFAULT TO K @V200930 01028000
DUMPKEY OI SAVEWRK1+1,CHEX TURN ON HEX CONVERSION SWITCH 01029000
OI SAVEWRK1,HEXLOC FLAG AS BEING HEXLOC REQUEST 01030000
OI BUFLAG,FIRSTL TURN ON FIRST LINE SWITCH 01031000
MVC IDCHAR,KEYEQ SAVE IDENTIFICATION CHARACTERS 01032000
LA R15,2048 LOAD ADDRESS INCREMENT @VA03720 01033000
STH R15,INCRMT SET INCREMENT VALUE 01034000
L R2,VMSIZE LOAD VIRTUAL MACHINE SIZE 01035000
BCTR R2,0 MAKE IT LAST ADDRESS @VM08524 01036000
ST R2,TENDADD SAVE END ADDRESS @VM08524 01037000
ST R2,ENDMAX SET MAXIMUM ADDRESS @VM08524 01038000
S R2,=F'2047' BACK UP TO LAST PAGE ADDR @VM08854 01039000
ST R2,ENDADD SET DEFAULT ENDING ADDRESS 01040000
BAL R7,DISINIT INITIALIZE BEGIN & END ADDRESSES @V4075A0 01047100
KEYRET NI SAVEWRK1+1,255-CHEX TURN OFF HEX CONVERSION SWITCH 01048000
LA R15,HAVEKEY SET RETURN ADDRESS @VM08553 01049000
GETKEY EQU * HERE TO CALCULATE KEY VALUES @VM08553 01050000
ST R15,SAVEWRK5 SAVE RETURN ADDR @VM08553 01051000
LR R14,R1 LOAD CURRENT ADDRESS 01052000
L R3,VMSEG OBTAIN STO @V408246 01053500
SRDL R14,16 GET SEGMENT NUMBER 01054000
SLL R14,2 MULTIPLY BY 4 01055000
LA R3,0(R14,R3) INDEX TO STE FOR THIS SEGMENT @V408246 01056100
TM 3(R3),1 IS THE STE INVALID? @V408246 01056300
BZ VLDKEY NO, PNTR ALL RIGHT @V408246 01056500
LR R0,R15 SAVE 2ND PART @V408246 01056700
TRANS 2,1,OPT=(DEFER) LET PTR CHECK ON SEGMENT @V408246 01056900
LR R15,R0 RESTORE 2ND PART @V408246 01057100
TM 3(R3),1 DID PTR CLEAR UP PAGE TABLE @V408246 01057300
* POINTER? 01057500
BZ VLDKEY NO, RETURN ZERO KEY @V408246 01057700
INVDKEY L R1,FFS INDICATE MINUS IF NON-ADDRESSABLE@VA09057 01059500
B NOKEY PROCESS NON-ADDRESSABLE KEY @V304635 01060000
VLDKEY EQU * HERE FOR ADDRESSABLE STORAGE @V304635 01061000
L R3,0(,R3) GET PAGE TABLE POINTER @V408246 01062200
LA R2,16*2+8(,R3) GET SWAPTABLE ORIGIN @V408246 01063200
SR R14,R14 ZERO WORK REGISTER 01066000
SLDL R14,4 GET PAGE NUMBER 01067000
SLL R14,3 MULTIPY BY 8 @VA09057 01068100
LR R0,R3 LOAD SEG TABLE POINTER @VA09057 01068200
SRL R0,4 LINE IT UP @VA09057 01068300
LA R1,1(R14,R2) GET SWAP TABLE ADDRESS @VA09057 01068400
CLM R0,B'1000',0(R1) COMPARE THEM @VA09057 01068500
BL INVDKEY THATS MORE THAN WE HAVE - BRANCH @VA09057 01068600
SRL R14,1 SET UP FOR 2ND HALF PAGE @VA09057 01068700
SLDL R14,1 ADD 1 IF 2ND HALF OF PAGE 01069000
SR R1,R1 ZERO REGISTER 01070000
IC R1,2(R14,R2) INSERT STORAGE KEY 01071000
SRDL R14,1 GET PAGE NUMBER X 2 01072000
SRL R14,1 .. 01073000
LA R3,0(R14,R3) LOAD PAGE TABLE ENTRY ADDRESS 01074000
SR R2,R2 CLEAR FOR ISK (OR LACK OF IT) @VM08553 01075000
TM 1(R3),X'08' IS THE PAGE IN STORAGE ? 01076000
BO GOTPART BRANCH IF NO @VM08553 01077000
LH R14,0(,R3) LOAD REAL PAGE ADDRESS 01078000
SRL R14,4 .. 01079000
SLDL R14,12 ADD DISPLACEMENT ADDRESS 01080000
ISK R2,R14 GET THE REAL STORAGE KEY 01081000
GOTPART TM VMOSTAT,VMSHR IS THIS A SHARED SYSTEM? @VA01666 01082000
BZ *+8 NOPE, SKIP @VA01666 01083000
N R2,=A(X'0E') SHUT OFF PHONEY KEY @VA01666 01084000
OR R1,R2 PUT REAL AND VIRT TOGETHER @VA01666 01085000
LA R3,X'FE' SET FOR ECMODE @VA01666 01086000
TM VMPSTAT,VMV370R DOES THIS MACHINE HAVE EC? @VA01666 01087000
BO *+8 YES, MASK OK @VA01666 01088000
LA R3,X'F8' SET MASK FOR BC TYPE MACHINE @VA01666 01089000
NR R1,R3 SHUT OFF WHATEVER IS NECESSARY. @VA01666 01090000
NOKEY L R15,SAVEWRK5 RESTORE RETURN ADDRESS @V304635 01091000
BR R15 RETURN @VM08553 01092000
HAVEKEY EQU * @VM08553 01093000
TM BUFLAG,FIRSTL IS THIS THE FIRST LINE ? 01094000
BO DISK1STL BRANCH IF YES 01095000
CL R1,LNSAVE SAME AS LAST KEY ? 01096000
BE DISKBUMP BRANCH IF YES 01097000
BAL R4,DISWRITE OUTPUT PREVIOUS LINE 01098000
DISK1STL NI BUFLAG,NFIRSTL TURN OFF IST LINE SWITCH 01099000
MVC BUFBUF+18(5),KEYEQ MOVE 'KEY =' TO BUFFER 01100000
ST R1,LNSAVE SAVE KEY 01101000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 01102000
STH R1,BUFBUF+24 STORE KEY IN BUFFER 01103000
LA R1,26 STANDARD LINE LENGTH @V304635 01104000
CLI LNSAVE,X'FF' IS IT NON-ADDRESSABLE STORAGE ? @V304635 01105000
BNE SETBUFLG NO - SET UP BUFFER LENGTH @V304635 01106000
MVC BUFBUF+18(23),=C'NON-ADDRESSABLE STORAGE' @V304635 01107000
LA R1,15(,R1) LENGTH-EN MESSAGE LINE @V304635 01108000
SETBUFLG STH R1,BFRCNT SET LINE LENGTH. @V304635 01109000
L R1,NXTADD LOAD BEGINNING ADDRESS 01110000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 01111000
STCM R0,B'0011',BUFBUF @V4075A0 01112100
STCM R1,B'1111',BUFBUF+2 @V4075A0 01113100
MVC BUFBUF+7(2),=C'TO' 01114000
DISKBUMP L R1,NXTADD LOAD CURRENT ADDRESS 01115000
LA R1,2047(R1) ADD 2047 01116000
CALL DMKCVTBH CONVERT TO PRINTABLE CHARACTERS 01117000
STCM R0,B'0011',BUFBUF+10 @V4075A0 01118100
STCM R1,B'1111',BUFBUF+12 @V4075A0 01119100
B DISNEXTA GET NEXT ADDRESS 01120000
EJECT 01121000
* THE FOLLOWING TWO SUBROUTINES ARE USED TO INITIALIZE AND 01122000
* CONTROL THE DISPLAYING OF A RANGE OF ADDRESSES. REGISTER 7 IS 01123000
* LOADED BY A BAL TO DISINIT FROM THE VARIOUS DISPLAY ROUTINES. 01124000
* IT IS LATER USED BY DISNEXTA TO RETURN TO THE ROUTINE THAT 01125000
* LAST CALLED DISINIT TO DISPLAY THE NEXT ADDRESS. 01126000
* 01127000
* INITIALIZE BEGINNING AND ENDING ADDRESSES SUBROUTINE 01128000
* 01129000
DISINIT EQU * 01130000
MVC TENDADD(4),ENDMAX SET UP TRUE END DEFAULT @VM08524 01131000
NI SAVEWRK1,X'FF'-RANGE-DISLEN RESET FLAGS @V200930 01132000
LA R1,1(,R5) BUMP PAST TYPE CODE 01133000
CH R6,F1+2 ANY ADDRESS SPECIFIED ???? 01134000
BH DISISCAN BRANCH IF YES 01135000
SPACE 01136000
OI SAVEWRK1,RANGE INDICATE RANGE OF OPERANDS @VM08515 01137000
B DISIBLNK GO SET DEFAULTS 01138000
SPACE 01139000
* NOW CHECK FOR A COLON OR HYPHEN 01140000
SPACE 01141000
DISISCAN EQU * 01142000
LR R14,R6 LENGTH TO R14 01143000
BCTR R14,0 MINUS ONE FOR TYPE CODE BYPASS 01144000
DISICOLN CLI 0(R1),C':' CHECK FOR A COLON 01145000
BE DISIHYPH BRANCH IF YES 01146000
CLI 0(R1),C'-' HYPHEN ???? 01147000
BE DISIHYPH YES --- 01148000
CLI 0(R1),C'.' IS IT A LENGTH ?? @V200930 01149000
BE DISDOT YES, FLAG AND CONTINUE @V200930 01150000
CLI 0(R1),C' ' BLANK ??? 01151000
BNH DISIBLNK BRANCH IF IT IS @VM08515 01152000
LA R1,1(,R1) BUMP TO NEXT CHAR. 01153000
BCT R14,DISICOLN LOOP BACK IF HAVE MORE CHARACTERS TO CHK. 01154000
B DISIBLNK NO MORE - TREAT AS BLANK @VM08515 01155000
SPACE 01156000
DISDOT OI SAVEWRK1,DISLEN FLAG LENGTH RANGE @V200930 01157000
DISIHYPH OI SAVEWRK1,RANGE SET RANGE SWITCH 01158000
BCTR R6,0 MINUS ONE FROM LENGTH FOR HYPHEN 01159000
LA R0,1(R5,R6) COMPUTE LENGTH OF ENDING FIELD 01160000
LA R1,1(,R1) . . . 01161000
SR R0,R1 . . . 01162000
BNP DISIBLNK NO ENDING FIELD - TREAT AS BLANK @VM08515 01163000
SR R6,R0 COMPUTE LENGTH OF BEGINNING FIELD 01164000
SPACE 01165000
CL R0,F3 THREE CHARACTERS ???? 01166000
BNE DISICNVT NOT 'END' - BRANCH @VM08515 01167000
LR R14,R0 COUNT TO GPR 14 01168000
BCTR R14,0 LESS ONE FOR 'EX' 01169000
EX R14,ENDCOMP IS IT 'END' ???? 01170000
BE DISIBLNK BRANCH IF IT IS 01171000
DISICNVT STM R0,R1,SAVEWRK8 SAVE FOR POSSIBLE ERROR MSG 01172000
NI SAVEWRK1+1,X'FF'-CONVLEN RESET FLAG @V200930 01173000
TM SAVEWRK1,RANGE+DISLEN LENGTH RANGE ?? @V200930 01174000
BNO *+8 NO, NOT LENGTH FIELD @V200930 01175000
OI SAVEWRK1+1,CONVLEN INDICATE CONVERT LENGTH @V200930 01176000
BAL R4,CNVTBIN CONVERT END ADDRESS TO BINARY 01177000
BNZ BADADDR BRANCH IF BAD CONVERT 01178000
ST R15,TENDADD SAVE TRUE END ADDRESS @VM08524 01179000
CLI SAVEWRK1+2,C'Y' FLOATING POINT FUNCTION @VM08524 01180000
BNE REMEND NO -- @VM08524 01181000
TM SAVEWRK1,DISLEN+RANGE REG COUNT @VM08524 01182000
BO YREGCNT YES - VALIDATE REG COUNT @VM08524 01183000
TM TENDADD+3,X'01' VALID Y REG NUMBER @VM08524 01184000
BO CDB010 NO - REG ODD ERROR @VA01634 01185000
CL R15,F6 Y REG 0 2 4 6 @VM08524 01186000
BH CDB010 NO - Y REG ERROR @VA01634 01187000
B REMEND CONT @VM08524 01188000
YREGCNT SLL R15,1 X 2 (0 2 4 6) @VA01634 01189000
BCTR R15,0 -1 FOR LENGTH COUNT @VM08524 01190000
ST R15,TENDADD UPDATE NEW LENGTH COUNT @VM08524 01191000
LR R1,R15 CORRECT LENGTH REG @VM08524 01192000
REMEND LR R2,R1 REMEMBER END ADDRESS @VM08524 01193000
NI SAVEWRK1+1,X'FF'-CONVLEN RESET LENGTH FLAG @V200930 01194000
DISTRT LR R0,R6 GET LENGTH OF START CODE @VM08524 01195000
BCT R0,DISIBGNA SUBTRACT 1 FROM LENGTH FOR TYPE CODE 01196000
SR R1,R1 SET DEFAULT BEGINNING ADDRESS TO ZERO 01197000
ST R1,NXTADD .. 01198000
ST R1,TBEGADD SAVE TRUE BEGIN ADDRESS @VM08524 01199000
B DISTDOT TEST FOR LENGTH RANGE @V200930 01200000
DISIBGNA LA R1,1(R5) LOAD ADDRESS OF BEGINNING FIELD 01201000
STM R0,R1,SAVEWRK6 SAVE FOR POSSIBLE ERROR @VM08524 01202000
BAL R4,CNVTBIN CONVERT BEGINNING ADDRESS 01203000
BNZ BADADDR1 BRANCH IF BAD CONVERSION @VM08524 01204000
ST R15,TBEGADD SAVE TRUE BEGIN ADDRESS @VM08524 01205000
CL R15,ENDMAX IS IT ABOVE MAXIMUM ? @VM08524 01206000
BNH RANGOK1 NO, CONTINUE... @VA01634 01207000
MVC SAVEWRK8(8),SAVEWRK6 FOR ERROR MESSAGE @VA03060 01208000
TM SAVEWRK1,HEXLOC WHICH KIND OF ERROR? @VA01634 01209000
BO CDB160 HEXADDR ERROR @VA01634 01210000
B CDB010 REG ERROR. @VA01634 01211000
RANGOK1 EQU * @VA01634 01212000
ST R1,NXTADD INITIALIZE BEGINNING ADDRESS 01213000
CLI SAVEWRK1+2,C'Y' YREG PROCESSING @VM08524 01214000
BNE DISTDOT NO -- @VM08524 01215000
TM TBEGADD+3,X'01' YREG 0 2 4 6 @VM08524 01216000
BO BADADDR1 NO - YREG ERROR @VM08524 01217000
DISTDOT TM SAVEWRK1,RANGE+DISLEN IS IT LENGTH RANGE ?? @V200930 01218000
BNO DISENDA NO, SAVE END ADDRESS @V200930 01219000
L R15,TENDADD GET BYTE OR REG COUNT VALUE @VM08524 01220000
A R15,TBEGADD UPDATE TRUE END ADDRESS @VM08524 01221000
BCTR R15,0 -1 @VM08524 01222000
ST R15,TENDADD .. @VM08524 01223000
AL R2,TBEGADD ADD TO THE TRUE BEGIN ADDR @VA03502 01224000
DISENDA ST R2,ENDADD SET END ADDRESS @VM08524 01225000
CLC TBEGADD(4),TENDADD START LARGER THAN END @VM08524 01226000
BH CKRANGE YES, ERROR @VM08524 01227000
CLC TENDADD(4),ENDMAX END ADDRESS ABOVE MAXIMUM @VM08524 01228000
BH CKRANGE YES, ERROR @VM08524 01229000
TM SAVEWRK1,RANGE DISPLAY A RANGE OF ADDRESSES ? 01230000
BCR 1,R7 YES - RETURN 01231000
MVC ENDADD,NXTADD MAKE ENDING ADDRESS SAME AS BEGINNING 01232000
BR R7 RETURN 01233000
SPACE 01234000
CKRANGE TM SAVEWRK1,RANGE RANGE OF ADDRESSES ??? 01235000
BO CDB009 SEND BAD RANGE MESSAGE 01236000
MVC SAVEWRK8(8),SAVEWRK6 FOR ERROR MESSAGE @VA03060 01237000
TM SAVEWRK1,HEXLOC LOCATION OR REGISTER ???? 01238000
BO CDB160 BRANCH IF LOCATION 01239000
B CDB010 MUST BE REGISTER 01240000
DISIBLNK L R2,ENDADD SET DEFAULT END ADDRESS @V200930 01241000
NI SAVEWRK1,X'FF'-DISLEN NO LENGTH ON DEFAULT @V200930 01242000
B DISTRT CONTINUE @V200930 01243000
EJECT 01244000
* 01245000
* GET NEXT ADDRESS SUBROUTINE 01246000
* 01247000
DISNEXTA L R1,NXTADD LOAD CURRENT ADDRESS @V4075A0 01250100
AH R1,INCRMT GET NEXT ADDRESS @VA03720 01251000
DISNCOMM TM VMRSTAT,VMLOGOFF IS USER LOGGING OFF ? 01256000
BO EXIT YES TERMINATE THE DUMP OR DISPLAY 01257000
CL R1,ENDADD GREATER THAN ENDING ADDRESS ? 01258000
BH DISGETN LOOK FOR MORE USER INPUT @V4075A0 01259100
ST R1,NXTADD STORE NEXT ADDRESS 01260000
BR R7 CONTINUE 01279000
ENDCOMP CLC 0(0,R1),=C'END ' EXECUTED COMPARE 01346000
EJECT 01347000
********************************************************************* 01348000
* 01349000
* SUBROUTINE TO FORMAT LINE HEADER & TRAILER 01350000
* 01351000
********************************************************************* 01352000
DISHEAD L R1,NXTADD GET NEXT ADDRESS 01353000
CLC IDCHAR,=C'LOC' DISPLAY STORAGE COMMAND? @V4075A0 01354100
BE DISHCORE BRANCH IF YES 01355000
MVC BUFBUF(3),IDCHAR MOVE IDENTIFICATION TO BUFFER 01356000
CALL DMKCVTBD CONVERT REGISTER NUMBER TO DECIMAL 01357000
STH R1,BUFBUF+4 STORE IN BUFFER 01358000
CLI BUFBUF+4,C'0' LEADING ZERO ? 01359000
BNE DISHSETP BRANCH IF NO 01360000
MVI BUFBUF+4,C' ' YES - REPLACE WITH A BLANK 01361000
DISHSETP MVI BUFBUF+7,C'=' 01362000
DISHSETC LA R1,BUFBUF+10 SET ADDRESS 01363000
ST R1,BUFPNT STORE POINTER 01364000
MVC BFRCNT,F10+2 SET COUNT = 10 @V4075A0 01365100
BR R8 RETURN 01366000
SPACE 2 01367000
DISHCORE EQU * 01368000
TM BUFLAG,FIRSTL IS THIS THE 1ST LINE ? 01369000
BO DISH1STL BRANCH IF YES 01370000
TM BUFLAG,SAMEL LINES ALREADY SUPPRESSED ? 01371000
BO DISHSUPP BRANCH IF YES 01372000
BAL R15,SETR14 GO SET UP 'EX' REG. 01373000
L R1,NXTADD RELOAD NEXT ADDRESS 01374000
EX R14,DISHCLCL SAME AS LAST LINE ? 01375000
BNE DISHSAVE BRANCH IF NO 01376000
OI BUFLAG,SAMEL TURN ON SAME AS LAST LINE SWITCH 01377000
CALL DMKCVTBH CONVERT ADDRESS TO HEX 01378000
STCM R0,B'0011',BUFBUF @V4075A0 01379100
STCM R1,B'1111',BUFBUF+2 @V4075A0 01380100
L R1,NXTADD RELOAD CURRENT ADDRESS 01381000
MVC BUFBUF+7(2),=C'TO' 01382000
MVC BUFBUF+19(L'SUPPLMSG),SUPPLMSG MOVE MESSAGE TEXT 01383000
MVC BFRCNT,=AL2(L'SUPPLMSG+19) SET BYTE COUNT 01384000
DISHBUMP AH R1,BUFTRC BUMP TO NEXT LINE ADDRESS 01385000
TM SAVEWRK1,VIRTC REAL OR VIRTUAL 01386000
BO DISHVIRT BRANCH AROUND IF IT'S VIRTUAL 01387000
L R14,=A(DMKSYSRM) GET ADDRESS OF TOP 01388000
L R14,0(,R14) LOAD THE ADDRESS 01389000
B DISHCKR1 GO SEE IF IT WILL FIT 01390000
DISHVIRT EQU * 01391000
L R14,VMSIZE LOAD VIRTUAL MACHINE SIZE 01392000
DISHCKR1 EQU * 01393000
CR R1,R14 ADDRESS IN R1 TOO HIGH 01394000
BNH DISHSTR1 BRANCH IF IT ISN'T 01395000
LR R1,R14 MAKE IT VALID 01396000
DISHSTR1 EQU * 01397000
ST R1,NXTADD SAVE NEW ADDRESS 01398000
CALL DMKCVTBH CONVERT ADDRESS TO HEX 01399000
STCM R0,B'0011',BUFBUF+10 @V4075A0 01400100
STCM R1,B'1111',BUFBUF+12 @V4075A0 01401100
L R1,NXTADD RELOAD NEXT ADDRESS 01402000
B DISNCOMM CHECK NEXT ADDRESS 01403000
EJECT 01404000
DISH1STL NI BUFLAG,NFIRSTL TURN OFF 1ST LINE SWITCH 01405000
DISHSAVE NI BUFLAG,NSAMEL TURN OFF SUPPRESSED LINES SWITCH 01406000
CALL DMKCVTBH CONVERT ADDRESS TO HEX @VM08515 01407000
STCM R0,B'0011',BUFBUF @V4075A0 01408100
STCM R1,B'1111',BUFBUF+2 @V4075A0 01409100
BAL R15,SETR14 GO SET UP 'EX' REG. 01410000
EX R14,DISHMVCL SAVE NEXT 16 OR 32 BYTES 01411000
TM BUFLAG,TRANSLAT TRANSLATE TO EBCDIC ???? 01412000
BZ DISHSETC NO .. 01413000
LA R1,BUFBUF+92 POINT TO KEY AREA 01414000
CH R14,=H'31' LONG LINE ?? 01415000
BE *+8 YES 01416000
LA R1,BUFBUF+49 POINT TO KEY IN SHORT LINE @V200930 01417000
LR R4,R1 SAVE BUFFER ADDRESS 01418000
LR R1,R2 GET DATA ADDRESS 01419000
N R1,=F'2047' AT 2K BOUNDARY ?? 01420000
BNZ BUFUP NO .. 01421000
ST R14,REGSAVE SAVE ACROSS SUBROUTINE @VM08553 01422000
STM R2,R3,REGSAVE+4 ... @VM08553 01423000
L R1,NXTADD GET THE ADDRESS OF THIS PAGE @VM08854 01424000
TM SAVEWRK1,VIRTC IS THIS VIRT STORAGE? @VM08854 01425000
BO CDBK01 VIRT, LET SUBROUTINE DO IT @VM08854 01426000
SR R1,R1 CLEAR OUT FOR CVT ROUTINE @VM08854 01427000
ISK R1,R2 GET THE REAL STUFF @VM08854 01428000
B CDBK02 AND CONTINUE NORMALLY @VM08854 01429000
SPACE 01430000
CDBK01 BAL R15,GETKEY GO GET THE KEY @VM08854 01431000
CDBK02 CALL DMKCVTBH CONVERT @VM08854 01432000
L R14,REGSAVE RESTORE FOR RETURN 01433000
LM R2,R3,REGSAVE+4 RESTORE THE REGS @VM08553 01434000
STH R1,0(R4) PUT KEY IN LINE 01435000
BUFUP LR R1,R4 RESTORE BUFFER ADDRESS 01436000
LA R1,4(R1) POINT TO TRANSLATE AREA 01437000
MVI 0(R1),C'*' 01438000
EX R14,DISHMVCB MOVE LINE TO BUFFER 01439000
L R15,=A(DMKDMPTR) LOAD TRANSLATE TABLE ADDRESS 01440000
EX R14,DISHTRLN TRANSLATE TO PRINTABLE CHARACTERS 01441000
LA R1,2(R14,R1) BUMP POINTER TO NEXT BYTE 01442000
MVI 0(R1),C'*' 01443000
B DISHSETC SET POINTER AND COUNT 01444000
SPACE 2 01445000
DISHSUPP EQU * 01446000
BAL R15,SETR14 GO SET UP 'EX' REG. 01447000
L R1,NXTADD RELOAD NEXT ADDRESS 01448000
EX R14,DISHCLCL SAME AS LAST LINE ? 01449000
BE DISHBUMP BRANCH IF YES 01450000
BAL R4,DISWRITE OUTPUT SUPPRESSED LINES MESSAGE 01451000
TM SAVEWRK1,VIRTC VIRTUAL REQUEST ????? 01452000
BZ DISHSAVE NO -- NO NEED TO DO TRANS 01453000
TRANS 2,1,OPT=(BRING,DEFER) MAKE SURE ADDRESS STILL IN !! 01454000
B DISHSAVE SAVE THIS LINE 01455000
SPACE 2 01456000
********************************************************************* 01457000
* * 01458000
* THIS SUBROUTINE INSURES THAT R14 WHICH IS USED FOR EXECUTED * 01459000
* COMPARES AND MOVES DOES NOT CONTAIN A COUNT THAT WILL * 01460000
* GO PAST THE END OF REAL STORAGE * 01461000
* * 01461100
* THIS ROUTINE WILL ALSO INSURE THAT NON-CONTIGUOUS V-STORAGE * 01461200
* DATA WILL BE COLLECTED INTO A CONTIGUOUS AREA CALLED * 01461300
* WRKLINE FOR DUPLICATE LINE PROCESSING * 01461400
* * 01462000
********************************************************************** 01463000
SPACE 2 01464000
SETR14 LH R14,BUFTRC LOAD NORMAL TRANSLAT COUNT 01465000
L R1,=A(DMKSYSRM) ADDRESS OF TOP OF STORAGE CONST. 01466000
L R0,0(,R1) TOP OF STORAGE TO R0 01467000
SR R0,R2 DIFFERENCE BETWEEN PRESENT AND TOP 01468000
CR R0,R14 COMPARE THE COUNTS 01469000
BH SETR14A IF R14 IS VALID CONTINUE.... @VA05405 01470000
LR R14,R0 IF NOT - MAKE IT VALID 01471000
SETR14A EQU * @VA05405 01471005
ST R3,REGSAVE SAVE R3 @VA05405 01471010
LA R3,WRKLINE POINT TO WORK LINE BUFFER @VA05405 01471015
ST R14,REGSAVE+8 SAVE R14 @VA05405 01471020
LR R4,R2 SAVE OLD (REAL) PAGE ADDRESS @VA05405 01471025
TM SAVEWRK1,VIRTC VIRTUAL REQUEST ? @VA05405 01471030
BZ R14OK IF SO, MUST BE CONTIGUOUS @VA05405 01471035
L R1,NXTADD GET ADDRESS OF THIS PAGE @VA05405 01471040
N R1,F4095 SAVE PAGE DISPLACEMENT ONLY @VA05405 01471045
AR R1,R14 ADD LENGTH TO DISP @VA05405 01471050
C R1,F4096 CROSS OVER 4K PAGE BOUNDARY ? @VA05405 01471055
BNH R14OK IF NOT, ALL SET @VA05405 01471060
N R1,F4095 NUMBER OF BYTES INTO SECOND PAGE @VA07075 01471065
LR R0,R1 SAVE IT ... @VA05405 01471070
SR R14,R0 NUMBER OF BYTES IN 1ST PAGE @VA05405 01471075
BCTR R14,0 -1 @VA05405 01471080
EX R14,MOVEWRK GET 1ST PAGE DATA @VA05405 01471085
LA R3,1(R14,R3) UPDATE WORK LINE POINTER @VA05405 01471090
L R1,NXTADD CALC NEXT PAGE ADDRESS @VA05405 01471095
LA R1,1(R14,R1) EST VOILA, 2ND PAGE ADDRESS @VA05405 01471100
ST R15,REGSAVE+4 SAVE RETURN ADDRESS ACROSS CALL @VA05405 01471105
TRANS 2,1,OPT=(BRING,DEFER) @VA05405 01471110
L R15,REGSAVE+4 RESTORE RETURN ADDRESS @VA05405 01471115
LR R14,R0 SECOND PAGE LENGTH .... @VA05405 01471120
R14OK BCTR R14,0 MINUS ONE FOR THE EXECUTES 01472000
EX R14,MOVEWRK MOVE TO WORK AREA @VA05405 01472100
L R3,REGSAVE RESTORE R3 @VA05405 01472200
L R14,REGSAVE+8 RESTORE R14 @VA05405 01472300
LR R2,R4 RESTORE OLD (REAL) PAGE ADDRESS @VA05405 01472400
BCTR R14,0 -1 FOR EXECUTES @VA05405 01472500
BR R15 GO BACK 01473000
SPACE 6 01474000
* EXECUTED INSTRUCTIONS 01475000
SPACE 01476000
DISHCLCL CLC LNSAVE(*-*),WRKLINE @VA05405 01477000
DISHMVCL MVC LNSAVE(*-*),WRKLINE @VA05405 01477500
MOVEWRK MVC 0(*-*,R3),0(R2) @VA05405 01478000
DISHMVCB MVC 1(*-*,R1),WRKLINE @VA05405 01479000
DISHTRLN TR 1(0,R1),0(R15) 01480000
MOVEID MVC BUFBUF+25(*-*),0(R3) EXECUTED FOR DUMP ID @V200930 01481000
CLCPSW CLC 0(0,R5),CPSWEQ @V4075A0 01482100
EJECT 01483000
* 01484000
* OUTPUT SUBROUTINE 01485000
* 01486000
DISWRITE TM VMRSTAT,VMLOGOFF IS USER LOGGING OFF ? 01487000
BO EXIT YES TERMINATE THE DUMP OR DISPLAY 01488000
TM VMOSTAT,VMKILL IS USER BEING FORCED OFF @VA05493 01488350
BO EXIT YES, TERMINATE DUMP OR DISPLAY @VA05493 01488700
STM R0,R3,REGSAVE SAVE REGISTERS 01489000
LH R0,BFRCNT LOAD BUFFER BYTE COUNT 01490000
LTR R0,R0 IS IT ZERO ? 01491000
BZ DISWRTOK YES - NOTHING TO OUTPUT 01492000
LR R1,R10 LOAD BUFFER ADDRESS 01493000
TM BUFLAG,TRANSLAT TRANSLATED OUTPUT ALSO ? 01496000
BZ DISWRTC NO - DON'T CHANGE LENGTH 01497000
LA R0,71 SIZE FOR SHORT TRANS OUTPUT @V200930 01498000
DISWRTC EQU * @V200820 01499000
CALL DMKQCNWT,PARM=0 SEND LINE TO TERMINAL 01500000
BNZ EXIT QUIT IF 'ATTN' OR LINE DROP @V200820 01501000
DISWRTOK ST R10,BUFPNT RESET BUFFER POINTER 01502000
MVC BFRCNT(2),ZEROES ZERO THE BYTE COUNT 01503000
MVI BUFBUF,C' ' CLEAR BUFFER 01504000
MVC BUFBUF+1(131),BUFBUF 01505000
LM R0,R3,REGSAVE RESTORE REGISTERS 01506000
BR R4 RETURN 01507000
EJECT 01508100
********************************************************************* 01530000
* SUBROUTINE TO CONVERT AN ADDRESS TO BINARY 01531000
* 01532000
* ON ENTRY - R0 = LENGTH OF FIELD 01533000
* R1 = LOCATION OF FIELD 01534000
* ON EXIT - R1 = RESULT OF CONVERSION TRUNCATED 01535000
* TO INCREMENT BOUNDARY 01536000
* CC = 0 IF CONVERSION IS SUCCESSFUL 01537000
* CC = 1 IF CONVERSION ERROR 01538000
* 01539000
********************************************************************* 01540000
CNVTBIN CL R0,FLDLEN LENGTH GREATER THAN MAX ? @VM08524 01541000
BH CDB003 YES - ERROR DMKCDB003 @VM08524 01542000
STM R0,R1,REGSAVE SAVE INPUT CONDITIONS @VM08524 01543000
TM SAVEWRK1+1,CHEX HEXADECIMAL FIELD ? 01544000
BO CNVTHEX BRANCH IF YES 01545000
CALL DMKCVTDB CONVERT TO BINARY 01546000
BZ CNVTCOMM BRANCH IF CONVERSION OK 01547000
LM R0,R1,REGSAVE RESTORE INPUT CONDITIONS 01548000
CNVTHEX CALL DMKCVTHB CONVERT TO BINARY 01549000
BCR 7,R4 RETURN IF BAD CONVERSION 01550000
CNVTCOMM LH R0,INCRMT LOAD ADDRESS INCREMENT 01551000
LCR R0,R0 LOAD COMPLEMENT OF INCREMENT 01552000
LR R15,R1 SAVE TRUE ADDRESS @VM08524 01553000
TM SAVEWRK1+1,CONVLEN CONVERT LENGTH FIELD ?? @V200930 01554000
BZ TRUNC NO, TRUNC FOR ALIGN @V200930 01555000
LTR R1,R1 IS LENGTH ZERO ?? @V200930 01556000
BZ BADADDR YES, INVALID LENGTH @VM08524 01557000
BCTR R1,R0 ONE LESS IN R1 FOR RANGE @V200930 01558000
TRUNC DS 0H @V200930 01559000
NR R1,R0 TRUNCATE TO INCREMENT BOUNDARY 01560000
SR R0,R0 SET CC = 0 01561000
BR R4 RETURN TO CALLER 01562000
EJECT 01563000
CONFMSG MSG 'COMMAND COMPLETE' 01564000
CALL DMKQCNWT,PARM=NORET 01565000
B EXIT 01566000
BADADDR1 LM R0,R1,SAVEWRK6 LEN AND ADDRESS OF STARTING FIELD@VM08524 01567000
B *+8 CHECK WHICH ERROR @VM08524 01568000
BADADDR LM R0,R1,SAVEWRK8 LOAD LEN. AND ADDRESS OF BAD ARGUMENT 01569000
TM SAVEWRK1+1,CONVLEN CONVERT LENGTH ERROR? @VA03060 01570000
BO CDB003 BRANCH IF YES @VA03060 01571000
TM SAVEWRK1,HEXLOC LOCATION REQUEST 01572000
BO CDB004 BR. IF YES 01573000
CDB003 LA R2,3 ERROR CODE 01574000
B PARMLEN SET PARM LENGTH @VM08524 01575000
SPACE 01576000
CDB004 LA R2,4 ERROR CODE 01577000
B PARMLEN SET PARM LENGTH @VM08524 01578000
SPACE 01579000
CDB009 LA R2,009 ERROR CODE 01580000
L R1,TBEGADD GET TRUE BEGIN ADDRESS @VM08524 01581000
TM SAVEWRK1,HEXLOC HEX LOC OR REGISTER ?? @V200930 01582000
BO CVTH1 HEX @V200930 01583000
CALL DMKCVTBD CONVERT TO DEC @V200930 01584000
B STCM1 SAVE VALUES @V200930 01585000
CVTH1 CALL DMKCVTBH CONVERT TO HEX @V200930 01586000
STCM1 DS 0H @V200930 01587000
STCM R0,3,BUFBUF STORE HEXLOC 01588000
STCM R1,15,BUFBUF+2 . . . 01589000
MVI BUFBUF+6,C'-' INSERT HYPHEN 01590000
L R1,TENDADD LOAD TRUE END ADDRESS @VM08524 01591000
TM SAVEWRK1,HEXLOC HEX OR DEC CONVERT ?? @V200930 01592000
BO CVTH2 HEX @V200930 01593000
CALL DMKCVTBD CONVERT TO DEC @V200930 01594000
B STCM2 SAVE VALUES @V200930 01595000
CVTH2 CALL DMKCVTBH CONVERT TO HEX @V200930 01596000
STCM2 DS 0H @V200930 01597000
STCM R0,3,BUFBUF+7 STORE AWAY 01598000
STCM R1,15,BUFBUF+9 . . . 01599000
TM SAVEWRK1,HEXLOC HEX LOCATION ?? @V200930 01600000
BO STCM3 YES, CONT @V200930 01601000
STCM R1,3,BUFBUF+7 SET VALUE FOR REG @V200930 01602000
LA R0,5 SIZE @V200930 01603000
LA R1,BUFBUF+4 DATA ADDRESS @V200930 01604000
B CALLERM DO ERROR MESSAGE @V200930 01605000
STCM3 DS 0H @V200930 01606000
LA R0,13 LENGTH OF FIELD 01607000
LA R1,BUFBUF SET DATA ADDRESS @V200930 01608000
B CALLERM 01609000
SPACE 01610000
CDB010 LA R2,010 ERROR CODE - MESSAGE DMKCDB010 @VM08524 01611000
B ERRPARM GO SET UP ERROR PARM @VM08524 01612000
SPACE 01613000
CDB026 LA R2,26 ERROR CODE 01614000
B NOVAR . . . 01615000
SPACE 01616000
CDB033 LA R2,33 ERROR CODE 01617000
B NOVAR . . . 01618000
SPACE 01619000
CDB160 LA R2,160 ERROR CODE - MESSAGE DMKCDB160 @VM08524 01626000
ERRPARM LM R0,R1,SAVEWRK8 COUNT AND ADDRESS OF ERROR OPTION@VM08524 01627000
PARMLEN C R0,F24 COUNT OVER MAX @VM08524 01628000
BNH *+8 NO - @VM08524 01629000
LA R0,24 SET MAX COUNT @VM08524 01630000
B CALLERM . . . 01631000
SPACE 01632000
NOVAR SR R1,R1 ZERO PARM REG 01633000
SPACE 01634000
SPACE 01635000
CALLERM ICM R0,14,MODID+3 INSERT MODULE ID 01636000
ICM R2,B'1000',X40FFS FLAG TO FRET BUFFER, NOT RTN@V4075A0 01637100
L R3,SAVEWRK4 LOAD ADDRESS AND LENGTH OF BUFFER 01638000
CALL DMKERMSG . . . 01639000
* 01640000
* DMKERM MODULE WILL FRET THE BUFFER, SVC16 THE SAVEAREA OUT, 01641000
* AND RETURN DIRECTLY TO DMKCFM TO PROCESS THE NEXT COMMAND. 01642000
* 01643000
EJECT 01644000
EXIT EQU * 01645000
TM VMPSTAT,VMV370R EXTENDED-CONTROL MACHINE? 01646000
BZ EXITOUT NO - CONTINUE 01647000
TM VMESTAT,VMNEWCR0+VMINVSEG+VMINVPAG 01648000
BZ EXITOUT NOTHING NEEDS CLEANUP 01649000
CALL DMKVATAB CLEAN UP SHADOW TABLES 01650000
EXITOUT LA R0,BFRSIZE FRET OUTPUT BUFFER @VM08524 01651000
LR R1,R10 ADDRESS OF BUFFER @VM08524 01652000
CALL DMKFRET .. @VM08524 01653000
EXIT @VM08515 01654000
EJECT 01655000
*********************************************************************** 01656000
* 01657000
* CONSTANTS * 01658000
* * 01659000
KEYEQ DC C'KEY =' 01660000
SUPPLMSG DC C'SUPPRESSED LINE(S) SAME AS ABOVE .....' 01661000
CPSWEQ DC C'PSW =' @V4075A0 01661100
SPACE 01662000
LTORG 01663000
EJECT 01664000
PSA , @V306638 01665000
COPY CONBUF @V306638 01666000
COPY EQU @V306638 01667000
COPY SAVE @V306638 01668000
COPY VMBLOK @V306638 01669000
END 01670000