         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      DUMP                                                          
         DEF      DEXIT                                                         
         DEF      DFGDBAL,DFGD,DFGDX                                            
OLAYFLAG EQU      'DUMP'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '***** DUMP *****'                                            
*        DUMP CONTROL BLOCK FIELD DISPLACEMENTS                                 
*        WORD INDEX (WX) OR BYTE INDEX (BX)                                     
WXDCB    EQU      2                 WX TO DCB POINTER                           
WXFWA    EQU      3                 WX TO FIRST WORD TO DUMP                    
WXCWA    EQU      3                 CURRENT WORD IS UPDATED FWA                 
WXLWA    EQU      4                 WX TO LWA TO DUMP                           
WXBAD    EQU      5                 WX TO BUFFER-ADDRESS DISPLACEMENT           
*        CONTENTS OF THIS CELL ADDED TO CORE ADDRESS BEFORE                     
*        PRINTING AS DUMP ADDRESS.  ALLOWS BUFFERED DUMP OF                     
*        MEMORY, FILE, REGISTERS, ETC.                                          
WXBAL    EQU      6                 ADDRESS OF POST-WRITE ROUTINE               
BXFLAGS  EQU      4*7               BX TO FLAG BYTE                             
*        FLAGS ARE DESCRIBED IN 'FL...' EQUS                                    
BXLNP    EQU      4*7+3             BX TO LINE NR IN PAGE                       
WXFPT    EQU      8                 WX TO SPACE FOR WRITE FPT                   
WXBUF    EQU      14                WX TO LINE OUTPUT BUFFER                    
WXTEMP   EQU      46                WX TO SCRATCH CELL                          
WXSTK    EQU      47                WX TO START OF RETURN POINTER STACK         
WXESTK   EQU      53                WX TO END OF STACK                          
WXRES    EQU      54                RESERVED FOR CALLER'S USE                   
WXEND    EQU      64                WX TO END OF BLOCK +1                       
*        INDEXES FOR FPT FIELDS                                                 
WXFLGFPT EQU      1                                                             
WXERAFPT EQU      2                                                             
WXABAFPT EQU      3                                                             
WXBUFFPT EQU      4                                                             
WXSIZFPT EQU      5                                                             
*        MASKS FOR FLAGS IN FLAG BYTE OF CONTROL BLOCK                          
MEBC     EQU      1**7              SET IF HEX/EBCDIC DUMP                      
*                                   RESET IF HEX ONLY                           
M4WD     EQU      1**6              SET IF 4 WD/LINE DUMP                       
*                                   RESET IF 8 WD/LINE                          
MFFK     EQU      1**5              SET TO FORCE FORMAT KEY PRINT               
*                                   RESET TO PRINT ONLY AT TOP OF FORM          
MEOP     EQU      1**4              SET TO BREAK AT EITHER LWA                  
*                                   OR END OF MEMORY PAGE                       
*                                   RESET FOR BREAK AT LWA ONLY                 
MVIRT    EQU      MEOP              SET IF VIRTUAL MEMORY DUMP                  
*                                   RESET IF NOT                                
*        BYTE INDEXES FOR BUILDING A DUMP LINE                                  
*        FIRST FOR 8-WORD LINE, THEN FOR 4-WORD LINE                            
BXEND8   EQU      127               END OF LINE + 1                             
BXEND4   EQU      69                                                            
BXEBC8   EQU      88                START OF EBCDIC DUMP FIELD                  
BXEBC4   EQU      50                                                            
BXEHEX8  EQU      85                END OF HEX DUMP FIELD + 1                   
BXEHEX4  EQU      47                                                            
BXHEXBK8 EQU      48                BREAK IN HEX DUMP LINE                      
*                                   NOT USED IN 4-WORD LINE                     
BXHEX    EQU      12                START OF HEX DUMP FIELD                     
BXADDR   EQU      2                 START OF DUMP ADDRESS FIELD                 
*        MORE BYTE INDEXES FOR DUMP LINES (INDEPENDENT OF WDS/LINE)             
*        LINE FOR CONTIGUOUS EQUAL VALUE WORDS                                  
BXCEVF   EQU      16                FIRST OCCURRENCE OF VALUE                   
BXCEVL   EQU      28                LAST OCCURRENCE OF VALUE                    
BXCEVHEX EQU      37                HEX VALUE                                   
BXCEVEBC EQU      47                EBCDIC VALUE                                
*        LINE FOR NEW VIRTUAL PAGE                                              
BXVA     EQU      9                 VIRTUAL ADDRESS                             
BXRA     EQU      22                REAL ADDRESS                                
BXAC     EQU      37                ACCESS                                      
*        FORMAT CONTROL CODES                                                   
FCCTOF   EQU      X'F1'             TOP OF FORM                                 
FCCBOF   EQU      X'F0'             BOTTOM OF FORM                              
FCCDS    EQU      X'C1'             DOUBLE SPACE                                
*        FPT CODES                                                              
OPENC    EQU      X'14'                                                         
WRITEC   EQU      X'11'                                                         
CLOSEC   EQU      X'15'                                                         
*        THE FOLLOWING COMPRESSED STRING FORMAT HAS BEEN USED                   
*        TO REDUCE THE SPACE REQUIRED FOR SAMPLE LINES:                         
*                                                                               
*        TEXT ITEMS FOLLOW CONTROL BYTES. SUPPOSE CONTROL BYTE                  
*        VALUE 'N' IS FOUND.  IF                                                
*        N<0      THEN N COPIES OF THE NEXT BYTE ARE TAKEN.                     
*        N>0      THEN THE NEXT N BYTES FROM THE SAMPLE ARE TAKEN.              
*        N=0      THEN THE END OF THE SAMPLE HAS BEEN REACHED.                  
*                                                                               
*        THE FOLLOWING PROCEDURE HELPS GENERATE COMPRESSED TEXT                 
*        AF(I) MAY BE:                                                          
*        A TEXT STRING (16 OR FEWER BYTES), TO BE INSERTED;                     
*        (N,'C') FOR A CHARACTER TO BE INSERTED FOR N REPETITIONS;              
*        0, FOR END OF SAMPLE                                                   
*                                                                               
COMPRESS CNAME                                                                  
         PROC                                                                   
         LOCAL    I                                                             
