Generate a PL/I INMOD Routine - FastExport

Teradata FastExport Reference

Product
FastExport
Release Number
15.00
Language
English (United States)
Last Update
2018-09-28
dita:id
B035-2410
lifecycle
previous
Product Category
Teradata Tools and Utilities

Generate a PL/I INMOD Routine

Following is an example of compiling and linking a PL/I INMOD routine.

 
//MXM049A  JOB (22150000),'MXM',MSGCLASS=A,NOTIFY=MXM                           
//STEP1  EXEC PGM=IEV90,REGION=1024K,                                           
//             PARM='OBJ,NODECK,XREF(FULL)'                                     
//SYSLIB   DD   DSN=SYS1.MACLIB,DISP=SHR                                        
//         DD   DSN=SYS1.AMODGEN,DISP=SHR                                       
//SYSPRINT DD   SYSOUT=A                                                        
//SYSTERM  DD   SYSOUT=*                                                        
//SYSUT1   DD   UNIT=VIO,SPACE=(CYL,(9,5))                                      
//SYSUT2   DD   UNIT=VIO,SPACE=(CYL,(9,5))                                      
//SYSUT3   DD   UNIT=VIO,SPACE=(CYL,(9,5))                                      
//SYSLIN   DD   DSN=&&PLIA,DISP=(,PASS),UNIT=SCR,                               
//  SPACE=(CYL,(1,1)),DCB=(RECFM=FB,LRECL=80,BLKSIZE=3200)                      
//SYSIN    DD   *                                                               
         TITLE 'DYNAMN'                                                         
