EJECT ,                                                                
***********************************************************************         
*                                                                               
* Create equate for storage in IPCS dump                                        
* 
* Input:                                                                               
* Parmlist+0 - Name of equate/storage (String)                                  
* Parmlist+4 - Virtual Storage address in dump (fullword)                       
* Parmlist+8 - length of storage (halfword)                                     
* Parmlist+12 - ASID (halfword)                                                 
* Parmlist+16 - Remarks: =AL2(xx),CLxx'remarks'                                 
*                                                                               
***********************************************************************         
         space 1                                                                
Create_Equate ds 0h                                                             
         BAKR  R14,0                                                            
                                                                             
         L     R2,My_ABDPL                Locate ABDPL                          
         MVI   ADPLPRDP-ABDPL(R2),ADPLVIRT Set to virtual storage               
                                                                                
         MVC   AS_ParmSI(2),ADPLASID-ABDPL(R2)  Save                            
         MVC   ADPLASID-ABDPL(2,R2),parmlist+12 Get ASID                        
                                                                                
         LA    R14,my_essy                                                      
         USING ESSY,R14                                                         
         mvc   0(ESSYLRL,r14),c_essy                                            
                                                                                
         l     r1,parmlist+0              Locate name                           
         slr   r15,r15                                                          
         ic    r15,0(r1)                  Get length (-1 already)               
         ex    r15,ce$MoveName            Get symbol name                       
                                                                                
         l     r1,parmlist+4              Locate V/S address                    
         mvc   ESSYLAD(4),0(R1)           Set it                                
                                                                                
         l     r1,parmlist+8              Locate length halfword                
         mvc   ESSYDLE+2(2),0(r1)         Fill in area length                   
                                                                                
         MVC   essyAS2+2(2),parmlist+12                                         
                                                                                
         l     r1,parmlist+16             Locate remarks                        
         slr   r15,r15                                                          
         icm   r15,b'0011',0(r1)          Get length of remarks                 
         bctr  r15,0                      Decrement for EX                      
         ex    r15,ce$MoveREM             Move remarks to ESSY                  
                                                                                
         mvc   essyast(2),=AL2(ZZZASTCV)  V/S address                           
                                                                                
         LA    R15,ADPLSEQS               Get service type: Equate              
         ST    R15,DOUBLE                 Save code                             
         L     R15,ADPLSERV-ABDPL(R2)     Locate IPCS service routine           
         DROP  R14                                                              
         CALL  (15),((2),DOUBLE,(14)),MF=(E,PARMLIST)                           
         LTR   R15,R15                                                          
         JZ    CE$X                                                             
         st    r15,double2                                                      
         JAS   R14,Initialize_Line        Clear output area                     
         mvc   0(30,r15),=c'Create Equate IPCS service RC='                     
         LA    R15,30(R15)                                                      
         L     R1,double2  
         cvd   r1,double
         ed    0(4,r15),double+4(4)
         oi    3(r15),c'0'                                                                                                            
         JAS   R14,Print_Line             Print Message                         
                                                                                
CE$X     DS    0H                                                               
         MVC   ADPLASID-ABDPL(2,R2),AS_ParmSI Restore ASID                      
         PR    ,                                                                
                                                                               
*                                                                               
ce$MoveName mvc ESSYSYM-essy(*-*,r14),1(r1)                                     
ce$MoveREM  mvc essyrl-essy(*-*,r14),0(r1)                                      
* 
...
My_ABDPL   DS    F                        Address of ABDPL on entry 
My_essy    DS    XL(ESSYLRL)              Create Equate  Parameter List         
My_essyREM DS    cl80' '                  Remark is up to 80 bytes 
... 
ESSY     BLSRESSY ,                       IPCS service: Equate Symbol