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 | LHEXLOC1 <<-> > | 00600000 * | DCP | THEXLOC1 <<:> > | 00601000 * | | 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