//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; ##