FALSE

Page Nav

HIDE

Grid

GRID_STYLE

PL/I Sample program's 2

//TRGA06SM JOB NOTIFY=TRGA06,PRTY=14               //STEP1 EXEC PGM=PL1EX9                           //STEPLIB DD DSN=TRGA06.MAGESH.LOADLI...

//TRGA06SM JOB NOTIFY=TRGA06,PRTY=14              
//STEP1 EXEC PGM=PL1EX9                          
//STEPLIB DD DSN=TRGA06.MAGESH.LOADLIB,DISP=SHR  
//SYSPRINT DD SYSOUT=A                            
//SYSOUT DD SYSOUT=A                              
//SYSIN DD DUMMY                                  

**********************************************************
 MAINSUB:PROC OPTIONS(MAIN) REORDER;                      
 DCL INFILE FILE INPUT RECORD;                            
 DCL OUTFILE FILE RECORD OUTPUT ENV(F RECSIZE(80));      
 DCL ENDFILE BUILTIN;                                    
 DCL 01 INREC,                                            
     05 LINE1 CHAR(80);                                  
 DCL EOF BIT(1) INIT('1'B);                              
 ON ENDFILE EOF='0'B;                                    
 OPEN FILE(INFILE);                                      
 OPEN FILE(OUTFILE);                                      
 READ FILE(INFILE) INTO (INREC);                          
 DO WHILE(EOF);                                          
 WRITE FILE(OUTFILE) FROM (INREC);                        
 READ FILE(INFILE) INTO (INREC);                          
 END;                                                    
 CLOSE FILE(INFILE);  
 CLOSE FILE(OUTFILE);  
 END MAINSUB;                                            
********************************************************

//TRGA06SM JOB NOTIFY=TRGA06                      
//STEP1 EXEC PGM=PLISJCL                          
//STEPLIB DD DSN=TRGA06.MAGESH.LOADLIB,DISP=SHR    
//INFILE DD DSN=TRGA06.MAGESH.PLISAM(SA),DISP=SHR  
//OUTFILE DD SYSOUT=(A,INTRDR)                    
//SYSPRINT DD SYSOUT=A                            
//SYSIN DD DUMMY                                  

******************************************************
          INTERNAL PROCEDURE
INPRO:PROC OPTIONS(MAIN) REORDER;     
CALL ST;                              
ST:PROC;                              
PUT SKIP LIST('I AM FROM HTC');       
END ST;                               
END INPRO;                  
*************************************************************
     BUILTIN
BLDIN:PROC OPTIONS(MAIN) REORDER;                            
DCL VERIFY BUILTIN;                                          
DCL SUBSTR BUILTIN;                                          
DCL TRANSLATE BUILTIN;                                       
DCL STRING BUILTIN;                                          
DCL STR CHAR(12) INIT('MOWLEESWARAN');                       
IF VERIFY('1237','123456') THEN                              
    PUT SKIP LIST('FALSE');                                  
ELSE                                                         
    PUT SKIP LIST('TRUE');                                   
PUT SKIP LIST('VALUE IS:',VERIFY('D','ABC'));                
PUT SKIP LIST('VALUE IS:',VERIFY('ABD ','ABCD'));            
PUT SKIP LIST('VALUE IS:',INDEX('AXDEFGH','XDY'));           
PUT SKIP LIST('LENGTH OF STRING:',LENGTH('MOWLEESWARAN'));   
PUT SKIP LIST('TRANSLATE :', TRANSLATE(STR,'E','U'));        
PUT SKIP LIST(STR);                                          
PUT SKIP LIST('STR IS:',SUBSTR(STR,6,5));  
DCL 01 REC,                                 
       02 EID CHAR(4) INIT('1001'),         
       02 ENAME CHAR(5) INIT('KAR');        
DCL VAR CHAR(9);                            
VAR=STRING(REC);                            
PUT SKIP LIST(VAR);                         
END BLDIN;                                  
************************************************************
      EXTERNAL AND INTERNAL PROC
INPRO:PROC OPTIONS(MAIN) REORDER;    
CALL ST;                             
ST:PROC;                             
PUT SKIP LIST('I AM FROM HTC');      
END ST;                              
PROC1:PROC(MSG);                     
DCL MSG CHAR(20) VARYING;            
DCL EXTSUB EXTERNAL ENTRY;           
PUT SKIP LIST(MSG);                  
CALL EXTSUB;                         
END PROC1;                           
CALL PROC1('MAINFRAME');             
END INPRO;                           

           EXTSUB
        ______________
 EXTSUB:PROC;                      
 PUT SKIP LIST('EXTERNAL PROC');   
 END EXTSUB;                       
