ASLLLA1R CSECT                                                                  
ASLLLA1R AMODE 31                                                               
ASLLLA1R RMODE ANY                                                              
*        COPY  ASLEQUC                                                          
***********************************************************************         
**                        A S L L L A 1 R                            **         
***********************************************************************         
** Purpose :- Issue an LLA refresh if message is issue by a jobname  **         
**            defined within the table in the code.                  **         
**                                                                   **         
***********************************************************************         
**            Copyright 1998 (C) Abbydale Systems LLC.               **         
***********************************************************************         
***********************************************************************         
*                         REGISTER EQUATES                            *         
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *         
R0       EQU   0                                                      *         
R1       EQU   1                                                      *         
R2       EQU   2                                                      *         
R3       EQU   3                                                      *         
R4       EQU   4                                                      *         
R5       EQU   5                                                      *         
R6       EQU   6                                                      *         
R7       EQU   7                                                      *         
R8       EQU   8                       A S L E Q U C                  *         
R9       EQU   9                                                      *         
R10      EQU   10      EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER      *         
R11      EQU   11       TO MAKE THE USE OF REGISTER OPERANDS IN       *         
R12      EQU   12       INSTRUCTIONS SELF EXPLANITORY.THIS ALSO       *         
R13      EQU   13         CREATES ENTRIES IN CROSS REFERENCE.         *         
R14      EQU   14                                                     *         
R15      EQU   15                                                     *         
FPR0     EQU   0                                                      *         
FPR2     EQU   2                                                      *         
FPR4     EQU   4                                                      *         
FPR6     EQU   6                                                      *         
         EJECT                                                                  
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *         
*                     MISCELLANEOUS EQUATES                           *         
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *         
EQUHOBON EQU   X'80000000'   SET HIGH ORDER BIT ON                    *         
PACKDIG  EQU   X'0F'         PACK DIGIT                               *         
*                                                              K.E.F. *         
* ******************************************************************* *         
         STM   R14,R12,12(R13)    Save callers registers                        
         BALR  R12,0              Load base register ...                        
         USING *,R12              ... and establish addressability              
         L     R5,0(R1)           CTXT address into R5 ...                      
         USING CTXT,R5            ... and establish addressability              
***********************************************************************         
**  Get Storage for SVC 34 (below the line)                          **         
***********************************************************************         
         STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW                     
         USING DATA,R11           Address the area returned                     
         ST    R13,SAVEAREA+4     Set backwards pointer                         
         LA    R15,SAVEAREA       Get our save area address ...                 
         ST    R15,8(R13)         ... and set forward pointer                   
         LR    R13,R15            Load R13 with savearea address                
         L     R2,CTXTTXPJ        Get address of message attributes ...         
         USING CTXTATTR,R2        ... and establish addressability              
         OI    CTXTRFB2,CTXTRHCO  Set to suppress message                       
         BAS   R10,Check_User     Go see if we are authorised                   
         LTR   R7,R7              Can we do it?                                 
         BNZ   Not_Auth           No - Get out                                  
         XC    MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area                         
         MVC   MGCRTEXT(L'REPLYT),REPLYT Move our reply in                      
         LA    R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length of Reply                
         STC   R1,MGCRLGTH        Save the length                               
         XR    R0,R0              Clear register zero                           
         MGCR  MGCRPL             Issue the reply                               
Not_Auth DS    0H                                                               
         L     R13,4(R13)         Restore register 13                           
         STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11)  Free the storage            
         LM    R14,R12,12(R13)    Restore callers registers                     
         PR                       Return to caller                              
Check_User DS 0H                                                                
         MVC   JOBNAME,CTXTJBNM   Save jobname                                  
         TR    JOBNAME,TRTABLE                                                  
         LA    R7,8               Set default to fail                           
         LA    R2,Table           Start of table                                
         LA    R3,Table_End       End of table                                  
Loop_Back DS   0H                                                               
         CLC   CTXTJBNM,0(R2)     Jobname match?                                
         BE    Exit_CC0           Yes - Go set Cond code and then exit          
         LA    R2,8(R2)           Point at next table entry                     
         CR    R2,R3              End of table?                                 
         BH    Exit_User                                                        
         B     Loop_Back                                                        
Exit_CC0 DS    0H                                                               
         XR    R7,R7              Flag OK to issue                              
Exit_User DS   0H                                                               
         BR    R10                                                              
***********************************************************************         
*                  Start of authorised jobname table                  *         
***********************************************************************         
Table    DS    0H                                                               
         DC    CL8'REFRESH '                                                    
         DC    CL8'ASMMPF  '                                                    
Table_End DS   0H                                                               
Table_Size EQU Table_End-Table                                                  
***********************************************************************         
*                  End of autorised jobnames tabel                    *         
***********************************************************************         
TRTABLE  DS    0CL256                                                           
         DC    XL1'40',XL255'00'                                                
REPLYT   DS    0CL13                                                            
         DC    CL13'F LLA,REFRESH' Refresh LLA                                  
DATA     DSECT                                                                  
         DS    0F                                                               
JOBNAME  DS    CL8                                                              
SAVEAREA DS    18F                Register save area                            
MGCR     IEZMGCR DSECT=NO                                                       
DATAEND  EQU   *-DATA                                                           
         IEZVX100                                                               
         END