MACRO                                                                  
&NAME    ASLFILL  &FIELD,&X                                                     
* *********************************************************************         
*                        A S L F I L L                                *         
*                                                                     *         
*        Fill a passed area with the string passed as a second        *         
*        parameter. If a second parm is omitted space x'40' is        *         
*        used as the fill character.                                  *         
*                                                                     *         
*        NOTE: The passed fill character must be the hex value        *         
*              i.e. to fill a field with binary zeros pass 00 to      *         
*                   the macro like this: ASLFILL AREANAME,00          *         
*                                                                     *         
* *********************************************************************         
         LCLC  &CHAR,&REG,&LEN,&LEN2                                            
         AIF   (K'&FIELD NE 0).OK                                               
         MNOTE 12,'***** No field specified *****'                              
         AGO   .EXIT                                                            
.OK      ANOP                                                                   
         AIF   (K'&X NE 0).SETOK                                                
         MNOTE 0,'***** No pad character specified. Space assumed'              
&CHAR    SETC  '40'                                                             
         AGO   .CONT                                                            
.SETOK   ANOP                                                                   
&CHAR    SETC  '&X'                                                             
.CONT    ANOP                                                                   
         AIF   (K'&Name EQ 0).SKIPNAME                                          
&NAME    EQU   *                                                                
.SKIPNAME ANOP                                                                  
         AIF   ('&FIELD'(1,1) NE '(').DOFIELD                                   
&LEN     SETC  '&Field(2)'                                                      
&REG     SETC  '&FIELD(1)'                                                      
         LR    0,&REG                 Point to passed area                      
         AIF   ('&LEN'(1,1) NE '(').NOTREG                                      
&LEN2    SETC  '&LEN'(2,3)                                                      
         AIF   ('&LEN'(4,1) NE ')').SKIPSET                                     
&LEN2    SETC  '&LEN'(2,2)                                                      
.SKIPSET ANOP                                                                   
         LR    1,&LEN2                Load length of area into R1               
         AGO   .REJOIN                                                          
.NOTREG  ANOP                                                                   
         LA    1,&LEN                 Load length of area into R1               
         AGO   .REJOIN                                                          
.DOFIELD ANOP                                                                   
         LA    0,&FIELD               Point to passed area                      
         LA    1,L'&FIELD             Load length of area into R1               
.REJOIN  ANOP                                                                   
         XR    14,14                  Clear register 14                         
         LA    15,X'&CHAR'            Set pad character...                      
         SLL   15,24                  ... and shift to high order               
         MVCL  0,14                   Now intialise the area                    
.EXIT    ANOP                                                                   
         MEXIT                                                                  
*                                                                     *         
*  Copyright - Abbydale Systems LLC.                                  *         
* *********************************************************************         
         MEND