ibm:vm370-lib:dumpscan:dmmfed.assemble_src
Table of Contents
DMMFED Source
References
- Fixes Applied : 0
- This Source Date : Monday, December 11, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMMFED.ASSEMBLE.txt
- 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
ibm/vm370-lib/dumpscan/dmmfed.assemble_src.txt ยท Last modified: 2023/08/06 13:37 by Site Administrator