MACRO                                                                  
&N       PRINTHEX &R1,&OUTAREA                                                  
* ******************************************************************* *         
*                                                                     *         
*                          P R I N T H E X                            *         
*                                                                     *         
*        Make the contents of a register printable and place          *         
*        the result into the passed area.                             *         
*                                                                     *         
*        Registers R0-R3 are saved and restored.                      *         
*                                                                     *         
         LCLC  &REG1                                                            
         GBLA  &H                                                               
         GBLB  &PRNTHEX                                                         
         AIF   ('&N' EQ '').GO                                                  
&N       DS    0H                                                               
.GO      ANOP                                                                   
         AIF   ('&H' GT '1').GO2                                                
&H       SETA  1                                                                
.GO2     AIF   (K'&R1 NE 0).REG1OK                                              
         MNOTE 8,'***** No register specified ************************'         
         AGO   .END                                                             
.REG1OK  ANOP                                                                   
         AIF   ('&R1'(1,1) NE 'R').NUMB                                         
&REG1    SETC  '&R1'(2,2)                                                       
         AGO   .CONT                                                            
.NUMB    ANOP                                                                   
&REG1    SETC  '&R1'                                                            
         AIF   (K'&OUTAREA EQ 0).E2                                             
.CONT    ANOP                                                                   
         AIF   ('&REG1' GT '15').E1                                             
         AIF   (&PRNTHEX).SKIPPY                                                
         B     ASLPX&H                                                          
*             P R I N T H E X      W O R K A R E A                    *         
ASLPRX1  DS    4F                                                               
&PRNTHEX SETB  1                                                                
.SKIPPY  ANOP                                                                   
ASLPX&H  DS    0H                                                               
         STM   0,3,ASLPRX1        Save the registers                            
         LA    0,8                Set loop counter                              
         LA    1,&OUTAREA         Get target arear                              
         LR    3,&REG1            Load source register                          
         LA    2,X'0F'            Prime R2 with 0F                              
         SLDL  2,4                Shift first nibble from R3                    
         CH    2,=x'00FA'         Is it F0 to F9?                               
         BL    *+8                ... No, skip the subtract                     
         SH    2,=x'0039'         Subtract 39 to get hex letter                 
         STC   2,0(1)             Store it in R1                                
         LA    1,1(1)             Skip up outout field                          
         BCT   0,*-28                                                           
         LM    0,3,ASLPRX1        Restore the registers                         
&H       SETA  &H+1                                                             
         MEXIT                                                                  
.E1      MNOTE 8,'Improper register specified. No statements generated'         
         AGO   .END                                                             
.E2      MNOTE 8,'**** Output area not specified *********************'         
.END     ANOP                                                                   
*                                                                     *         
*  Copyright - Abbydale Systems LLC.                                  *         
* ******************************************************************* *         
         MEND