************************************************************    
INPRO:PROC OPTIONS(MAIN) REORDER;    
CALL ST;                             
ST:PROC;                             
PUT SKIP LIST('I AM FROM HTC');      
END ST;                              
PROC1:PROC(MSG);                     
DCL MSG CHAR(20) VARYING;            
DCL EXTSUB ENTRY;                    
PUT SKIP LIST(MSG);                  
CALL EXTSUB('MOULI',2000);           
END PROC1;                           
CALL PROC1('MAINFRAME');             
END INPRO;                           

      EXTSUB
    *************
EXTSUB:PROC(MSG,NUM);           
DCL MSG CHAR(10) VARYING;       
DCL NUM FIXED DECIMAL(5,0);     
DCL RES PIC '(10)9';            
PUT SKIP LIST('EXTERNAL PROC'); 
PUT SKIP LIST('MSG:',MSG);      
PUT SKIP LIST('NUM:',NUM);      
RES = NUM;                      
PUT SKIP LIST('RES:',RES);      
END EXTSUB;                     
***********************************************************

INPRO:PROC OPTIONS(MAIN) REORDER;          
CALL ST;                                   
ST:PROC;                                   
PUT SKIP LIST('I AM FROM HTC');            
END ST;                                    
PROC1:PROC(MSG);                           
DCL MSG CHAR(20) VARYING;                  
DCL EXTSUB RETURNS(FIXED DEC(5,0)) ENTRY;  
PUT SKIP LIST(MSG);                        
PUT SKIP LIST(CALL EXTSUB('MOULI',2000));  
END PROC1;                                 
CALL PROC1('MAINFRAME');                   
END INPRO;                                 
          EXTSUB
        ***********
EXTSUB:PROC(MSG,NUM) RETURNS(FIXED DECIMAL(5,0)); 
DCL MSG CHAR(10) VARYING;                         
DCL NUM FIXED DECIMAL(5,0);                       
DCL N FIXED DECIMAL(5,0);                         
DCL RES FIXED DECIMAL(5,0);                       
PUT SKIP LIST('EXTERNAL PROC');                   
PUT SKIP LIST('MSG:',MSG);                        
PUT SKIP LIST('NUM:',NUM);                        
RES = NUM;                                        
N=RES+NUM;                                        
PUT SKIP LIST('RES:',RES);                        
RETURN (N);                                       
END EXTSUB;                                       
*************************************************************
          GOTO
LOOPEND:PROC OPTIONS(MAIN) REORDER;        
  DCL I FIXED BIN(15,0);                   
  DO WHILE(I<10);                          
     PUT SKIP LIST(I);                     
     IF I=6 THEN                           
        GOTO P1;                           
    I=I+1;                                 
  END;                                     
P1:                                        
  PUT SKIP LIST('MOULI');                  
END LOOPEND;                               
**************************************************************
         STATIC AND AUTOMATIC
 STOR:PROC OPTIONS(MAIN) REORDER;                
    DCL STR CHAR(10) INIT('MOULI');              
    P1:PROC;                                     
    DCL A FIXED BIN(15,0) INIT(100);             
    DCL S FIXED BIN(15,0) INIT(200) STATIC;      
       A=A+1;                                    
       S=S+1;                                    
       PUT SKIP LIST(A);                         
       PUT SKIP LIST(S);                         
       PUT SKIP LIST(STR);                       
    END;                                         
    CALL P1;                                     
    CALL P1;                                     
 END STOR;                   
**************************************************************
         POINTER WITH VARIABLE
PTR1:PROC OPTIONS(MAIN) REORDER;                  
   DCL P PTR;                                     
   DCL A CHAR(6) INIT('MOULI');/*BASED (P);*/     
   DCL B CHAR(6) BASED (P);                       
   P=ADDR(A);                                     
   PUT SKIP LIST(B);  /*MOULI*/                   
   PUT SKIP LIST(A);  /*MOULI*/                   
   B='MADDYY';                                    
   PUT SKIP LIST(B);  /*MADDYY*/                  
   PUT SKIP LIST(A);  /*MADDYY*/                  
END PTR1;                                         
***********************************************************
       POINTER
PTR1:PROC OPTIONS(MAIN) REORDER;             
   DCL P PTR;                                
   DCL A CHAR(6) INIT('MOULI');/*BASED (P);*/
   DCL B CHAR(6) BASED (P);                  
   DCL C CHAR(10);                           
   P=ADDR(A);                                
   PUT SKIP LIST(B);  /*MOULI*/              
   PUT SKIP LIST(A);  /*MOULI*/              
   B='MADDYY';                               
   P=ADDR(C);                                
   PUT SKIP LIST(B);  /*     */             
   PUT SKIP LIST(A);  /*MADDYY*/             
   PUT SKIP LIST(C);  /*     */                       