I        DO       NUM(AF)                                                       
         DO       NUM(AF(I))=1                                                  
         DO       S:NUMC(AF(I))=0                                               
         DATA,1   AF(I)                                                         
         ELSE     S:NUMC(AF(I))=0                                               
         DATA,1   S:NUMC(AF(I))                                                 
         DATA,S:NUMC(AF(I))  AF(I)                                              
         FIN      S:NUMC(AF(I))=0                                               
         ELSE     NUM(AF(I))=1                                                  
         DATA,1   -AF(I,1)                                                      
         DATA,1   AF(I,2)                                                       
         FIN      NUM(AF(I))                                                    
         FIN      NUM(AF)                                                       
         PEND                                                                   
*                                                                               
*        COMPRESSED HEADER TEXT                                                 
BLANKS1  RES,1    0                 LINE OF BLANKS                              
         COMPRESS (80,' '),(48,' '),0                                           
FMTKEY8  RES,1    0                 FORMAT KEY, FOR 8 WD LINE                   
         COMPRESS '  ADDRESS',(5,' '),'0/8',(6,' '),'1/9',(6,' ')               
         COMPRESS '2/A',(6,' '),'3/B',(8,' '),'4/C',(6,' ')                     
         COMPRESS '5/D',(6,' '),'6/E',(6,' '),'7/F',(46,' '),0                  
FMTKEY4  RES,1    0                 FORMAT KEY, FOR 4 WD LINE                   
         DATA,1   48                                                            
         DATA,12  '  ADDRESS   '                                                
         DATA,9   ' 0/4/8/C ',' 1/5/9/D '                                       
         DATA,9   ' 2/6/A/E ',' 3/7/B/F '                                       
         COMPRESS (80,' '),0                                                    
CEVW     RES,1    0                 CONTIGUOUS EQUAL VALUE WORDS                
         COMPRESS (23,' '),'THRU',(7,' '),':',(11,' '),'('                      
         COMPRESS (4,' '),')',(76,' '),0                                        
MEMPAGE  RES,1    0                 NEW VIRTUAL PAGE HEADER                     
         COMPRESS 'AVIRTUAL',(7,' ')                                            
         COMPRESS '; REAL',(7,' '),'; ACCESS',(92,' '),0                        
         BOUND    4                                                             
*        SPECIAL CHARACTER SET FOR HEX-EBCDIC CONVERSION                        
SCSS     TEXT     '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'                        
         TEXT     ' .(+&%*);-/,%:#@''=><'                                       
         DATA     X'4A4F5A5F',X'6A6D6F7F'                                       
SCSE     EQU      %                                                             
*        FPT FLAG WORDS                                                         
OFPTF    DATA     X'C0000010'       ERA+ABA+WAIT                                
WFPTF    DATA     X'F0000010'       ERA+ABA+BUF+SIZ+WAIT                        
CFPTF    DATA     X'11'             WAIT+OVR                                    
*                                                                               
RSZTBL   GEN,8,8,8,8  BXEHEX8,64,BXEND8,BXEND4                                  
         TITLE    '***** DUMP SUBROUTINE:  INSERT *****'                        
*                                                                               
*        CALL:    BAL,R8   INSERT                                               
*        PURPOSE: INSERT CHARACTERS INTO THE LINE BUFFER AS                     
*                 DIRECTED BY A COMPRESSED SOURCE STRING                        
*        INPUT:   (R5)=BX OF DESTINATION IN LINE BUFFER                         
*                 (R6)=BA OF START OF COMPRESSED STRING                         
*                 (R7)=WA OF START OF DUMP CONTROL BLOCK                        
*                                                                               
INSERT   RES      0                                                             
         LW,R4    R7                                                            
         AI,R4    WXBUF             WA OF LINE BUFFER                           
INEXT    LB,R3    0,R6              CONTROL BYTE                                
         BEZ      *R8                                                           
         SCS,R3   -8                                                            
         SAS,R3   -24               EXTEND SIGN                                 
         AI,R6    1                 BA OF NEXT SOURCE BYTE                      
IMVSTR   RES      0                 LOOP TO MOVE STRING                         
         LB,R2    0,R6              CURRENT SOURCE BYTE                         
         AI,R6    1                 BA OF NEXT SOURCE BYTE                      
IRPTCH   RES      0                 LOOP TO REPEAT A CHARACTER                  
         STB,R2   *R4,R5            INSERT BYTE INTO LINE BUF                   
         AI,R5    1                 BX TO NEXT BYTE IN LINE BUF                 
         LW,R3    R3                                                            
         BLZ      %+3               B IF REPEAT OF A SINGLE CHAR                
         BDR,R3   IMVSTR            B TO MOVE NEXT CHAR                         
         B        INEXT             B TO GET NEXT CONTROL BYTE                  
         BIR,R3   IRPTCH            B TO REPEAT THE CHAR                        
         B        INEXT             B TO GET NEXT CONTROL BYTE                  
         TITLE    '***** DUMP SUBROUTINE: CVTHEX *****'                         
