PL/I INMOD Example - MultiLoad

Teradata MultiLoad Reference

Product
MultiLoad
Release Number
15.10
Language
English (United States)
Last Update
2018-10-06
dita:id
B035-2409
lifecycle
previous
Product Category
Teradata Tools and Utilities

PL/I INMOD Example

 

          
          
        //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=&&PL1A,DISP=(,PASS),UNIT=SCR,                               
        //  SPACE=(CYL,(1,1)),DCB=(RECFM=FB,LRECL=80,BLKSIZE=3200)                      
        //SYSIN    DD   *                                                               
                 TITLE 'DYNAMN'                                                         
        DYNAMN   CSECT                                                                  
                 EXTRN PL1START                                                         
                 B     START-*(,R15)            BRANCH AROUND CONSTANTS                 
                 DC    AL1(L'PL1AFLAG)          LENGTH OF CONSTANTS                     
        PL1AFLAG DC    C'ASSEMBLED AT &SYSTIME ON &SYSDATE.. PL1A'                      
                 DC    C' COPYRIGHT (C) 1999 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(PL1START)                                                      
        *================================================================               
        *   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                                                          
            //PL1.SYSPRINT  DD SYSOUT=*                                                     
            //PL1.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.PL1A     DD DISP=(OLD,DELETE),DSN=&&PL1A                                 
            //LKED.SYSIN    DD *                                                            
            INCLUDE PL1A                                                                  
            ENTRY DYNAMN                                                                  
            NAME INMDPL2(R)
            //COPY EXEC PGM=IEBGENER 
            //SYSIN DD DUMMY
            //SYSPRINT DD SYSOUT=*
            //SYSUT2 DD DISP=(NEW,PASS),DSN=&&TEMP,UNIT=SYSDA,
            //          DCB=(LRECL=80,BLKSIZE=1760,RECFM=FB),
            //          SPACE=(CYL,(1,1),RLSE)
            //SYSUT1 DD DATA,DLM=@@
            ("SASC")  A0000000000000000000000000000A
            ("PASC")  A0000000000000000000000000000A
            ("COBOL") A0000000000000000000000000000A
            ("ASSEM") A0000000000000000000000000000A
            ("SASC")  B1111111111111111111111111111B
            ("PASC")  B1111111111111111111111111111B
            ("COBOL") B1111111111111111111111111111B
            ("ASSEM") B1111111111111111111111111111B
            ("SASC")  C2222222222222222222222222222C
            ("PASC")  C2222222222222222222222222222C
            ("COBOL") C2222222222222222222222222222C
            ("ASSEM") C2222222222222222222222222222C
            ("PL/I")  C2222222222222222222222222222C
            ("SASC")  D3333333333333333333333333333D
            ("PASC")  D3333333333333333333333333333D
            ("PL/I")  D3333333333333333333333333333D
            ("SASC")  E4444444444444444444444444444E
            ("PASC")  E4444444444444444444444444444E
            ("PL/I")  E4444444444444444444444444444E
            ("SASC")  F5555555555555555555555555555F
            ("PASC")  F5555555555555555555555555555F
            ("PL/I")  F5555555555555555555555555555F
            @@  
            //*******************************************************************
            //* THIS STEP WILL ONLY DROP THE TABLES IF MLOAD IS NOT IN APPLY    *
            //* PHASE                                                           *
            //*******************************************************************
            //CREATE   EXEC BTEQ 
            .LOGON TDP5/DMD,DMD;
            /* INMOD TEST CASE II - PL/I      */
            RELEASE MLOAD DMD.INMODPL2;
            .IF ERRORCODE = 2572 THEN .GOTO NODROP;
            DROP TABLE DMD.LOGTABLE;
            DROP TABLE DMD.ET_INMODPL2;
            DROP TABLE DMD.UV_INMODPL2;
            DROP TABLE DMD.WT_INMODPL2; 
            DROP TABLE DMD.INMODPL2;
            .QUIT;
            .LABEL NODROP;
            .EXIT 4;
            CREATE TABLE INMODPL2 (F1 CHAR(10), F2 CHAR(70)); 
            ##
            //*****************************************************************
            //*                                                               *
            //*   RUN MULTILOAD                                               *
            //*                                                               *
            //*****************************************************************
            //LOADIT   EXEC PGM=MLOAD,TIME=(,3)
            //STEPLIB  DD  DSN=STV.RG20.APPLOAD,DISP=SHR
            //         DD  DSN=STV.EG14MLL1.APP.L,DISP=SHR
            //         DD  DSN=STV.TG13BLD.APP.L,DISP=SHR
            //         DD  DSN=TER2.SASC450F.LINKLIB,DISP=SHR
            //         DD  DSN=*.STEP2.LKED.SYSLMOD,DISP=(OLD,PASS),
            //         VOL=REF=*.STEP2.LKED.SYSLMOD 
            //SYSPRINT DD  SYSOUT=*
            //SYSTERM  DD  SYSOUT=*
            //SYSOUT   DD  SYSOUT=*
            //INDATA   DD DISP=OLD,DSN=*.COPY.SYSUT2,DCB=(LRECL=80,RECFM=F),
            //         VOL=REF=*.COPY.SYSUT2
            //SYSIN    DD  DATA,DLM=##
            .LOGON TDP5/DMD,DMD;
            .LOGTABLE DMD.LOGTABLE_SFD;
            .BEGIN IMPORT MLOAD TABLES INMODPL2; 
            .Layout layname1; 
            .Field L1Fld1 1 Char(10); 
            .Field L1Fld2 * Char(30);
            .Field L1Fld3 * Char(40); 
            .DML Label DML1; 
            INSERT INMODPL2(F1,F2) VALUES (:L1FLD1, :L1FLD2); 
            .IMPORT INFILE INDATA
             INMOD INMDPL2 USING ("PL/I") LAYOUT LAYNAME1 APPLY DML1; 
            .End Mload; 
            .LOGOFF; 
            ##