END PTR1;                 
*************************************************************
     POINTER
 PTR1:PROC OPTIONS(MAIN) REORDER;                   
    DCL P PTR;                                      
    DCL A CHAR(6) INIT('MOULI');/*BASED (P);*/      
    DCL B CHAR(6) BASED (P);                        
    DCL C CHAR(10) BASED (P);                       
    P=ADDR(A);                                      
    PUT SKIP LIST(B);  /*MOULI*/                    
    PUT SKIP LIST(A);  /*MOULI*/                    
    B='MADDYY';                                     
    PUT SKIP LIST(B);  /*MADDYY*/                   
    PUT SKIP LIST(A);  /*MADDYY*/                   
    PUT SKIP LIST(C);  /*MADDYY*/                   
    C='ESWARAN';                                    
    PUT SKIP LIST(B);  /*ESWARA*/                   
    PUT SKIP LIST(A);  /*ESWARA*/                   
    PUT SKIP LIST(C);  /*ESWARAN*/                  
 END PTR1;                                          
**************************************************************
PTR1:PROC OPTIONS(MAIN) REORDER;                
   DCL P PTR;                                   
   DCL A CHAR(6) INIT('MOULI');/*BASED (P);*/   
   DCL B CHAR(6) BASED (P);                     
   DCL C CHAR(10) INIT('SSSSSS') BASED (P);     
   P=ADDR(A);                                   
   PUT SKIP LIST(B);  /*MOULI*/                 
   PUT SKIP LIST(A);  /*MOULI*/                 
   PUT SKIP LIST(C);  /*MOULI*/                          
   B='MADDYY';                                  
   PUT SKIP LIST(B);  /*MADDYY*/                
   PUT SKIP LIST(A);  /*MADDYY*/                
   PUT SKIP LIST(C);  /*MADDYY*/                
   C='ESWARAN';                                 
   PUT SKIP LIST(B);  /*ESWARA*/                
   PUT SKIP LIST(A);  /*ESWARA*/                
   PUT SKIP LIST(C);  /*ESWARAN*/               
END PTR1;                       
**************************************************************
       SEARCH
 SRCH:PROC OPTIONS(MAIN) REORDER;                             
   DCL SRC CHAR(50) INIT('EXT SUBROUTINE IS SUBROUTINE');     
   DCL SUBSTR BUILTIN;                                        
   DCL LENGTH BUILTIN;                                        
   DCL INDEX BUILTIN;                                         
   DCL TEMP FIXED BIN(15,0) INIT(0);                          
   DCL LEN FIXED BIN(15,0) INIT(0);                           
   PUT SKIP LIST(LENGTH(SRC));                                
   DO WHILE(INDEX(SRC,'SUBROUTINE'));                         
      TEMP=TEMP+1;                                            
      SRC=SUBSTR(SRC,INDEX(SRC,'SUBROUTINE')+1);              
   END;                                                       
   PUT SKIP LIST(TEMP);                                       
 END SRCH;                                                    
*****************************************************************                                         
         FILE WITH POINTERS
FILEPTR:PROC OPTIONS(MAIN) REORDER;         
DCL INFILE FILE RECORD INPUT;               
DCL OUTFILE FILE RECORD OUTPUT;             
DCL P PTR;                                  
DCL Q PTR;                                  
DCL 01 INREC BASED (P),                     
       02 EID FIXED BIN(15,0),              
       02 ENAME CHAR(10),                   
       02 DESIG CHAR(10),                   
       02 FILLER CHAR(58);                  
DCL 01 OUTREC BASED (Q),                    
       02 EID FIXED BIN(15,0),              
       02 ENAME CHAR(10),                   
       02 DESIG CHAR(10),                   
       02 FILLER CHAR(58);                  
DCL EOF BIT(1) INIT('1'B);                  
ON ENDFILE (INFILE) EOF='0'B;               
READ FILE(INFILE)SET(P);              
DO WHILE(EOF);                        
   LOCATE OUTREC FILE(OUTFILE)SET(Q); 
   OUTREC=INREC;                      
   READ FILE(INFILE)SET(P);           
END;                                  
END FILEPTR;                          
***************************************************************
           CONTROLLED
 CONTRL:PROC OPTIONS(MAIN) REORDER;          
 DCL A CHAR(6) INIT('MOULI') CONTROLLED;     
 ALLOCATE A;                                 
 PUT SKIP LIST('VALUE:',A);      ==>MOULI            
 FREE A;                                     
 PUT SKIP LIST('VALUE:',A);      ==>NO O/P            
 END CONTRL;                                 
*****************************************************************

No comments