FED TITLE 'DMMFED (IPCS) VM/370 - RELEASE 6' 00001000 * 00002000 * MODULE NAME: 00003000 * DMMFED SUBROUTINE OF DUMPSCAN 00004000 * 00005000 * FUNCTION: 00006000 * DISPLAY 'NNN' BYTES FROM ADDRESS 'HEXLOC' 00007000 * 00008000 * ATTRIBUTES: 00009000 * REUSABLE 00010000 * NON-REENTRANT 00011000 * 00012000 * ENTRY POINTS: 00013000 * DMMFED 00014000 * 00015000 * ENTRY CONDITIONS: 00016000 * R2 POINTS TO PLIST WITH TOKENIZED INPUT 00017000 * 00018000 * EXIT CONDITIONS: 00019000 * RETURN CODE IN R15 0 - GOOD 00020000 * 4 - WARNING 00021000 * 8 - FATAL 00022000 * 00023000 * CALLS TO OTHER ROUTINES: 00024000 * GETREC TO READ IN AN AREA OF THE DUMP 00025000 * 00026000 * EXTERNAL REFERENCES: 00027000 * BUFF1 GETREC'S BUFFER AREA 00028000 * SCRNAREA DISPLAY AREA 00029000 * 00030000 * TABLES/WORKAREAS: 00031000 * PLIST ADDRESS PASSED IN R2 00032000 * BUFF1 IN GETREC 00033000 * 00034000 * REGISTER USAGE: 00035000 * 00036000 * R15 ADDRESSES OF EXTERNAL ROUTINES 00037000 * R14 RETURNS FROM EXTERNAL ROUTINES 00038000 * R13 SAVE AREA ADDRESS 00039000 * R12 BASE 00040000 * R10 INTERNAL LINKS 00041000 * R9-R2 WORK REGISTERS 00042000 * R2 PASSES ADDRESS OF PLIST. 00043000 * 00044000 * NOTES: 00045000 * 00046000 * 00047000 * OPERATION: 00048000 * INPUT IS OF THE FORM 'D XXXXXX NNN', WHERE 'XXXXXX' 00049000 * IS A HEX ADDRESS, AND 'NNN' IS A HEX NUMBER OF BYTES. 00050000 * IT IS CHECKED FOR VALIDITY, AND TRANSLATED FROM EBC 00051000 * TO HEX. THE ADDRESS IS PASSED TO GETREC WHO FETCHES 00052000 * THE AREA INTO CORE. THE AREA IS TRANSLATED TO EBCDIC, 00053000 * ALONG WITH THE APPROPRIATE ADDRESSES, AND DISPLAYED 00054000 * ON THE SCREEN. THIS IS CONTINUED UNTIL THE REQUESTED 00055000 * BYTE COUNT HAS BEEN DISPLAYED. CONTROL IS RETURNED 00056000 * TO DUMPSCAN. 00057000 * TO BE COMPATIBLE WITH THE CP 'DISPLAY' FUNCTION 00058000 * DMMFED ACCEPTS INPUT OF THE FORM 'D TXXXXXX.NNN'. 00059000 * THE INPUT IS CHECKED FOR 'XXXXXX%', WHICH INDICATES 00060000 * AN INDIRECT REQUEST. 00061000 * 00062000 * ERROR MESSAGES: 00063000 * DMMFED702I NON-HEX CHARACTER IN IN COUNT - RETRY 00064000 * DMMFED703I NON-HEX CHARACTER IN ADDRESS - RETRY 00065000 * 00066000 * 00067000 * * * * * * * *------- -------- -------- -------- ------* 00068000 * * * * * * * *------- -------- -------- -------- ------* 00069000 EJECT 00070000 DMMFED CSECT @VA04250 00071000 ENTRY TRTABLE TRANSLATE TABLE @VA04830 00072000 EXTRN BUFF1 GET READ AREA @VA04250 00073000 ENTRY DMMFEDLN COMMON WRTERM/PRINT ROUTINE @V4075A2 00074000 EXTRN PRINTSW PRINT ON/OFF INDICATOR @V4075A2 00075000 EXTRN SCRNAREA DISPLAY AREA @VA04250 00076000 EXTRN DMMGET FETCH DUMP INTO CORE @VA04250 00077000 EXTRN DMMINT TRANSLATE HEX TO EBCDIC @VA04250 00078000 EXTRN INPUT READ IN AREA @VA04250 00079000 EXTRN CONSOLE VIRT CONS ADD @VA04250 00080000 EXTRN PRINTONE ONE-SHOT PRINT SW @V4075A2 00081000 STM R14,R12,SAVEDISP(R13) SAVE CALLERS REGS @VA04250 00082000 LR R12,R15 ADDRESSABILITY @VA04250 00083000 USING DMMFED,R12 RIGHT @VA04250 00084000 ST R13,SAVEBACK CALLERS SAVE AREA PTR @VA04250 00085000 B EYECATCH GO PAST EYE CATCHER @VA04250 00086000 DS 0D ALIGN @VA04250 00087000 DC CL8'DMMFED' EYE CATCHER @VA04250 00088000 RELLEV DC C'REL4LEV0' RELEASE AND LEVEL @V4075A1 00089000 EYECATCH LA R13,SAVEAREA OUR SAVE AREA PTR @VA04250 00090000 XC RETCODE(WORKL),RETCODE CLEAR RETURN CODE @VA04250 00091000 * * * * * * * *------- -------- -------- -------- ------* 00092000 * * * * * * * * THE PLIST ADDRESS IS IN R2. THIS FIRST 00093000 * * * * * * * * RIGHT JUSTIFIES THE COUNT, CHECKING FOR 00094000 * * * * * * * * VALIDITY, THEN CONVERTS THE COUNT TO HEX. 00095000 * * * * * * * *------- -------- -------- -------- ------* 00096000 ST R2,PLISTADD SAVE PLIST PTR @VA04250 00097000 CLC FOXES,PL3(R2) NO COUNT IN PLIST? @VA04250 00098000 BNE MOVEZ COUNT - CONTINUE @VA04250 00099000 LA R4,DEFAULT SET COUNT TO HEX 16 @VA04250 00100000 ST R4,HEXCOUNT STORE IT @VA04250 00101000 B ADFETCH GO TREAT ADDRESS @VA04250 00102000 MOVEZ MVC COUNT,CZEROS SET COUNT TO ZEROS @VA04250 00103000 LA R4,L'ADDRESS COUNT 6 BYTES OF INPUT @VA04250 00104000 LA R2,INLEN(R2) LAST BYTE OF INPUT @VA04250 00105000 LA R3,COUNT+LOUT LAST BYTE OF OUTPUT @VA04250 00106000 CCOMPR CLI 0(R2),BLANK IS IT BLANK @VA04250 00107000 BE CBUMP @VA04250 00108000 * * * * * * * *------- -------- -------- -------- ------* 00109000 * * * * * * * * FIRST CHECK INPUT VALIDITY 00110000 * * * * * * * *------- -------- -------- -------- ------* 00111000 CMOVEIT CLI 0(R2),A BELOW 'A'? @VA04250 00112000 BL CBADIN NOT HEX @VA04250 00113000 CLI 0(R2),F ABOVE 'F' @VA04250 00114000 BH CHICHEK OK SO FAR @VA04250 00115000 B CVALID GOOD - USE IT @VA04250 00116000 CHICHEK CLI 0(R2),ZERO BELOW '0' @VA04250 00117000 BL CBADIN NOT HEX @VA04250 00118000 CLI 0(R2),A9 ABOVE '9' @VA04250 00119000 BH CBADIN NOT HEX @VA04250 00120000 CVALID MVC 0(ONE,R3),0(R2) MOVE THE CHAR @VA04250 00121000 BCTR R3,R0 BACK UP OUTPUT PTR @VA04250 00122000 CBUMP BCTR R2,R0 BACK UP INPUT PTR @VA04250 00123000 BCT R4,CCOMPR GET THE NEXT CHAR @VA04250 00124000 B CTRAN ALL DONE @VA04250 00125000 CBADIN LA R8,ERMSG702 ADDRESS @VA04250 00126000 LA R9,L'ERMSG702 AND LENGTH @VA04250 00127000 BAL R10,WRTERM 'NON-HEX CHAR IN COUNT' @VA04250 00128000 B RETURN TRY AGAIN @VA04250 00129000 EJECT 00130000 * * * * * * * *------- -------- -------- -------- ------* 00131000 * * * * * * * * NOW THE COUNT IS RIGHT JUSTIFIED IN THE 00132000 * * * * * * * * 'COUNT' FIELD, AND WILL BE TRANSLATED 00133000 * * * * * * * * TO HEX FOR THE COUNT ROUTINE. 00134000 * * * * * * * *------- -------- -------- -------- ------* 00135000 CTRAN LA R4,COUNT SET UP FOR CONVERT @VA04250 00136000 LA R6,L'ADDRESS COUNT ADDRESS BYTES @VA04250 00137000 CTEST TM 0(R4),NUMZONE NUMERIC? @VA04250 00138000 BNO CADDNINE NO - FIX IT UP @VA04250 00139000 LA R4,ONE(R4) NEXT BYTE @VA04250 00140000 BCT R6,CTEST IF NOT ALL DONE @VA04250 00141000 B CALLDONE @VA04250 00142000 CADDNINE MVC CREGLOAD+LORD(ONE),0(R4) ADD A BINARY @VA04250 00143000 L R7,CREGLOAD NINE TO ANY @VA04250 00144000 AH R7,NINE ALPHA DIGIT @VA04250 00145000 ST R7,CREGLOAD PLUG IT BACK INTO COUNT @VA04250 00146000 MVC 0(ONE,R4),CREGLOAD+LORD INTO COUNT @VA04250 00147000 LA R4,ONE(R4) GET NEXT BYTE @VA04250 00148000 BCT R6,CTEST NEXT BYTE @VA04250 00149000 CALLDONE PACK HEXCOUNT(HEXL),COUNT(COUNTL) STRIP OFF ZONES @VA04250 00150000 L R3,HEXCOUNT CHECK COUNT NOT TO BE ZERO, @VA04250 00151000 LTR R3,R3 IS IT ZERO? @VA04250 00152000 BNZ STORCNT NO - LET IT STAND @VA04250 00153000 LA R3,DEFAULT YES - SET TO 16 @VA04250 00154000 STORCNT ST R3,HEXCOUNT PLUG THE COUNT @VA04250 00155000 * * * * * * * *------- -------- -------- -------- ------* 00156000 * * * * * * * * THIS ROUTINE MOVES THE EBCDIC ADDRESS FROM THE 00157000 * * * * * * * * THE PLIST, TRANSLATES IT TO HEX, CHECKING 00158000 * * * * * * * * FOR INDIRECT REQUESTS. IT FETCHES THE 00159000 * * * * * * * * NEEDED RECORD INTO CORE AND FORMATS AND 00160000 * * * * * * * * DISPLAYS THE AMOUNT SPECIFIED. 00161000 * * * * * * * *------- -------- -------- -------- ------* 00162000 ADFETCH L R2,PLISTADD RESTORE PLIST PTR @VA04250 00163000 MVC ADDRESS,CZEROS SET ADRESS TO ZEROS @VA04250 00164000 LA R4,PLISTENT COUNT 8 BYTES OF INPUT @VA04250 00165000 LA R2,PL2L(R2) 15 - LAST BYTE OF INPUT @VA04250 00166000 LA R3,ADDRESS+LOUT LAST BYTE OF OUTPUT @VA04250 00167000 COMPR CLI 0(R2),BLANK IS IT BLANK @VA04250 00168000 BE BUMP YES - GET NEXT LETTER @VA04250 00169000 CLI 0(R2),T AS IN 'D T1000...' @VA04250 00170000 BNE PCCHECK NO - GO CHECK PERCENT @VA04250 00171000 MVI 0(R2),ZERO REPLACE WITH A ZERO @VA04250 00172000 B VALID AND PLUG IT IN PLIST @VA04250 00173000 PCCHECK CLI 0(R2),PERCENT IS IT A %? @VA04250 00174000 BNE MOVEIT NO ITS A CHARACTER @VA04250 00175000 MVI PCSW,INDIRECT YES - TURN ON INDIRECT SW @VA04250 00176000 B BUMP AND GET ANOTHER @VA04250 00177000 EJECT 00178000 * * * * * * * *------- -------- -------- -------- ------* 00179000 * * * * * * * * FIRST CHECK INPUT VALIDITY 00180000 * * * * * * * *------- -------- -------- -------- ------* 00181000 MOVEIT CLI 0(R2),A BELOW 'A' @VA04250 00182000 BL BADIN NOT HEX @VA04250 00183000 CLI 0(R2),F ABOVE 'F' @VA04250 00184000 BH HICHEK SO FAR SO GOOD @VA04250 00185000 B VALID GOOD @VA04250 00186000 HICHEK CLI 0(R2),ZERO BELOW '0' @VA04250 00187000 BL BADIN NOT HEX @VA04250 00188000 CLI 0(R2),A9 ABOVE '9' @VA04250 00189000 BH BADIN NOT HEX @VA04250 00190000 VALID MVC 0(ONE,R3),0(R2) MOVE THE CHAR @VA04250 00191000 BCTR R3,R0 BACK UP OUTPUT PTR @VA04250 00192000 BUMP BCTR R2,R0 BACK UP INPUT PTR @VA04250 00193000 BCT R4,COMPR GET ANOTHER @VA04250 00194000 B TRANADD GOOD - GO TRANSLATE IT @VA04250 00195000 BADIN LA R8,ERMSG703 ADDRESS @VA04250 00196000 LA R9,L'ERMSG703 AND LENGTH @VA04250 00197000 BAL R10,WRTERM 'NON-HEX CHARACTER IN ADDRESS' @VA04250 00198000 B RETURN TRY AGAIN @VA04250 00199000 * * * * * * * *------- -------- -------- -------- ------* 00200000 * * * * * * * * NOW THE ADDRESS IS RIGHT JUSTIFIED IN THE 00201000 * * * * * * * * 'ADDRESS' FIELD, AND WILL BE TRANSLATED 00202000 * * * * * * * * TO HEX FOR THE GETREC ROUTINE. 00203000 * * * * * * * *------- -------- -------- -------- ------* 00204000 TRANADD LA R4,ADDRESS SET UP FOR CONVERT @VA04250 00205000 LA R6,L'ADDRESS COUNT ADDRESS BYTES @VA04250 00206000 TEST TM 0(R4),NUMZONE NUMERIC? @VA04250 00207000 BNO ADDNINE NO - FIX IT UP @VA04250 00208000 LA R4,ONE(R4) NEXT BYTE @VA04250 00209000 BCT R6,TEST IF NOT ALL DONE @VA04250 00210000 B ALLDONE @VA04250 00211000 ADDNINE MVC REGLOAD+LORD(ONE),0(R4) ADD A BINARY @VA04250 00212000 L R7,REGLOAD NINE TO ANY @VA04250 00213000 AH R7,NINE ALPHA DIGIT @VA04250 00214000 ST R7,REGLOAD PLUG IT BACK INTO ADDRESS @VA04250 00215000 MVC 0(ONE,R4),REGLOAD+LORD INTO ADDRESS @VA04250 00216000 LA R4,ONE(R4) GET NEXT BYTE @VA04250 00217000 BCT R6,TEST NEXT BYTE @VA04250 00218000 ALLDONE PACK DUMHEXAD(HEXL),ADDRESS(ADL) STRIP OFF ZONES @VA04250 00219000 SCROLL L R2,DUMHEXAD GET ADDRESS FOR GETREC @VA04250 00220000 CLI PCSW,INDIRECT INDIRECT REQ ? @VA04250 00221000 BE NOROUND YES - DONT ROUND IT OFF YET. @VA04250 00222000 LR R7,R2 WORK REG TO FIND ODD BYTES IN @VA04250 00223000 SLL R7,28 EXCESS OF 16 BYTE GROUPS TO ADD @VA04250 00224000 SRL R7,28 TO HEXCOUNT TO DISPLAY CORRECT @VA04250 00225000 A R7,HEXCOUNT NUMBER OF LINES. @VA04250 00226000 ST R7,HEXCOUNT SAVE THE CORRECTED COUNT @VA04250 00227000 SRL R2,4 ROUND ADDRESS TO A @VA04250 00228000 SLL R2,4 QUAD WORD BOUNDARY @VA04250 00229000 NOROUND SRL R2,2 ROUND TO WORD BOUND FOR INDIRECT @VA04250 00230000 SLL R2,2 AND RESTORE @VA04250 00231000 LR R7,R2 REAL DISPLAY ADDRESS @VA04250 00232000 L R15,GETADD GETREC TO @VA04250 00233000 BALR R14,R15 GO GET RECORD INTO CORE @VA04250 00234000 LTR R15,R15 HOW WAS IT? @VA04250 00235000 BZ INDIR OK @VA04250 00236000 ST R15,RETCODE SAVE THE RETURN @VA04250 00237000 B RETURN BACK TO DX @VA04250 00238000 INDIR CLI PCSW,INDIRECT INDIRECT REQUEST ? @VA04250 00239000 BNE DIRECT NO @VA04250 00240000 L R2,0(R2) YES, GO AROUND AGAIN. @VA04250 00241000 LA R2,0(R2) CLEAR HI ORD BYTE @VA04250 00242000 LR R7,R2 WORK REG @VA04250 00243000 SLL R7,28 COUNT ODD BYTES IN EXCESS OF 16 @VA04250 00244000 SRL R7,28 TO ADD TO COUNT TO DISPLAY @VA04250 00245000 A R7,HEXCOUNT CORRECT NUMBER OF LINES @VA04250 00246000 ST R7,HEXCOUNT SAVE THE UPDATED COUNT @VA04250 00247000 SRL R2,4 NOW ROUND REAL ADDR TO 4WD BOUND @VA04250 00248000 SLL R2,4 QUADWORD BOUNDARY @VA04250 00249000 ST R2,DUMHEXAD SAVE THE ADDRESS FOR SCROLL @VA04250 00250000 LR R7,R2 GET REAL ADDRESS FOR SCREEN. @VA04250 00251000 MVI PCSW,OFF TURN OFF INDIRECT SW. @VA04250 00252000 L R15,GETADD GET READY TO GO AGAIN. @VA04250 00253000 BALR R14,R15 GO @VA04250 00254000 LTR R15,R15 HOW WAS IT? @VA04250 00255000 BZ DIRECT OK @VA04250 00256000 ST R15,RETCODE SAVE BAD RETURN @VA04250 00257000 B RETURN BACK TO CALLER @VA04250 00258000 EJECT 00259000 * * * * * * * *-----------------------------------------* 00260000 * * * * * * * * NOW THE CORRECT RECORD IS IN CORE 00261000 * * * * * * * * THIS CODE FORMATS THE REQUIRED PORTION OF 00262000 * * * * * * * * THE DUMP WITH ADDRESSES 00263000 * * * * * * * *-----------------------------------------* 00264000 DIRECT L R8,PLISTADD GET PLIST ADRESS TO SEE IF @VA04250 00265000 CLC DISPLAY,0(R8) THIS COMMAND IS A DISPLAY @VA04250 00266000 BE ZEROHDR IF IT IS BYPASS THE CLEAR @VA04250 00267000 BAL R10,CLEAR IF NOT - CLEAR THE SCREEN @VA04250 00268000 ZEROHDR MVC HEADER,BLANKOUT NOW CLEAR THE HEADING LINE @VA04830 00269000 L R8,INPUTADD ADD OF INPUT TO WRITE HEADER @VA04250 00270000 MVC HEADER,0(R8) PLUG INPUT LINE IN HEADER @VA04250 00271000 LA R8,HEADER ADDRESS FOR WRITE @VA04250 00272000 LA R9,L'HEADER LENGTH @VA04250 00273000 BAL R10,WRTERM WRITE HEADER @VA04250 00274000 REDIRECT LR R9,R2 GET IN CORE ADDRESS @VA04250 00275000 L R2,BUFF1ADD GET PAGE LOWER BOUNDARY @VA04250 00276000 L R8,SCRNADD BEGINNING OF SCREEN @VA04250 00277000 STM R6,R9,CLEARSAV SAVE REGS THROUGH CLEAR @VA04250 00278000 L R6,SCRNADD START OF SCREEN @VA04250 00279000 LA R7,SCRNSIZE 1760 BYTES IN SCREEN @VA04250 00280000 LA R9,NULL PAD @VA04250 00281000 MVCL R6,R8 CLEAR SCREEN @VA04250 00282000 LM R6,R9,CLEARSAV RESTORE REGS @VA04250 00283000 LR R6,R9 GET FIRST LINE @VA04250 00284000 AH R6,ONETIRTY R6 NOW POINTS TO END OF SCREEN @VA04250 00285000 AH R2,ONEK R2 POINTS TO TOP OF PAGE @VA04250 00286000 CR R6,R2 IS TOP OF SCREEN OFF PAGE? @VA04250 00287000 BNH OFFPAGE NO @VA04250 00288000 LR R6,R2 YES - USE LOWER FIGURE @VA04250 00289000 OFFPAGE SH R2,ONEK RESTORE R2 @VA04250 00290000 OFFCOMP CR R2,R9 CURRENT LINE PTR OFF PAGE? @VA04250 00291000 BNH KEEPON NO - PRINT IT. @VA04250 00292000 LA R9,EBCL(R9) NEXT LINE ON PAGE @VA04250 00293000 LA R7,EBCL(R7) BUMP REAL ADDRESS BY 16 @VA04250 00294000 LA R8,LINEL(R8) NEXT LINE ON SCREEN @VA04250 00295000 B OFFCOMP GO CHECK NEXT LINE @VA04250 00296000 KEEPON LA R2,NULL SET TO COUNT TRANSLATED LINES @VA04250 00297000 TRANSLAT MVC TRANLINE+TDAT(L'TRANLINE-TDAT),0(R9) TRANS DATA @VA04250 00298000 ST R7,TRANLINE LOAD ADDRESS FOR TRANS @VA04250 00299000 LA R4,TRANLINE+ONE GET ADDRESS FOR TRANS @VA04250 00300000 LA R3,TRANINL 19 - LENGTH TO TRANSLATE @VA04250 00301000 L R15,INTADD GO DO IT @VA04250 00302000 BALR R14,R15 LINK @VA04250 00303000 LA R2,ONE(R2) COUNT TRANSLATED LINES @VA04250 00304000 LA R8,FOUR(R8) POINT TO ADDR AREA @VA04250 00305000 MVC 0(SIX,R8),0(R5) PLUG ADDRESS @VA04250 00306000 LA R5,SIX(R5) POINT TO DATA @VA04250 00307000 LA R3,FOUR COUNT SLOTS ON LINE @VA04250 00308000 LA R8,TEN(R8) MIDDLE OF SCREEN @VA04250 00309000 MOVEBLOK MVC 0(EIGHT,R8),0(R5) MOVE XLATED 8 BYTES TO SCREEN @VA04250 00310000 LA R8,TEN(R8) NEXT OUTPUT BLOCK @VA04250 00311000 LA R5,EIGHT(R5) NEXT INPUT BLOCK @VA04250 00312000 BCT R3,MOVEBLOK MOVE NEXT BLOK @VA04250 00313000 LA R8,TWO(R8) POINT TO EBCDIC AREA @VA04250 00314000 MVC 0(SIXTEEN,R8),0(R9) WRITE EBCDIC @VA04250 00315000 LA R8,TWENTYFO(R8) BUMP SCREEN LINE PTR @VA04250 00316000 CR R6,R9 OFF END OF SCREEN? @VA04250 00317000 BL SCRNFULL YES - GO WRITE IT @VA04250 00318000 LA R9,EBCL(R9) BUMP PAGELINE PTR @VA04250 00319000 LA R7,EBCL(R7) BUMP ADDRESS CTR @VA04250 00320000 B TRANSLAT GO CONVERT NEXT LINE TO EBCDIC @VA04250 00321000 EJECT 00322000 * * * * * * * *------- -------- -------- -------- ------* 00323000 * * * * * * * * NOW WRITE THE DATA 00324000 * * * * * * * * R2 HAS THE COUNT OF LINES TRANSLATED. 00325000 * * * * * * * * IF THIS GOES TO ZERO BEFORE THE BYTE COUNT 00326000 * * * * * * * * WE MUST GET THE NEXT PAGE AND FORMAT IT 00327000 * * * * * * * * THEN CONTINUE DISPLAYING . 00328000 * * * * * * * * ------- -------- -------- ------- * 00329000 SCRNFULL L R3,HEXCOUNT GET BYTES TO BE DISPLAYED @VA04250 00330000 L R8,SCRNADD WHERE TO DISPLAY EM. @VA04250 00331000 LA R5,LINES COUNT 20 LINES @VA04250 00332000 LA R6,EBCL COUNT 20 BYTES TO A LINE @VA04250 00333000 WRITE LA R9,SHRTLINE LENGTH OF SHORT LINE - 72 @VA04250 00334000 MVI TRTABLE,BLANK SET TRTABLE TO TRANS EBCDIC @VA04830 00335000 TR 0(SHRTLINE-SIXTEEN,R8),TRTABLE TRANSLATE EBCDIC @VA04830 00336000 MVI TRTABLE,PERIOD RESTORE TRTABLE @VA04830 00337000 TR HEXAREA(SIXTEEN,R8),TRTABLE REMOVE CTL CHARS @VA04250 00338000 BAL R10,WRTERM WRITE A FORMATTED LINE @VA04250 00339000 LA R8,LINEL(R8) NEXT OUTPUT LINE @VA04250 00340000 SR R3,R6 TAKE 1 LINE FROM COUNT @VA04250 00341000 BP COUNTIT KEEP GOING @VA04250 00342000 B SCROLSET ALL DONE - EXIT @VA04250 00343000 COUNTIT BCT R5,FORMCHEK GET NEXT LINE @VA04250 00344000 B NEXTSCRN GO DO ANOTHER SCREEN @VA04250 00345000 FORMCHEK BCT R2,WRITE STILL HAVE FORMATTED DATA @VA04250 00346000 * * * * * * * *------- -------- -------- -------- ------* 00347000 * * * * * * * * WE HAVE WRITTEN ALL THE DATA WE FORMATTED 00348000 * * * * * * * * BUT THE COUNT DID NOT GO TO ZERO. 00349000 * * * * * * * * THIS MEANS WE ARE AT THE END OF A 00350000 * * * * * * * * STORAGE PAGE. WE MUST GET THE LAST 00351000 * * * * * * * * ADDRESS WE WROTE TO THE SCREEN, TRANSLATE 00352000 * * * * * * * * IT BACK TO HEX, AND SEND IT BACK TO DIRECT. 00353000 * * * * * * * *------- -------- -------- -------- ------* 00354000 ST R3,HEXCOUNT SAVE THE CURRENT COUNT @VA04250 00355000 S R8,E76 BACK UP TO LAST SHOWN ADDRESS @VA04250 00356000 MVC LASTADD(ADDRL),0(R8) MOVE ADDRESS TO WORK AREA @VA04250 00357000 * * * * * * * *------- -------- -------- -------- ------* 00358000 * * * * * * * * NOW R4 POINTS TO THE LEFT BYTE OF THE 00359000 * * * * * * * * EBCDIC ADDRESS FIELD WHICH WILL BE TRANS- 00360000 * * * * * * * * LATED TO HEX TO BE PLUGGED FOR SCROLL. 00361000 * * * * * * * *------- -------- -------- -------- ------* 00362000 LTRAN LA R6,L'ADDRESS COUNT ADDRESS BYTES @VA04250 00363000 LA R4,LASTADD POINT TO WORK AREA @VA04250 00364000 LTEST TM 0(R4),NUMZONE NUMERIC? @VA04250 00365000 BNO LADDNINE NO - FIX IT UP @VA04250 00366000 LA R4,ONE(R4) NEXT BYTE @VA04250 00367000 BCT R6,LTEST IF NOT ALL DONE @VA04250 00368000 B LALLDONE @VA04250 00369000 LADDNINE MVC LREGLOAD+LORD(ONE),0(R4) ADD A BINARY @VA04250 00370000 L R7,LREGLOAD NINE TO ANY @VA04250 00371000 AH R7,NINE ALPHA DIGIT @VA04250 00372000 ST R7,LREGLOAD PLUG IT BACK @VA04250 00373000 MVC 0(ONE,R4),LREGLOAD+LORD INTO ADDRESS @VA04250 00374000 LA R4,ONE(R4) GET NEXT BYTE @VA04250 00375000 BCT R6,LTEST NEXT BYTE @VA04250 00376000 LALLDONE PACK HEXLAST(HEXL),LASTADD(LADL) STRIP OFF ZONES @VA04250 00377000 * * * * * * * *------- -------- -------- -------- ------* 00378000 * * * * * * * * NOW HEXLAST CONTAINS THE LAST ADDRESS 00379000 * * * * * * * * WE DISPLAYED. ADD X'10' TO IT, AND SET 00380000 * * * * * * * * UP R2 AND R7 FOR GETREC, AND SEND IT 00381000 * * * * * * * * BACK TO DIRECT. 00382000 * * * * * * * *------- -------- -------- -------- ------* 00383000 L R2,HEXLAST GET ADDRESS TO FETCH AND @VA04250 00384000 LA R2,EBCL(R2) BUMP TO NEXT DISPLAY ADDRESS @VA04250 00385000 ST R2,DUMHEXAD KEEP IT RIGHT FOR NEXT SCREEN @VA04250 00386000 LR R7,R2 ADDRESS TO BE DISPLAYED @VA04250 00387000 L R15,GETADD GO TO GET IT IN CORE @VA04250 00388000 BALR R14,R15 GO DO IT @VA04250 00389000 LTR R15,R15 CHECK IT @VA04250 00390000 BZ REDIRECT CONTINUE DISPLAY @VA04250 00391000 MVC RETCODE,CODE4 SEND THE BAD NEWS @VA04250 00392000 B RETURN @VA04250 00393000 EJECT 00394000 * * * * * * * *------- -------- -------- -------- ------* 00395000 * * * * * * * * NOW WE HAVE WRITTEN A SCREEN FULL. 00396000 * * * * * * * * ADD THE LENGTH OF A SCREEN TO THE 00397000 * * * * * * * * ORIGINAL ADDRESS AND GO AROUND AGAIN. 00398000 * * * * * * * * KEEP AT IT TILL R3 IS NO LONGER PLUS. 00399000 * * * * * * * *------- -------- -------- -------- ------* 00400000 NEXTSCRN ST R3,HEXCOUNT SAVE THE CURRENT COUNT @VA04250 00401000 L R7,DUMHEXAD GET THE OLD ADDRESS @VA04250 00402000 A R7,X140 BUMP IT UP A SCREENFULL @VA04250 00403000 ST R7,DUMHEXAD AND REPLACE IT @VA04250 00404000 LR R2,R7 SET UP FOR GETREC @VA04250 00405000 L R15,GETADD GO TO GET THE NEW ADDRESS IN @VA04250 00406000 BALR R14,R15 @VA04250 00407000 LTR R15,R15 TEST IT @VA04250 00408000 BZ REDIRECT OK - GO DISPLAY IT @VA04250 00409000 MVC RETCODE,CODE4 NOT SO GOOD @VA04250 00410000 B RETURN @VA04250 00411000 * * * * * * * *------- -------- -------- -------- ------* 00412000 * * * * * * * *THIS CLEARS THE SCREEN AND ALLOWS THE 00413000 * * * * * * * * NEXT OPERATION TO BE POSITIONED 00414000 * * * * * * * * AT THE TOP OF THE SCREEN 00415000 * * * * * * * *------- -------- -------- -------- ------* 00416000 CLEAR STM R8,R9,SAVCLR SAVE REGS @VA04250 00417000 L R11,PRINT1AD GET NO DISPLAY FLAG @V4075A2 00418000 CLI 0(R11),NOSUBC SUPPRESS DISPLAY ? @V4075A2 00419000 BE ALLCLEAR YES - DONT CLEAR SCREEN @V4075A2 00420000 L R8,SCRNADD GET THE ADDRESS OF THE SCREEN @VA04250 00421000 ST R8,CCWC PLUG ADDRESS IN CCW @VA04250 00422000 LA R8,CCWC CCW ADD @VA04250 00423000 L R9,CONSADD GET VIRT CONS ADDR LOCATION @VA04250 00424000 L R9,0(R9) GET VIRT CON CUU @VA04250 00425000 MVI CCWC,CMDCODE RESTORE CMD CODE @VA04250 00426000 MVI CCWCTL,ERASE SET ERASE BYTE @VA04250 00427000 WAITT WAIT FOR TERMINAL TO QUIESCE @VA04250 00428000 DC X'83890058' DIAGNOSE @VA04250 00429000 ALLCLEAR LM R8,R9,SAVCLR RESTORE REGS @V4075A2 00430000 BR R10 RETURN @VA04250 00431000 * * * * * * * *------- -------- -------- -------- ------* 00432000 * * * * * * * * SET UP AN ADDRESS TO BE PLUGGED FOR A 00433000 * * * * * * * * SUBSEQUENT SCROLL REQUEST. 00434000 * * * * * * * *------- -------- -------- -------- ------* 00435000 SCROLSET S R8,E76 BACK UP TO LAST SHOWN ADDRESS @VA04250 00436000 MVC SCROLADD(SIX),0(R8) MOVE ADDRESS TO WORK AREA @VA04250 00437000 * * * * * * * *------- -------- -------- -------- ------* 00438000 * * * * * * * * NOW R4 POINTS TO THE LEFT BYTE OF THE 00439000 * * * * * * * * EBCDIC ADDRESS FIELD WHICH WILL BE TRANS- 00440000 * * * * * * * * LATED TO HEX TO BE PLUGGED FOR SCROLL. 00441000 * * * * * * * *------- -------- -------- -------- ------* 00442000 STRAN LA R6,L'ADDRESS COUNT ADDRESS BYTES @VA04250 00443000 LA R4,SCROLADD POINT TO WORK AREA @VA04250 00444000 STEST TM 0(R4),NUMZONE NUMERIC? @VA04250 00445000 BNO SADDNINE NO - FIX IT UP @VA04250 00446000 LA R4,ONE(R4) NEXT BYTE @VA04250 00447000 BCT R6,STEST IF NOT ALL DONE @VA04250 00448000 B SALLDONE GOT EM ALL @VA04250 00449000 SADDNINE MVC SREGLOAD+LORD(ONE),0(R4) ADD A BINARY @VA04250 00450000 L R7,SREGLOAD NINE TO ANY @VA04250 00451000 AH R7,NINE ALPHA DIGIT @VA04250 00452000 ST R7,SREGLOAD PLUG IT BACK INTO COUNT @VA04250 00453000 MVC 0(ONE,R4),SREGLOAD+LORD INTO COUNT @VA04250 00454000 LA R4,ONE(R4) GET NEXT BYTE @VA04250 00455000 BCT R6,STEST NEXT BYTE @VA04250 00456000 SALLDONE PACK HEXSCROL(HEXL),SCROLADD(SCRADL) STRIP OFF ZONES @VA04250 00457000 MVI HEXSCROL,D FLAG IT AS A DUMP ADDRESS @VA04250 00458000 B RETURN BACK TO DSC @VA04250 00459000 EJECT 00460000 * * * * * * * * ------- -------- -------- ------- * 00461000 * * * * * * * * WRTERM ROUTINE 00462000 * * * * * * * * ------- -------- -------- ------- * 00463000 WRTERM ST R8,PARMLIS1 PUT REGS IN THE PARM LIST @V4075A2 00464000 ST R9,PARMLIS2 TO PASS TO DMMFEDLN @V4075A2 00465000 LA R1,PARMLIS1 SET POINTER @V4075A2 00466000 L R15,FEDLNADD DMMFEDLN @V4075A2 00467000 BALR R14,R15 GO WRITE THE LINE @V4075A2 00468000 BR R10 RETURN @V4075A2 00469000 PARMLIS1 DS F PARM1 @V4075A2 00470000 PARMLIS2 DS F PARM2 @V4075A2 00471000 FEDLNADD DC V(DMMFEDLN) LINE WRITER RTN @V4075A2 00472000 * * * * * * * *------- -------- -------- -------- ------* 00473000 * * * * * * * * RETURN 00474000 * * * * * * * *------- -------- -------- -------- ------* 00475000 RETURN L R13,SAVEBACK USERS SAVE @VA04250 00476000 MVC SAVEREG2(L'HEXSCROL,R13),HEXSCROL ADDR TO SCROLL@VA04250 00477000 MVC SAVREG15(L'RETCODE,R13),RETCODE RET CODE @VA04250 00478000 LM R14,R12,SAVEDISP(R13) USERS REGS @VA04250 00479000 BR R14 RETURN TO CALLER @VA04250 00480000 * * * * * * * *------- -------- -------- -------- ------* 00481000 * * * * * * * * CONSTANTS 00482000 * * * * * * * *------- -------- -------- -------- ------* 00483000 BLANKOUT DC CL80' ' BLANKS TO CLEAR HEADER @VA04830 00484000 PCSW DC X'00' DIRECT/INDIRECT REQUEST @VA04250 00485000 INDIRECT EQU X'FF' INDIRECT REQUEST ACTIVE @VA04250 00486000 * * * * * * * * ------- -------- -------- ------- * 00487000 CMDCODE EQU X'19' CMD CODE FOR DIAGNOSE CCW @VA04250 00488000 ERASE EQU X'FF' ERASE CONTROL BYTE FOR CCW @VA04250 00489000 * * * * * * * * ------- -------- -------- ------- * 00490000 * * * * * * * * STANDARDS CONSTANTS 00491000 * * * * * * * * ------- -------- -------- ------- * 00492000 NULL EQU X'00' CLEAR REG @VA04250 00493000 OFF EQU X'00' SWITCH 'OFF' STATE @VA04250 00494000 NUMZONE EQU X'F0' ZONE OF A NUMERIC CHAR @VA04250 00495000 ONE EQU 1 ONE BYTE LENGTH VALUE @VA04250 00496000 TWO EQU 2 TWO @VA04250 00497000 LORD EQU 3 DISP TO LO-ORDER BYTE OF REG LOAD@VA04250 00498000 FOUR EQU 4 FOUR @VA04250 00499000 TDAT EQU 4 LENGTH OF DATA TO TRANSLATE @VA04250 00500000 LOUT EQU 5 DISP TO LAST BYTE OF OUTPUT @VA04250 00501000 HEXL EQU 5 FIVE @VA04250 00502000 SIX EQU 6 SIX @VA04250 00503000 ADDRL EQU 6 LENGTH OF ADDRESS @VA04250 00504000 ADL EQU 7 SEVEN @VA04250 00505000 COUNTL EQU 7 SEVEN @VA04250 00506000 LADL EQU 7 SEVEN @VA04250 00507000 SCRADL EQU 7 SEVEN @VA04250 00508000 EIGHT EQU 8 EIGHT @VA04250 00509000 PLISTENT EQU 8 LENGTH OF A PLIST ENTRY @VA04250 00510000 TEN EQU 10 TEN @VA04250 00511000 SAVEDISP EQU 12 DISP INTO SAVAREA FOR REGS @VA04250 00512000 PL2L EQU 15 DISP TO END OF SECOND PLIST ENT @VA04250 00513000 PL3 EQU 16 DISP TO THIRD PLIST ENTRY @VA04250 00514000 SAVREG15 EQU 16 DISP INTO SAVEAREA FOR REG 15 @VA04250 00515000 DEFAULT EQU 16 DEFAULT COUNT @VA04250 00516000 SIXTEEN EQU 16 SIXTEEN @VA04250 00517000 EBCL EQU 16 LENGTH OF AN EBC LINE ON SCREEN @VA04250 00518000 TRANINL EQU 19 INPUT LENGTH TO TRANSLATE @VA04250 00519000 LINES EQU 20 NUMBER OF LINES TO A SCREEN @VA04250 00520000 INLEN EQU 21 INPUT LENGTH @VA04250 00521000 TWENTYFO EQU 24 TWENTYFOUR @VA04250 00522000 SAVEREG2 EQU 28 DISP INTO SAVEAREA FOR REG 2 @VA04250 00523000 HIBYTE EQU 24 BITS TO HI ORD BYTE @VA04830 00524000 SHRTLINE EQU 72 SHORT LINE @VA04250 00525000 HEXAREA EQU 56 DISP INTO LINE OF TRUE HEX @VA04250 00526000 LINEL EQU 80 LINE LENGTH @VA04250 00527000 SCRNSIZE EQU 1760 SIZE OF SCREEN @VA04250 00528000 * * * * * * * * ------- -------- -------- ------- * 00529000 * * * * * * * * TRANSLATE TABLE FOR WRITE 00530000 * * * * * * * * ------- -------- -------- ------- * 00531000 TRTABLE DS CL256 TRANSLATE TABLE @VA04250 00532000 ORG TRTABLE @VA04250 00533000 DC 64C'.' 64 UNPRINTABLE CHARACTERS @VA04250 00534000 DC C' ' DISPLAY BLANK AS BLANK @VA04250 00535000 DC 9C'.' 9 UNPRINTABLE CHARACTERS @VA04250 00536000 DC X'4A4B4C4D4E4F50' 7 '¢.<(+|&' @VA04250 00537000 DC 9C'.' 9 UNPRINTABLE CHARACTERS @VA04250 00538000 DC X'5A5B5C5D5E5F6061' 8 '!$*);¬-/' @VA04250 00539000 DC 9C'.' 9 UNPRINTABLE CHARACTERS @VA04250 00540000 DC X'6B6C6D6E6F' 5 ',%_>?' @VA04250 00541000 DC 10C'.' 10 UNPRINTABLE CHARACTERS @VA04250 00542000 DC X'7A7B7C7D7E7F' 6 ':#@'="' @VA04250 00543000 DC C'.' 1 UNPRINTABLE CHARACTER @VA04250 00544000 DC X'818283848586878889' 9 'ABCDEFGHI' LOWER CASE @VA04250 00545000 DC 7C'.' 7 UNPRINTABLE CHARACTERS @VA04250 00546000 DC X'919293949596979899' 9 'JKLMNOPQR' LOWER CASE @VA04250 00547000 DC 8C'.' 8 UNPRINTABLE CHARACTERS @VA04250 00548000 DC X'A2A3A4A5A6A7A8A9' 8 'STUVWXYZ' LOWER CASE @VA04250 00549000 DC 23C'.' 23 UNPRINTABLE CHARACTERS @VA04250 00550000 DC X'C1C2C3C4C5C6C7C8C9' 9 'ABCDEFGHI' UPPER @VA04250 00551000 DC 7C'.' 7 UNPRINTABLE CHARACTERS @VA04250 00552000 DC X'D1D2D3D4D5D6D7D8D9' 9 'JKLMNOPQR' UPPER @VA04250 00553000 DC 8C'.' 8 UNPRINTABLE CHARACTERS @VA04250 00554000 DC X'E2E3E4E5E6E7E8E9' 8 'STUVWXYZ' UPPER @VA04250 00555000 DC 6C'.' 6 UNPRINTABLE CHARACTERS @VA04250 00556000 DC X'F0F1F2F3F4F5F6F7F8F9' 10 '0123456789' @VA04250 00557000 DC 6C'.' 6 UNPRINTABLE CHARACTERS @VA04250 00558000 * * * * * * * * ------- -------- -------- ------- * 00559000 BLANK EQU X'40' PLIST CHECK @VA04250 00560000 PERIOD EQU X'4B' PERIOD FOR TRANS TABLE @VA04830 00561000 A EQU X'C1' VALIDITY CHECK @VA04250 00562000 F EQU X'C6' SAME @VA04250 00563000 ZERO EQU X'F0' SAME @VA04250 00564000 A9 EQU X'F9' SAME @VA04250 00565000 T EQU X'E3' 'T'XXXX IN DISPLAY REG @VA04250 00566000 PERCENT EQU X'6C' PERCENT IN INPUT @VA04250 00567000 D EQU X'C4' DISPLAY FLAG FOR SCROLL @VA04250 00568000 * * * * * * * * ------- -------- -------- ------- * 00569000 DISPLAY DC C'D' COMPARAND FOR A 'DISPLAY' @VA04250 00570000 E76 DC F'76' SEVENTYSIX BYTES @VA04250 00571000 CODE4 DC F'4' WARNING RET CODE @VA04250 00572000 RETCODE DS F RETCODE HOLD AREA @VA04250 00573000 WORKL EQU 72 LENGTH OF WORK AREA TO CLEAR @VA04250 00574000 PADADD DS H SPILL FOR ADDRESS @VA04250 00575000 ADDRESS DS CL6 WK AREA FOR INPUT ADDRESS @VA04250 00576000 LAPADD DS H SPILL FOR LAST ADDRESS @VA04250 00577000 LASTADD DS CL6 LAST DISPLAYED ADDRESS @VA04250 00578000 REGLOAD DS F WK AREA FOR HEX TRANSLATE @VA04250 00579000 CREGLOAD DS F SAME @VA04250 00580000 SREGLOAD DS F SAME @VA04250 00581000 LREGLOAD DS F SAME @VA04250 00582000 PLISTADD DS F SAVE AREA FOR PLIST PTR @VA04250 00583000 DUMHEXAD DS D LAST HEX ADD FED USED @VA04250 00584000 HEXSCROL DS D SCROLL ADDRESS IN HEX @VA04250 00585000 HEXLAST DS D LAST ADDRESS IN HEX @VA04250 00586000 HEXCOUNT DS D COUNT IN HEX. @VA04250 00587000 GETADD DC AL4(DMMGET) FETCH DUMP INTO CORE @VA04250 00588000 INTADD DC AL4(DMMINT) TRANSLATE ROUTINE @VA04250 00589000 SCRNADD DC AL4(SCRNAREA) DISPLAY AREA @VA04250 00590000 BUFF1ADD DC AL4(BUFF1) BUFFER OF DUMP IN CORE @VA04250 00591000 INPUTADD DC AL4(INPUT) READ IN AREA @VA04250 00592000 CONSADD DC AL4(CONSOLE) VIRT CONS ADDR @VA04250 00593000 PRINT1AD DC AL4(PRINTONE) @V4075A2 00594000 SAVFED DS 18F OUR SAVE AREA @VA04250 00595000 * * * * * * * * ------- -------- -------- ------- * 00596000 * * * * * * * * SAVEAREA 00597000 * * * * * * * * ------- -------- -------- ------- * 00598000 SAVEAREA DS 0F THIS PROGRAM'S SAVE AREA @VA04250 00599000 SAVEUSR DS F USER WORD @VA04250 00600000 SAVEFWD DS F FORWARD POINTER @VA04250 00601000 SAVEBACK DS F BACKWARD POINTER @VA04250 00602000 SAVER14 DS F SAVE AREA FOR CALLER'S R14 @VA04250 00603000 SAVER15 DS F SAVE AREA FOR CALLER'S R15 @VA04250 00604000 SAVER0 DS F SAVE AREA FOR CALLER'S R0 @VA04250 00605000 SAVER1 DS F SAVE AREA FOR CALLER'S R1 @VA04250 00606000 SAVER2 DS F SAVE AREA FOR CALLER'S R2 @VA04250 00607000 SAVER3 DS F SAVE AREA FOR CALLER'S R3 @VA04250 00608000 SAVER4 DS F SAVE AREA FOR CALLER'S R4 @VA04250 00609000 SAVER5 DS F SAVE AREA FOR CALLER'S R5 @VA04250 00610000 SAVER6 DS F SAVE AREA FOR CALLER'S R6 @VA04250 00611000 SAVER7 DS F SAVE AREA FOR CALLER'S R7 @VA04250 00612000 SAVER8 DS F SAVE AREA FOR CALLER'S R8 @VA04250 00613000 SAVER9 DS F SAVE AREA FOR CALLER'S R9 @VA04250 00614000 SAVER10 DS F SAVE AREA FOR CALLER'S R10 @VA04250 00615000 SAVER11 DS F SAVE AREA FOR CALLER'S R11 @VA04250 00616000 SAVER12 DS F SAVE AREA FOR CALLER'S R12 @VA04250 00617000 HEADER DS CL80 HEADER FOR OUTPUT @VA04250 00618000 * * * * * * * * ------- -------- -------- ------- * 00619000 * * * * * * * * MESSAGES 00620000 * * * * * * * * ------- -------- -------- ------- * 00621000 ERMSG702 DC C'DMMFED702I NON-HEX CHARACTER IN COUNT - RETRY' 00622000 ERMSG703 DC C'DMMFED703I NON-HEX CHARACTER IN ADDRESS - RETRY' 00623000 * * * * * * * * ------- -------- -------- ------- * 00624000 * * * * * * * * CONSTANTS FOR 'DIRECT' 00625000 * * * * * * * * ------- -------- -------- ------- * 00626000 CLEARSAV DS 4F SAVE REGS ACROSS CLEAR @VA04250 00627000 TRANLINE DS CL20 INPUT AREA FOR TRANSLATE @VA04250 00628000 FOXES DC XL4'FFFFFFFF' END OF PLIST @VA04250 00629000 NINE DC X'0009' MAKE AN ALPHA DIGIT PRINT @VA04250 00630000 ONEK DC X'0FE0' BUMP A PAGE @VA04250 00631000 CZEROS DC 6C'0' ZEROS @VA04250 00632000 COUNT DS CL6 COUNT WORKAREA @VA04250 00633000 SCROLADD DS CL6 SCROLL WORKAREA @VA04250 00634000 XF DC F'15' ROUND @VA04250 00635000 X140 DC XL4'140' ONE SCREEN @VA04250 00636000 ONETIRTY DC X'0130' ONE SCREEN @VA04250 00637000 * * * * * * * * ------- -------- -------- ------- * 00638000 * * * * * * * * 'CLEAR' CONSTANTS 00639000 * * * * * * * * ------- -------- -------- ------- * 00640000 CCWC CCW X'19',X'0',X'20',1760 ERASE CCW FOR DIAGNOSE @VA04250 00641000 CCWCTL EQU CCWC+5 CONTROL BYTE @VA04250 00642000 SAVCLR DS 2F SAVE FOR CLEAR SUBR. @VA04250 00643000 * * * * * * * * ------- -------- -------- ------- * 00644000 PATCH DC 50F'0' PATCH AREA @VA04250 00645000 LTORG @VA04250 00646000 DMMFEDLN CSECT @V4075A2 00647000 STM R14,R12,SAVEDISP(R13) SAVE CALLERS REGS @V4075A2 00648000 LR R12,R15 ADDRESSABILITY @V4075A2 00649000 USING DMMFEDLN,R12 @V4075A2 00650000 ST R13,LINEBACK CALLERS SAVE AREA @V4075A2 00651000 LA R13,SAVELINE HEX SAVEAREA @V4075A2 00652000 XC PRETCODE,PRETCODE CLEAR RETURN CODE @V4075A2 00653000 L R11,PRTONEAD GET NO DISPLAY FLAG @V4075A2 00654000 CLI 0(R11),NOSUBC SUPPRESS DISPLAY ? @V4075A2 00655000 BE PRINTEST YES - DONT WRITE IT @V4075A2 00656000 WAITT @V4075A2 00657000 WRITER WRTERM (R8),(R9) WRITE THE LINE TO THE SCREEN. @V4075A2 00658000 PRINTEST L R2,PRTSWADD PRINT STATUS SW @V4075A2 00659000 CLI 0(R2),ON SHOULD WE PRINT THIS TOO ? @V4075A2 00660000 BNE RETURNER NO @V4075A2 00661000 ************************************************************ @V4075A2 00662000 * SINCE PRINT IS ON WE WILL WRITE THIS TO '00E' @V4075A2 00663000 ************************************************************ @V4075A2 00664000 MVI PRINTLIN,BLANK SET UP TO CLEAR PRINT LINE @V4075A2 00665000 MVC PRINTLIN+ONE(L'PRINTLIN-ONE),PRINTLIN AND SET TO BLANKS 00666000 BCTR R9,R0 CORRECT FOR MACH LANG COUNT @V4075A2 00667000 LA R4,L'PRINTLIN-ONE GET 79 @V4075A2 00668000 CR R9,R4 DONT WANT TO MOVE IN OVER 80 B. @V4075A2 00669000 BNH MOVEX OK - GO MOVE IT @V4075A2 00670000 LR R9,R4 SET TO MOVE 80 BYTES @V4075A2 00671000 MOVEX EX R9,MOVEPRTL GET THE LINE @V4075A2 00672000 LA R2,CARRCTRL POINT TO THE CARRAIGE CONTROL @V4075A2 00673000 PRINTL (R2),81,ERROR=PRINTERR WRITE TO VIRTUAL PRINTER 00674000 RETURNER L R13,LINEBACK GET CALLER'S LINESAVE POINTER @V4075A2 00675000 MVC LINER15,PRETCODE PASS BACK THE CODE @V4075A2 00676000 LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @V4075A2 00677000 BR R14 RETURN TO CALLER @V4075A2 00678000 MOVEPRTL MVC PRINTLIN(0),0(R8) MOVE THE WRTERM DATA TO PRINT LINE 00679000 ************************************************************ @V4075A2 00680000 * THIS HANDLES NON ZERO RETURNS FROM PRINTL @V4075A2 00681000 ************************************************************ @V4075A2 00682000 PRINTERR ST R15,PRTERRCD SAVE THE CODE @V4075A2 00683000 LR R2,R15 GET IT TO CHECK IT @V4075A2 00684000 C R2,CHAN2 CARRIAGE TAPE ? @V4075A2 00685000 BE RETURNER YES - OK TO IGNORE @V4075A2 00686000 C R2,CHAN3 CARRIAGE CONTROL ? @V4075A2 00687000 BE RETURNER @V4075A2 00688000 LINEDIT TEXT='DMMFED500I ERROR ... IN THE PRINTL MACRO',SUB=(HX00689000 EX,(2)) TEXT OF PRINT ERR MSG @V4075A2 00690000 MVC PRETCODE,COD4 SET WARNING CODE AND RETURN @V4075A2 00691000 ************************************************************ @V4075A2 00692000 * CONSTANTS @V4075A2 00693000 ************************************************************ @V4075A2 00694000 ON EQU X'FF' SWITCH STATUS @V4075A2 00695000 CARRCTRL DC C' ' CARRIAGE CONTROL CHAR @V4075A2 00696000 PRINTLIN DS CL80 PRINTED TEXT * DO NOT SEPARATE @V4075A2 00697000 CHAN2 DC F'2' CHANNEL 2 @V4075A2 00698000 CHAN3 DC F'3' CHANNEL 3 FROM CARR TAPE @V4075A2 00699000 PRTERRCD DS F PRETCODE FROM PRINTL @V4075A2 00700000 NOSUBC EQU X'0F' NO-DISPLAY FLAG @V4075A2 00701000 PRTONEAD DC AL4(PRINTONE) ONE-SHOT SW @V4075A2 00702000 PRTSWADD DC AL4(PRINTSW) ADDRESS OF PRINT SW IN DMMDSC @V4075A2 00703000 PRETCODE DS F RETURN TO CALLER @V4075A2 00704000 COD4 DC F'4' WARNING RETCODE @V4075A2 00705000 ***************************************************************@V4075A2 00706000 * CONSTANTS, LINESAVES, AND EQUATES @V4075A2 00707000 ***************************************************************@V4075A2 00708000 SAVELINE DS 0F THIS PROGRAM'S SAVE AREA @V4075A2 00709000 LINEUSR DS F USER WORD @V4075A2 00710000 LINEFWD DS F FORWARD POINTER @V4075A2 00711000 LINEBACK DS F BACKWARD POINTER @V4075A2 00712000 LINER14 DS F SAVE AREA FOR CALLER'S R14 @V4075A2 00713000 LINER15 DS F SAVE AREA FOR CALLER'S R15 @V4075A2 00714000 LINER0 DS F SAVE AREA FOR CALLER'S R0 @V4075A2 00715000 LINER1 DS F SAVE AREA FOR CALLER'S R1 @V4075A2 00716000 LINER2 DS F SAVE AREA FOR CALLER'S R2 @V4075A2 00717000 LINER3 DS F SAVE AREA FOR CALLER'S R3 @V4075A2 00718000 LINER4 DS F SAVE AREA FOR CALLER'S R4 @V4075A2 00719000 LINER5 DS F SAVE AREA FOR CALLER'S R5 @V4075A2 00720000 LINER6 DS F SAVE AREA FOR CALLER'S R6 @V4075A2 00721000 LINER7 DS F SAVE AREA FOR CALLER'S R7 @V4075A2 00722000 LINER8 DS F SAVE AREA FOR CALLER'S R8 @V4075A2 00723000 LINER9 DS F SAVE AREA FOR CALLER'S R9 @V4075A2 00724000 LINER10 DS F SAVE AREA FOR CALLER'S R10 @V4075A2 00725000 LINER11 DS F SAVE AREA FOR CALLER'S R11 @V4075A2 00726000 LINER12 DS F SAVE AREA FOR CALLER'S R12 @V4075A2 00727000 * * * * * * * * ------- -------- -------- ------- *************@V4075A2 00728000 LTORG @V4075A2 00729000 EJECT 00730000 REGEQU @VA04250 00731000 END 00732000