*                                                                               
*        CALL:    BAL,R8  CVTHEX                                                
*        PURPOSE: CONVERT A ONE-WORD VALUE FOR HEX DUMP                         
*                 BY GENERATING EBCDIC FOR ITS HEX VALUE                        
*        INPUT:   (R9)=VALUE TO CONVERT                                         
*        OUTPUT:  (R10,11)=EBCDIC REPRESENTATION OF INPUT (R9)                  
*                                                                               
CVTHEX   RES      0                                                             
         PSW,R8   *R7                                                           
         LI,R1    -8                                                            
CHLOOP   LI,R8    '0'**-4                                                       
         SLD,R8   4                                                             
         CI,R8    '9'                                                           
         BLE      %+2                                                           
         AI,R8    'A'-'9'-1                                                     
         STB,R8   R10+2,R1                                                      
         BIR,R1   CHLOOP                                                        
         PLW,R8   *R7                                                           
         B        *R8                                                           
         TITLE    '***** DUMP SUBROUTINE:  CVTEBC *****'                        
*                                                                               
*        CALL:    BAL,R8  CVTEBC                                                
*        PURPOSE: CONVERT A ONE-WORD VALUE FOR EBCDIC DUMP BY                   
*                 REPLACING UNPRINTABLE CHARACTERS WITH PERIODS                 
*        INPUT:   (R9)=VALUE TO BE CONVERTED                                    
*        OUTPUT:  (R10)=CONVERTED VALUE OF INPUT (R9)                           
*                                                                               
CVTEBC   RES      0                                                             
         LI,R1    -4                                                            
CELOOP1  LB,R2    R9+1,R1           GET NEXT BYTE                               
         LI,R3    BA(SCSS)-BA(SCSE)                                             
CELOOP2  CB,R2    SCSE,R3                                                       
         BE       CENEXT            B IF PRINTABLE SPECIAL CHAR                 
         BIR,R3   CELOOP2           CHECK AGAINST NEXT SPECIAL CHAR             
         LI,R2    '.'               REPLACE WITH PERIOD                         
CENEXT   STB,R2   R10+1,R1          INSERT CHARACTER OR '.'                     
         BIR,R1   CELOOP1           CHECK NEXT CHARACTER                        
         B        *R8               RETURN                                      
         TITLE    '***** DUMP SUBROUTINE:  PRINT *****'                         
*                                                                               
*        CALL:    BAL,R8  PRINT                                                 
*        PURPOSE: PRINT THE CONTENTS OF THE LINE BUFFER AND                     
*                 ADJUST THE LINE-IN-PAGE COUNTER                               
*        INPUT:   (R7)=WA OF DUMP CONTROL BLOCK                                 
*        RETURN:  NORMAL:  CALL+2                                               
*                 ABNORMAL:  CALL+1, WITH R8 AND R10 AS SET BY                  
*                            I/O CAL                                            
*                                                                               
PRINTD   RES      0                                                             
         PSW,R8   *R7                                                           
         LI,R1    4*WXBUF           BX TO LINE BUF IN CONTROL BLOCK             
         LB,R10   *R7,R1            GET FORMAT BYTE                             
         LI,R2    BXLNP                                                         
         LB,R11   *R7,R2            NEXT LINE NR IN PAGE                        
         CI,R10   X'F1'                                                         
         BNE      PR1               B IF NOT A TOP OF FORM COMMAND              
         LI,R11   0                 TOP OF FORM LINE NR                         
         B        PR3               BRANCH TO PRINT                             
PR1      LI,R12   X'F'              ANY FORMAT CONTROL OTHER THAN               
         AND,R10  R12               TOF IS ASSUMED TO BE X'CY'                  
         AW,R11   R10               ADD EXTRA SPACES TO LINE IN PAGE            
         CB,R11   K:PAGE                                                        
         BL       PR2               B IF NOT PAST END OF PAGE                   
         LI,R11   0                 PRINT AT TOP OF FORM                        
         LI,R10   X'F1'             TOF FORMAT CONTROL BYTE                     
         STB,R10  *R7,R1            INSERT IN PRINT LINE                        
         B        PR3               B TO PRINT                                  
PR2      AI,R10   X'C0'             UPSPACE N LINES CONTROL BYTE                
         STB,R10  *R7,R1            INSERT IN PRINT LINE                        
PR3      LI,R0    PR4               ERROR RETURN                                
         LI,R10   0                 FLAG:  NO IO ERROR                          
         CAL1,1   WXFPT,R7          WRITE THRU DUMP FPT                         
PR4      AI,R11   1                 INCREMENT LINE COUNT                        
         STB,R11  *R7,R2            SAVE LINE IN PAGE COUNT                     
         LW,R9    WXBAL,R7          BAL ADDRESS                                 
         BEZ      %+2               B IF NOT SPECIFIED                          
         BAL,R9   *R9               USE IT                                      
         PLW,R9   *R7                                                           
         MTW,0    R10                                                           
         BNEZ     %+2               B IF IO ERROR                               
         AI,R9    1                                                             
         B        *R9               RETURN TO CALL + 2                          
         TITLE    '***** DUMP SUBROUTINE:  CVTWRD *****'                        