DYNAMN   CSECT                                                                  
         EXTRN PLISTART                                                         
         B     START-*(,R15)            BRANCH AROUND CONSTANTS                 
         DC    AL1(L'PLIAFLAG)          LENGTH OF CONSTANTS                     
PLIAFLAG DC    C'ASSEMBLED AT &SYSTIME ON &SYSDATE.. PLIA'                      
         DC    C' COPYRIGHT (C) 2014 TERADATA CORPORATION,'                          
         DC    C' ALL RIGHTS RESERVED.'                                         
*================================================================               
*   ENTRY POINT                                                                 
*================================================================               
START    SAVE  (14,12)                                                          
         LR    R12,R15            -> PROGRAM ENTRY POINT                        
         USING DYNAMN,R12                                                       
*                                                                               
         LA    R10,SAVAREA                                                      
         ST    R10,8(R13)         FORWARD CHAIN                                 
         ST    R13,4(R10)         BACK CHAIN                                    
         LR    R13,R10                                                          
*                                                                               
         LR    R4,R1              SAVE PARM LIST ADDRESS                        
         L     R3,0(,R1)          -> COMMAND WORD                               
         L     R3,0(,R3)          COMMAND WORD                                  
         CH    R3,=H'0'           INITIAL CALL?                                 
         BE    DO_INIT            YES , DO INITIAL CODE                         
         CH    R3,=H'6'           INITIAL CALL?                                 
         BE    DO_INIT            YES , DO INITIAL CODE                         
         CH    R3,=H'2'           INITIAL CALL?                                 
         BNE   DO_CALL            NO, JUST GO CALL PROGRAM                      
*================================================================               
*   SETUP PL/I ENVIRONMENT                                                      
*================================================================               
DO_INIT  DS    0H                                                               
*                                                                               
*        WTO   'PRIOR TO INIT REQUEST'                                          
*                                                                               
         MVC   PRP_REQUEST,INIT   INDICATE THE INIT REQUEST                     
*                                                                               
         LA    R1,EXEC_ADDR       GET THE PARM ADDR LIST                        
         ST    R1,EPL_EXEC_OPTS   SAVE IN EPL                                   
*                                                                               
         LA    R1,PARM_EPL        R1 --> POINTER --> REQUEST LIST               
         L     R15,PSTART         PL/I ENTRY ADDR                               
         BALR  R14,R15            INVOKE PL/I                                   
*                                                                               
*        WTO   'AFTER INIT REQUEST'                                             
*================================================================               
*   CALL "OPTIONS( MAIN )" INMOD                                                
*================================================================               
DO_CALL  DS    0H                                                               
*                                                                               
*        WTO   'PRIOR TO CALL REQUEST'                                          
*                                                                               
         MVC   PRP_REQUEST,CALL   INDICATE THE CALL REQUEST                     
*                                                                               
         ST    R4,EPL_PROG_PARMS  SAVE PARM ADDR IN EPL                         
         LA    R1,PARM_EPL        R1 --> POINTER --> REQUEST LIST               
         L     R15,PSTART         PL/I ENTRY ADDR                               
         BALR  R14,R15            INVOKE PL/I                                   
*                                                                               
         CH    R3,=H'5'           FINAL CALL?                                   
         BNE   DO_RTN             NO, JUST RETURN TO CALLER                     
*================================================================               
*   TERMINATE THE PL/I ENVIRONMENT                                              
*================================================================               
DO_TERM  DS    0H                                                               
*                                                                               
         ST    R15,RETCODE        SAVE PL/I RETURN CODE                         
*                                                                               
*        WTO   'PRIOR TO TERM REQUEST'                                          
*                                                                               
         MVC   PRP_REQUEST,TERM   INDICATE A TERM COMMAND                       
*                                                                               
         LA    R1,0               NO PARM LIST IS PRESENT                       
         ST    R1,EPL_PROG_PARMS  SAVE IN EPL                                   
*                                                                               
         LA    R1,PARM_EPL        R1 --> POINTER --> REQUEST LIST               
         L     R15,PSTART         PL/I ENTRY ADDR                               
         BALR  R14,R15            INVOKE PL/I                                   
*                                                                               
*        WTO   'AFTER TERM REQUEST'                                             
*================================================================               
*   RETURN TO CALLER                                                            
*================================================================               
DO_RTN   DS    0H                                                               
*                                                                               
         L     R13,SAVAREA+4                                                    
         L     R14,12(R13)                                                      
         L     R15,RETCODE                                                      
         LM    R0,R12,20(R13)                                                   
         BR    R14                RETURN TO YOUR CALLER                         
         EJECT                                                                  
         EJECT                                                                  
*================================================================               
*   CONSTANTS AND WORKAREAS                                                     
*================================================================               
SAVAREA  DS    20F                                                              
RETCODE  DC    F'0'                                                             
PARM_EPL DC    A(X'80000000'+IBMBZPRP)      PARAMETER ADDR LIST                 
PSTART   DC    A(PLISTART)                                                      
*================================================================               
*   REQUEST STRINGS ALLOWED IN THE INTERFACE                                    
*================================================================               
INIT     DC    CL8'INIT'          INITIALIZE THE PROGRAM ENVIR                  
CALL     DC    CL8'CALL'          INVOKE THE APPL - LEAVE ENVIR UP              
TERM     DC    CL8'TERM'          TERMINATE ENVIRONMENT                         
EXEC     DC    CL8'EXECUTE'       INIT, CALL, TERM - ALL IN ONE                 
*================================================================               
*   PARAMETER LIST PASSED BY A PRE-INITIALIZED PROGRAM                          
*   ADDRESSED BY REG 1 = A(A(IBMBZPRP))                                         
*   SEE IBMBZEPL DSECT.                                                         
*================================================================               
IBMBZPRP             DS  0F                                                     
PRP_LENGTH           DC  H'16'    LEN OF THIS PRP PASSED (16)                   
PRP_ZERO             DC  H'0'     MUST BE ZERO                                  
PRP_REQUEST          DC  CL8' '   'INIT' - INITIALIZE PL/I                      
*                                 'CALL' - INVOKE APPLICATION                   
*                                 'TERM' - TERMINATE PL/I                       
*                                 'EXECUTE' - INIT, CALL, TERM                  
*                                                                               
PRP_EPL_PTR          DC  A(IBMBZEPL)   A(EPL) - EXTENDED PARM LIST              
*================================================================               
*   PARAMETER LIST FOR THE PRE-INITIALIZED PROGRAM                              
*================================================================               
IBMBZEPL             DS  0F                                                     
EPL_LENGTH           DC  A(EPL_SIZE)   LENGTH OF THIS EPL PASSED                
EPL_TOKEN1           DC  F'0'          FIRST ENV TOKEN                          
EPL_TOKEN2           DC  F'0'          SECOND ENV TOKEN                         
EPL_PROG_PARMS       DC  F'0'          A(PARM ADDRESS LIST) ...                 
EPL_EXEC_OPTS        DC  A(EXEC_ADDR)  A(EXECUTION TIME OPTNS) ...              
EPL_ALTMAIN          DC  F'0'          A(ALTERNATE MAIN)                        
EPL_SERVICE_VEC      DC  A(IBMBZSRV)   A(SERVICE ROUTINES VECTOR)               
EPL_SIZE             EQU *-IBMBZEPL    THE SIZE OF THIS BLOCK                   
*================================================================               
*   SERVICE ROUTINE VECTOR                                                      
*================================================================               
IBMBZSRV             DS  0F                                                     
SRV_SLOTS            DC  F'2'          COUNT OF SLOTS DEFINED                   
SRV_USERWORD         DC  A(SRV_UA)     USER WORD                                
SRV_WORKAREA         DC  A(SRV_WA)     A(WORKAREA)                              
SRV_LOAD             DC  F'0'          A(LOAD ROUTINE)                          
SRV_DELETE           DC  F'0'          A(DELETE ROUTINE)                        
SRV_GETSTOR          DC  F'0'          A(GET STORAGE ROUTINE)                   
SRV_FREESTOR         DC  F'0'          A(FREE STORAGE ROUTINE)                  
SRV_EXCEP_RTR        DC  F'0'          A(EXCEPTION ROUTER SERVICE)              
SRV_ATTN_RTR         DC  F'0'          A(ATTENTION ROUTER SERVICE)              
SRV_MSG_RTR          DC  F'0'          A(MESSAGE ROUTER SERVICE)                
SRV_END              DS  0F                                                     
*================================================================               
*   SERVICE ROUTINE USERAREA                                                    
*================================================================               
SRV_UA               DS  8F                                                     
*================================================================               
*   SERVICE ROUTINE WORKAREA                                                    
*================================================================               
SRV_WA               DS  0D                                                     
                     DC  F'256'   LENGTH OF WORKAREA                            
                     DS  63F      ACTUAL WORKAREA                               
*================================================================               
*   EXECUTION TIME PARAMETERS                                                   
*================================================================               
EXEC_ADDR DC    A(X'80000000'+EXEC_LEN)                                         
EXEC_LEN  DC    AL2(EXEC_OLEN)                                                  
EXEC_OPTS DC    C'NATLANG(ENU),NOSTAE'                                          
EXEC_OLEN EQU   *-EXEC_OPTS                                                     
*                                                                               
     LTORG                                                                      
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                                                                
R9       EQU   9                                                                
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END                                                                    
//*                                                                             
//STEP2    EXEC IEL1CL                                                          
//PLI.SYSPRINT  DD SYSOUT=*                                                     
//PLI.SYSIN     DD *                                                            
 INMDPL2: PROCEDURE (X,Y) OPTIONS (MAIN);                                       
                                                                                
  DCL X FIXED, Y FIXED;                                                         
                                                                                
  DCL 1 PARM_LIST ALIGNED BASED(P),                                             
        10 STATUS       FIXED BINARY (31,0),                                    
        10 RLENGTH      FIXED BINARY (31,0),                                    
        10 BUFFER       CHAR(80);                                               
  DCL 1 PARM_PARM2 ALIGNED BASED(Q),                                            
        10 SEQ          FIXED BINARY (31,0),                                    
        10 LEN          FIXED BINARY (15,0),                                    
        10 PARAMETER    CHAR(80);                                               
  DCL COUNT STATIC FIXED BINARY (31,0),                                         
      INSROWS STATIC FIXED BINARY (31,0),                                       
      REJROWS STATIC FIXED BINARY (31,0);                                       
  DCL I, NOTMATCH FIXED BINARY (31,0);                                          
  DCL ADDR BUILTIN, SUBSTR BUILTIN;                                             
  DCL P POINTER, Q POINTER;                                                     
  DCL SYSPRINT FILE OUTPUT;                                                     
                                                                                
  P = ADDR(X);                                                                  
  Q = ADDR(Y);                                                                  
                                                                                
  OPEN FILE(SYSPRINT);                                                          
  PUT SKIP LIST('### INSIDE PL/I INMOD ROUTINE...');                            
  PUT SKIP LIST('STATUS =');                                                    
  PUT LIST(P->STATUS);                                                          
  PUT SKIP LIST('LENGTH =');                                                    
  PUT LIST(P->RLENGTH);                                                         
  PUT SKIP LIST('BUFFER =');                                                    
  PUT LIST(SUBSTR(P->BUFFER,1,30));                                             
  PUT SKIP LIST('SEQ =');                                                       
  PUT LIST(Q->SEQ);                                                             
  PUT SKIP LIST('PARM =');                                                      
  PUT LIST(SUBSTR(Q->PARAMETER,1,Q->LEN));                                      
                                                                                
  SELECT (P->STATUS);                                                           
                                                                                
    WHEN (6) DO; /* INITIALIZE */                                               
                 COUNT = 0;                                                     
                 REJROWS = 0;                                                   
                 INSROWS = 0;                                                   
                 P->STATUS = 0;                                                 
             END;                                                               
                                                                                
    WHEN (7) DO; /* PROCESS */                                                  
                 COUNT = COUNT + 1;                                             
                 NOTMATCH = 0;                                                  
                 P->STATUS = 0;                                                 
                 DO I = 1 TO Q -> LEN;                                          
                    IF SUBSTR(P->BUFFER,I,1) ^= SUBSTR(Q->PARAMETER,I,1)        
                       THEN DO;                                                 
                          NOTMATCH= 1;                                          
                          LEAVE;                                                
                       END;                                                     
                 END;                                                           
                 IF NOTMATCH = 1                                                
                    THEN DO;                                                    
                       PUT SKIP LIST('------> REJECTED <------');               
                       REJROWS = REJROWS + 1;                                   
                       P->RLENGTH = 0;                                          
                    END;                                                        
                 ELSE                                                           
                    DO;                                                         
                       PUT SKIP LIST('------> ACCEPTED <------');               
                       INSROWS = INSROWS + 1;                                   
                    END;                                                        
             END;                                                               
                                                                                
    WHEN (5) DO; /* FINALIZE */                                                 
                 P->STATUS = 0;                                                 
             END;                                                               
                                                                                
    OTHERWISE DO;                                                               
                 PUT SKIP LIST ('UNKNOWN CODE...');                             
                 P->STATUS = 99;                                                
             END;                                                               
  END;                                                                          
                                                                                
  PUT SKIP LIST('STATUS =');                                                    
  PUT LIST(P->STATUS);                                                          
  PUT SKIP LIST('LENGTH =');                                                    
  PUT LIST(P->RLENGTH);                                                         
  PUT SKIP LIST('TOTAL =');                                                     
  PUT LIST(COUNT);                                                              
  PUT SKIP LIST('INSERTS =');                                                   
  PUT LIST(INSROWS);                                                            
  PUT SKIP LIST('REJROWS =');                                                   
  PUT LIST(REJROWS);                                                            
  PUT SKIP LIST('---------------------------------------------------');         
  CLOSE FILE(SYSPRINT);                                                         
                                                                                
 END INMDPL2;                                                                   
//LKED.SYSPRINT DD SYSOUT=*                                                     
//LKED.PLIA     DD DISP=(OLD,DELETE),DSN=&&PLIA                                 
//LKED.SYSIN    DD *                                                            
  INCLUDE PLIA                                                                  
  ENTRY DYNAMN                                                                  
  NAME INMDPL2(R)