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