*                                                                               
*        CALL:    BAL,R8  CVTWRD                                                
*        PURPOSE: TO PREPARE THE DUMP OF ONE WORD OF MEMORY                     
*        INPUT:   (R7)=WA OF DUMP CONTROL BLOCK                                 
*                                                                               
CVTWRD   RES      0                                                             
         PSW,R8   *R7                                                           
         LW,R9    WXCWA,R7          CURRENT WORD ADDRESS                        
         LW,R9    *R9               CURRENT WORD CONTENT                        
         BAL,R8   CVTHEX            (R10,11)=EBCDIC FOR HEX VALUE               
         BAL,R8   CWWRDNR           GET WORD-IN-LINE NR                         
         MI,R5    9                 WORD-IN-LINE NR TIMES BYTES/WORD            
         AI,R5    BXHEX             ADD START OF HEX FIELD                      
         CI,R5    BXHEXBK8          POSITION TO INSERT EXTRA SPACES             
         BL       %+2               B IF NOT THERE YET                          
         AI,R5    2                 INSERT EXTRA SPACES                         
*        (R5) IS NOW POSITION TO INSERT HEX DUMP OF WORD                        
         LI,R9    8                 BYTE COUNT TO INSERT (R10,11)               
         LI,R12   0                 TERMINATES INSERTION                        
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         BAL,R8   INSERT            INSERT HEX DUMP IN LINE                     
         LI,R1    BXFLAGS                                                       
         LB,R2    *R7,R1            FLAG BYTE                                   
         CI,R2    MEBC                                                          
         BAZ      CWEXIT            BRANCH IF NO EBCDIC DUMP                    
         LW,R9    WXCWA,R7          CWA                                         
         LW,R9    *R9               CONTENTS OF CWA                             
         BAL,R8   CVTEBC            (R10)=PRINTABLE EBCDIC                      
         BAL,R8   CWWRDNR           GET WORD-IN-LINE NR AND FLAGS               
         MI,R5    5                 WORD-IN-LINE TIMES BYTES/WORD               
         AI,R5    BXEBC8            START OF EBCDIC DUMP FIELD                  
         CI,R1    M4WD                                                          
         BAZ      %+2               B IF 8-WORD/LINE DUMP                       
         AI,R5    BXEBC4-BXEBC8     ADJUST FOR 4-WORD LINE                      
*        (R5) IS NOW POSITION TO INSERT EBCDIC DUMP OF WORD                     
         LI,R9    4                 BYTE COUNT TO INSERT (R10)                  
         LI,R11   0                 TERMINATES INSERTION                        
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         BAL,R8   INSERT            INSERT EBCDIC DUMP                          
CWEXIT   MTW,1    WXCWA,R7          INCREMENT CWA                               
         PLW,R8   *R7                                                           
         B        *R8                                                           
*        THE FOLLOWING CODE IS A SUBROUTINE USED ONLY BY CVTWRD.                
*        IT RETURNS THE CURRENT WORD'S WORD NR IN THE LINE IN R5,               
*        AND THE FLAG BYTE IN R1.                                               
*        (R10,11) IS UNCHANGED                                                  
CWWRDNR  RES      0                 CONVERT WORD WORD NUMBER                    
         LW,R5    WXCWA,R7          CWA                                         
         AW,R5    WXBAD,R7          BUFFER-ADDRESS DISPLACEMENT                 
         LI,R1    BXFLAGS                                                       
         LB,R1    *R7,R1            FLAG BYTE                                   
         LI,R2    8                 GUESS 8 WORDS PER LINE                      
         CI,R1    M4WD                                                          
         BAZ      %+2               B IF 8 WDS/LINE                             
         LI,R2    4                 4 WORDS PER LINE                            
         LI,R4    0                                                             
         DW,R4    R2                                                            
         LW,R5    R4                WORD NR IN LINE                             
         B        *R8               RETURN                                      
         TITLE    '***** DUMP SUBROUTINE:  CVTLIN *****'                        
*                                                                               
*        CALL:    BAL,R8  CVTLIN                                                
*        PURPOSE: CONVERT AND OUTPUT ONE LINE OF A DUMP                         
*        INPUT:   (R7)=WA OF DUMP CONTROL BLOCK                                 
*        RETURN:  NORMAL:  CALL+2                                               
*                 ERROR:  CALL+1, WITH (R8) AND (R9) AS RETURNED                
*                         BY WRITE CAL                                          
*                                                                               
CVTLIN   RES      0                 CONVERT A LINE                              
         PSW,R8   *R7                                                           
         LI,R5    0                                                             
         LI,R6    BA(BLANKS1)                                                   
         BAL,R8   INSERT            BLANK THE BUFFER                            
         LW,R9    WXCWA,R7          CURRENT WORD ADDRESS                        
         AW,R9    WXBAD,R7          BUFFER-ADDRESS DISPLACEMENT                 
