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