*        CWA + BAD = PRINTED ADDRESS                                            
         LI,R2    8                 8 WORDS/LINE                                
         LI,R1    BXFLAGS                                                       
         LB,R1    *R7,R1            FLAG BYTE                                   
         CI,R1    M4WD                                                          
         BAZ      %+2               B IF REALLY 8 WORDS/LINE                    
         LI,R2    4                 4 WORDS/LINE                                
         DW,R9    R2                TRUNCATE ADDRESS TO A                       
         MW,R9    R2                MULTIPLE OF WORDS PER LINE                  
         BAL,R8   CVTHEX            (R10,11)= EBCDIC FOR ADDRESS                
         LI,R5    BXADDR                                                        
         LI,R9    6                 NR BYTES TO INSERT                          
         SLD,R10  16                                                            
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         BAL,R8   INSERT                                                        
CLLOOP   BAL,R8   CVTWRD            DUMP CURRENT WORD INTO LINE BUF             
         LW,R9    WXCWA,R7          GET NEW CURRENT WORD ADDRESS                
         CW,R9    WXLWA,R7          COMPARE WITH LAST WORD ADDRESS              
         BG       CLPRINT           B IF CWA > LWA                              
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAGS                                   
         CI,R8    MEOP                                                          
         BAZ      %+3               B IF NO BREAK AFTER END OF PAGE             
         CI,R9    X'1FF'                                                        
         BAZ      CLPRINT           B IF START OF NEW MEMORY PAGE               
         AW,R9    WXBAD,R7          ADD BUFFER-ADDRESS DISPLACEMENT             
         LI,R2    7                 NEXT-LINE TEST, 8 WDS/LINE                  
         CI,R8    M4WD                                                          
         BAZ      %+2               B IF DUMPING 8 WDS/LINE                     
         LI,R2    3                 NEXT-LINE TEST, 4 WDS/LINE                  
         CW,R2    R9                                                            
         BANZ     CLLOOP            B IF NOT AT START OF NEW LINE               
CLPRINT  BAL,R8   PRINTD            PRINT THE LINE JUST COMPLETED               
         B        CLEREX            ERROR RETURN                                
         PLW,R8   *R7               NORMAL RETURN                               
         MTW,1    R8                                                            
         B        *R8                                                           
CLEREX   PLW,R9   *R7                                                           
         B        *R9                                                           
         TITLE    '***** DUMP SUBROUTINE:  CVTMEM *****'                        
*                                                                               
*        CALL:    BAL,R8  CVTMEM                                                
*        PURPOSE: TO DUMP THE AREA OF MEMORY DETERMINED BY THE                  
*                 CURRENT WORD ADDRESS AND LAST WORD ADDRESS IN                 
*                 THE DUMP CONTROL BLOCK, WITH OPTIONAL BREAK AT                
*                 END OF MEMORY PAGE                                            
*        INPUT:   (R7)=FWA OF DUMP CONTROL BLOCK                                
*        RETURN:  NORMAL:  CALL+2                                               
*                 ABNORMAL:  CALL+1 WITH (R8) AND (R10) AS                      
*                            RETURNED BY THE WRITE CAL                          
*                                                                               
CVTMEM   RES      0                                                             
         PSW,R8   *R7                                                           
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET THE FLAG BYTE                           
         LI,R9    ~MFFK                                                         
         AND,R9   R8                                                            
         STB,R9   *R7,R1            RESET FORCED FORMAT KEY FLAG                
         B        CA1STLIN                                                      
CANXLIN  RES      0                 CONVERT NEXT LINE                           
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAG BYTE                               
CA1STLIN LW,R9    WXCWA,R7          CURRENT WORD TO DUMP                        
         CW,R9    WXLWA,R7                                                      
         BG       CAEXIT            B IF PAST END OF DUMP                       
         LI,R5    0                                                             
         LI,R6    BA(FMTKEY8)       BA OF FORMAT KEY FOR 8 WDS/LINE             
         CI,R8    M4WD                                                          
         BAZ      %+2               B IF 8 WDS/LINE BEING DUMPED                
         LI,R6    BA(FMTKEY4)                                                   
         LI,R1    BXLNP                                                         
         LB,R9    *R7,R1            LINE IN PAGE                                
         CB,R9    K:PAGE                                                        
         BGE      CAFKTOF           B IF PAST END OF PAGE                       
         CI,R8    MFFK                                                          
         BAZ      CANFK             B IF FORMAT KEY NOT REQUESTED               
         BAL,R8   INSERT            INSERT FORMAT KEY                           
         LI,R8    FCCDS             FORMAT CONTROL CODE FOR                     
*                                   DOUBLE SPACE                                
         LI,R1    BXLNP                                                         
         LB,R9    *R7,R1            GET LINE NR IN PAGE                         
         AI,R9    5                                                             
         CB,R9    K:PAGE                                                        
         BL       %+2               B IF AT LEAST 5 LINES LEFT                  
         LI,R8    FCCTOF            FORMAT CONTROL CODE FOR                     
*                                   TOP OF FORM                                 
         LI,R1    4*WXBUF                                                       
         STB,R8   *R7,R1            SET FORMAT CONTROL CODE IN LINE             
         B        CAPFK             B TO PRINT FORMAT KEY                       
CAFKTOF  RES      0                 PRINT FORMAT KEY AT TOP OF FORM             
         BAL,R8   INSERT            PUT FORMAT KEY IN LINE                      
CAPFK    BAL,R8   PRINTD            PRINT FORMAT KEY                            
         B        CAEREX            ERROR EXIT                                  
         LI,R5    0                                                             
         LI,R6    BA(BLANKS1)                                                   
         BAL,R8   INSERT            BLANK THE BUFFER                            
         BAL,R8   PRINTD            PRINT A BLANK LINE                          
         B        CAEREX            ERROR EXIT                                  
CANFK    RES      0                 BRANCH HERE FOR NO FORMAT KEY               
*        FIND THE ADDRESS OF THE FIRST VALUE DIFFERENT FROM (CWA)               
         LW,R2    WXCWA,R7                                                      
         LW,R3    R2                                                            
         LW,R8    0,R2              CONTENTS OF CURRENT WORD                    
         LI,R1    BXFLAGS                                                       
         LB,R9    *R7,R1            GET FLAGS                                   
CAFCOV   AI,R3    1                 FIND CHANGE OF VALUE                        
         CW,R3    WXLWA,R7                                                      
         BG       CACOV             B IF END OF DUMP PASSED                     
         CI,R9    MEOP                                                          
         BAZ      %+3               B IF NO END OF PAGE BREAK                   
         CI,R3    X'1FF'                                                        
         BAZ      CACOV             B IF PAGE END WAS PASSED                    
         CW,R8    0,R3                                                          
         BE       CAFCOV            B IF SAME VALUE STILL                       
CACOV    RES      0                 CHANGE OF VALUE (OR END OF DUMP)            
         AW,R2    WXBAD,R7          ADD BUFFER-ADDRESS DISPLACEMENT             
         AW,R3    WXBAD,R7          TO CWA AND CHANGE ADDRESS                   
         LI,R4    8                 GUESS 8 WDS/LINE                            
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAGS                                   
         CI,R8    M4WD                                                          
         BAZ      %+2               B IF ACTUALLY DUMPING 8 WDS/LINE            
         LI,R4    4                 4 WDS/LINE                                  
         DW,R3    R4                TRUNCATE CHANGE OF VALUE                    
         MW,R3    R4                ADDR TO 1ST WD OF LINE                      
         CW,R3    R2                B IF CHANGE OF VALUE IS                     
         BG       CACEV             PAST CURRENT LINE                           
         BAL,R8   CVTLIN            OUTPUT A NORMAL DUMP LINE                   
         B        CAEREX            ERROR EXIT                                  
         B        CATSOP            B TO TEST FOR START OF PAGE                 
CACEV    RES      0                 CONTIGUOUS EQUAL VALUES (SPECIAL            
*                                   FORMAT LINE)                                
         STW,R3   WXTEMP,R7         SAVE CHANGE OF VALUE ADDRESS                
         LI,R6    BA(CEVW)          INSERTION SOURCE                            
         LI,R5    0                                                             
         BAL,R8   INSERT            SET UP FOR CONTIGUOUS EQU VAL LINE          
         LW,R9    WXCWA,R7                                                      
         AW,R9    WXBAD,R7                                                      
         BAL,R8   CVTHEX            CONVERT FWA TO PRINT                        
         LI,R9    6                 NR BYTES TO INSERT                          
         SLD,R10  16                                                            
         LI,R5    BXCEVF                                                        
         LI,R6    4*9+3             SOURCE OF INSERTION                         
         BAL,R8   INSERT            INSERT FWA                                  
         LW,R9    WXTEMP,R7         RECOVER CHANGE OF VALUE ADDRESS             
         AI,R9    -1                                                            
         BAL,R8   CVTHEX            CONVERT LWA                                 
         LI,R9    6                 BL TO INSERT                                
         SLD,R10  16                                                            
         LI,R5    BXCEVL                                                        
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         BAL,R8   INSERT            INSERT LWA                                  
         LW,R9    WXCWA,R7                                                      
         LW,R9    *R9               GET (CWA)                                   
         BAL,R8   CVTHEX            CONVERT FOR HEX DUMP                        
         LI,R9    8                                                             
         LI,R12   0                                                             
         LI,R5    BXCEVHEX                                                      
         LI,R6    4*9+3                                                         
         BAL,R8   INSERT            INSERT HEX FOR VALUE                        
         LW,R9    WXCWA,R7                                                      
         LW,R9    *R9               GET (CWA)                                   
         BAL,R8   CVTEBC            CONVERT (CWA) TO PRINTABLE EBCDIC           
         LI,R9    4                                                             
         LI,R11   0                                                             
         LI,R5    BXCEVEBC                                                      
         LI,R6    4*9+3                                                         
         BAL,R8   INSERT            INSERT EBCDIC FOR VALUE                     
CAPRCEV  BAL,R8   PRINTD            PRINT CONTIGUOUS EQUAL VALUE LINE           
         B        CAEREX            ERROR EXIT                                  
         LW,R8    WXTEMP,R7         RECOVER CHANGE OF VALUE ADDRESS             
         SW,R8    WXBAD,R7          REMOVE BUFFER-ADDRESS DISPLACEMENT          
         STW,R8   WXCWA,R7          SAVE AS NEW CWA                             
CATSOP   RES      0                 TEST FOR START OF PAGE                      
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAGS                                   
         CI,R8    MEOP                                                          
         BAZ      CANXLIN           B IF NO END OF PAGE BREAK                   
         LW,R8    WXCWA,R7                                                      
         CI,R8    X'1FF'                                                        
         BANZ     CANXLIN           B IF NOT AT END OF MEMORY PAGE              
*        ELSE BREAK AT END OF MEMORY PAGE                                       
CAEXIT   PLW,R8   *R7                                                           
         AI,R8    1                 NORMAL EXIT                                 
         B        *R8                                                           
CAEREX   PLW,R9   *R7                                                           
         B        *R9               ERROR EXIT                                  
         TITLE    '***** DUMP *****'                                            
*                                                                               
*        CALL:    BAL,R8  DUMP                                                  
*        PURPOSE: DUMP AN AREA OF MEMORY, WITH OPTIONS:                         
*                    A)  MAPPED MEMORY CONSIDERATIONS                           
*                    B)  EBCDIC DUMP ADDED                                      
*                    C)  DUMP 4 WORDS PER LINE                                  
*                    D)  DISPLACEMENT FROM MEMORY LOCATION                      
*                        TO PRINTED ADDRESS                                     
*        INPUT:   (R7)=WA OF DUMP CONTROL BLOCK                                 
*                         THE DCB, FWA, LWA, BAL, BAD, AND                      
*                         FLAGS FIELDS MUST BE SET.                             
*                         IF THE FIRST WORD OF THE LINE BUFFER IS               
*                         NON-ZERO, THE BUFFER IS PRINTED AS A                  
*                         HEADER.                                               
*        RETURN:  NORMAL:  CALL+2                                               
*                 ABNORMAL:  CALL+1, WITH (R8) AND (R10) AS                     
*                            RETURNED FROM THE OPEN OR WRITE CAL                
*                                                                               
DUMP     RES      0                                                             
         LI,R6    WXESTK-WXSTK+1    SET UP STACK POINTER DW                     
         SLS,R6   16                                                            
         STW,R6   1,R7                                                          
         LW,R6    R7                                                            
         AI,R6    WXSTK-1                                                       
         STW,R6   0,R7                                                          
         PSW,R8   *R7               SAVE RETURN ADDR IN STACK                   
*        SET UP I/O FPT                                                         
         AI,R6    WXDCB-WXSTK+1                                                 
         STW,R6   WXFPT,R7          DCB INDIRECT ADDRESS                        
         AI,R6    WXBUF-WXDCB                                                   
         STW,R6   WXFPT+WXBUFFPT,R7 LINE BUFFER ADDRESS                         
         LI,R6    IOABNER                                                       
         STW,R6   WXFPT+WXERAFPT,R7 ERROR ADDRESS                               
         STW,R6   WXFPT+WXABAFPT,R7 ABNORMAL ADDRESS                            
         LI,R1    BXFLAGS                                                       
         LB,R2    *R7,R1            GET FLAGS                                   
*********         VERY NONPARAMETRIC, BUT SHORT. BEWARE.                        
         SLS,R2   -6                                                            
         LB,R6    RSZTBL,R2         GET RSZ, CONSIDERING FLAGS                  
         STW,R6   WXFPT+WXSIZFPT,R7 SET LINE OUTPUT BL                          
         LW,R6    OFPTF                                                         
         STW,R6   WXFPT+WXFLGFPT,R7 SET FLAGS IN FPT FOR OPEN                   
         LI,R6    OPENC+X'80'                                                   
         LI,R1    4*WXFPT           BX OF FPT CODE BYTE IN BLOCK                
         STB,R6   *R7,R1            SET OPEN CODE IN FPT                        
         LI,R0    DUERROR                                                       
         CAL1,1   WXFPT,R7          OPEN THE DCB                                
         LW,R6    WFPTF                                                         
         STW,R6   WXFPT+WXFLGFPT,R7 SET FLAGS IN FPT FOR WRITE                  
         LI,R6    WRITEC+X'80'                                                  
         STB,R6   *R7,R1            SET WRITE CODE IN FPT                       
*        SETUP COMPLETE                                                         
         LW,R8    WXBUF,R7                                                      
         BEZ      %+3               B IF NO HEADER SPECIFIED                    
         BAL,R8   PRINTD                                                        
         B        DUERROR           ERROR RETURN                                
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAGS                                   
         DO       #MAP                                                          
         CI,R8    MVIRT                                                         
         BANZ     DUIPC             B IF VIRTUAL MEMORY DUMP                    
DUNPC    RES      0                 DUMP WITH NO PAGING CONSIDERATIONS          
         ELSE     #MAP                                                          
         LI,R9    ~MVIRT                                                        
         AND,R8   R9                VIRTUAL DUMP NOT ALLOWED                    
         FIN      #MAP                                                          
*        REAL MEMORY DUMP, OR VIRTUAL WITH NO MAPPING                           
*        OR MEMORY PROTECTION CONSIDERATION                                     
         LI,R9    MFFK              FORCE FORMAT KEY                            
         OR,R8    R9                BEFORE DUMPING                              
         STB,R8   *R7,R1            SET FLAGS                                   
         BAL,R8   CVTMEM            DUMP THE SPECIFIED RANGE                    
         B        DUERROR           ERROR EXIT                                  
DUEXIT   BAL,R9   DUCLOSE           NORMAL EXIT. CLOSE DCB                      
         PLW,R9   *R7                                                           
         AI,R9    1                                                             
DEXIT    B        *R9                                                           
DUERROR  PSW,R8   *R7               ERROR EXIT.  SAVE I/O ERROR REGS            
         PSW,R10  *R7                                                           
         BAL,R9   DUCLOSE           CLOSE THE DCB                               
         PLW,R10  *R7                                                           
         PLW,R8   *R7                                                           
         PLW,R9   *R7                                                           
         B        DEXIT                                                         
*                                                                               
*        DUMP WITH CONSIDERATION FOR MAPPING AND MEMORY PROTECTION              
         DO       #MAP                                                          
DUIPC    RES      0                 INCLUDE PAGING CONSIDERATIONS               
         LW,R9    WXBAD,R7                                                      
         BNEZ     DUNPC             CANT CHECK PAGING ON DISPLACED              
*                                   DUMP                                        
DUIPC1   LW,R9    WXCWA,R7          GET CURRENT WORD ADDRESS                    
         CW,R9    WXLWA,R7                                                      
         BG       DUEXIT            B IF PAST END                               
         LI,R6    BA(MEMPAGE)       BA OF INSERTION SOURCE                      
         LI,R5    0                 BX FOR DESTINATION IN LINE BUF              
         BAL,R8   INSERT            INSERT MEMORY PAGE HEADER                   
         LI,R9    X'1FE00'                                                      
         AND,R9   WXCWA,R7          CURRENT PAGE START                          
         BAL,R8   CVTHEX            CONVERT TO HEX                              
         SLD,R10  16                                                            
         LI,R9    6                 NR OF BYTES TO INSERT                       
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         LI,R5    BXVA              BX OF DESTINATION IN LINE BUF               
         BAL,R8   INSERT            INSERT VIRTUAL PAGE ADDRESS                 
         LW,R9    WXCWA,R7          CURRENT PAGE START                          
         DO       #ONLINE=0                                                     
         BAL,R8   TMGRA             GET REAL CWA                                
         ELSE     #ONLINE=0                                                     
         LW,R0    R9                                                            
         FIN      #ONLINE=0                                                     
         LI,R9    X'FFE00'                                                      
         AND,R9   R0                                                            
         STW,R0   WXTEMP,R7         SAVE ACCESS CODE                            
         BAL,R8   CVTHEX            CONVERT REAL PAGE ADDRESS                   
         SLD,R10  16                                                            
         LI,R9    6                 NR BYTES TO INSERT                          
         LI,R6    4*9+3             BA OF INSERTION SOURCE                      
         LI,R5    BXRA              BX OF DESTINATION IN LINE BUF               
         BAL,R8   INSERT            INSERT REAL PAGE ADDRESS                    
         LW,R11   WXTEMP,R7         RECOVER ACCESS CODE                         
         LB,R10   R11               CONVERT TO BINARY TEXT                      
         SLD,R10  -5                                                            
         SLS,R10  7                                                             
         SLD,R10  1                                                             
         AI,R10   X'2F0F0'          BYTE COUNT AND CONVERT TO EBCDIC            
         SLS,R10  8                                                             
         LI,R6    4*10              BA OF INSERTION SOURCE                      
         LI,R5    BXAC              BX OF DESTINATION IN LINE BUF               
         BAL,R8   INSERT            INSERT ACCESS CODE                          
         BAL,R8   PRINTD                                                        
         B        DUERROR           I/O ERROR EXIT                              
         LW,R9    WXTEMP,R7         RECOVER ACCESS CODE                         
         LB,R9    R9                                                            
         CI,R9    X'30'                                                         
         BE       DUIPC2            SKIP DUMP IF ACCESS NOT PERMITTED           
         LI,R1    BXFLAGS                                                       
         LB,R8    *R7,R1            GET FLAGS                                   
         LI,R9    MFFK                                                          
         OR,R8    R9                FORCE FORMAT KEY                            
         STB,R8   *R7,R1            SET FLAGS                                   
         BAL,R8   CVTMEM            CONVERT TO END OF PAGE OR                   
*                                   END OF DUMP                                 
         B        DUERROR           I/O ERROR                                   
         B        DUIPC1            B FOR NEXT PAGE                             
DUIPC2   LI,R9    X'1FE00'          SKIP TO START OF NEXT PAGE                  
         AND,R9   WXCWA,R7                                                      
         AI,R9    X'200'                                                        
         STW,R9   WXCWA,R7                                                      
         B        DUIPC1                                                        
         FIN      #MAP                                                          
*                                                                               
DUCLOSE  LW,R6    CFPTF             FPT FLAGS FOR CLOSE CAL                     
         STW,R6   WXFPT+WXFLGFPT,R7                                             
         LI,R6    CLOSEC+X'80'      CLOSE CODE, INDIRECT DCB                    
         LI,R1    4*WXFPT                                                       
         STB,R6   *R7,R1                                                        
         LI,R0    %+2               ERROR RETURN (IGNORE ERROR)                 
         CAL1,1   WXFPT,R7          CLOSE THE DUMP DCB                          
         B        *R9                                                           
*                                                                               
IOABNER  B        *R0               USE R0 AS ERR ROUTINE POINTER               
         TITLE    '***** DFGD:  POSTPRINT ROUTINE *****'                        
*                                                                               
*        PURPOSE: TO PROVIDE A BREAK IN CONTROL TASK DUMPS                      
*                 FOR PROCESSING OTHER CT SERVICES                              
*        CALLS:   BAL,R9 DFGDBAL   FROM WITHIN DUMP                             
*                 B      DFGD    FROM CT LOOP TO RETURN TO DUMP                 
*                                                                               
CTDABT   EQU      X'10000'          FLAG FOR CT DUMP ABORT (K:PMD1)             
*                                                                               
DFGDBAL  RES      0                 POST-PRINT ROUTINE FOR CT DUMP              
         LW,R0    WXRES+2,R7                                                    
         SLS,R0   -17               TYC FROM DUMP DCB                           
         CI,R0    1                                                             
         BNE      DFGDX             B IF ABNORMAL COMPLETION (NO BREAK)         
DFX1     LCI      3                                                             
         PSM,R8   *R7                                                           
         STW,R7   K:CTDR7           SAVE R7                                     
         LI,R9    CT1               GO TO CONTROL TASK LOOP                     
DFGDX    B        *R9                                                           
*                                                                               
DFGD     RES      0                 REENTER DUMP FROM CT LOOP                   
         LW,R7    K:CTDR7           RECOVER CONTROL BLOCK POINTER               
         LCI      3                                                             
         PLM,R8   *R7                                                           
         LW,R1    K:PMD1                                                        
         CI,R1    CTDABT                                                        
         BAZ      DFGDX             B IF DUMP ABORT NOT REQUIRED                
*                                                                               
DFABT    LW,R0    WXCWA,R7                                                      
         STW,R0   WXLWA,R7          SET THE  DUMP LIMITS TO                     
         MTW,-1   WXLWA,R7          FORCE END OF DUMP                           
         B        DFGDX                                                         
         OLAYEND                                                                
         END                                                                    
