COBOL

Expand all | Collapse all

User Defined Functions in Cobol 6.4

  • 1.  User Defined Functions in Cobol 6.4

    Posted Thu July 25, 2024 12:34 AM
    Edited by Hamidali Kottaparamban Thu July 25, 2024 09:25 PM

    Hello everyone,

    I've been experimenting with the Zowe extension in VSCode and trying to set up a sample for 'User-Defined Functions (UDF) in COBOL for z/OS 6.4.0,' as described here: IBM Documentation

     I'm still a bit unclear on how this feature can be used or how beneficial it could be. I just coded a sample UDF as given in IBM UDF - COBOL Function Example as my MAINPROG nd tried to compile and run it with a simple JCL as below:

    //HELLOCBL JOB 1,NOTIFY=&SYSUID //COBRUN EXEC IGYWCLG,SRC=MAINPROG

    This PROC IGYWCLG, is given for Compile, Link and Run the program passed in SRC parm. My code was compiled and linked, but it never gave me the expected display 'hello from mainprog, result=010230' in SYSOUT. The job ended okay with CC 0 I tried this IBM given example after my attempts to make up a bit more complex UDFs were all compiling, and I could see the loads were made to my load library, but their run didn't give any responses.

    Are there any blog posts or examples on how to effectively use "User-Defined Functions in COBOL 6.4"?

    Thanks!



    ------------------------------
    Hamidali Kottaparamban
    ------------------------------



  • 2.  RE: User Defined Functions in Cobol 6.4

    Posted Thu July 25, 2024 12:06 PM

    I'm not sure how your JCL even worked without error, as SRC is not a parameter for IGYWCLG.

    In any case, I did get it to compile/link/go by placing "SYSIN DD *" followed by the source code, in the JCL.  I still didn't get any output from the program.  This is because by default the entry point is the first source "program" compiled.  In this case the entry point is set to DOCALC (the function) rather than MAINPROG (the main program).  So, it you have to pass an "EP" parameter to the linkedit step.  Try the following:

    //HELLOCBL JOB 1,NOTIFY=&SYSUID                         
    //         JCLLIB ORDER=(IGY.SIGYPROC)                  
    //COBRUN EXEC IGYWCLG,LNGPRFX=IGY,GOPGM=MAINPROG,       
    //           PARM.LKED='EP=MAINPROG'                    
    //SYSIN  DD *                                           
    000100 Identification division.                         
    000200   Function-id. docalc.                           
    000300 Data division.                                   
    000400  Linkage section.                                
    000500   1 kind pic x(3).                               
    000600   1 argA pic 999.                                
    000700   1 argB pic v999.                               
    000800   1 res pic 999v999.                             
    000900 Procedure division                               
    001000     using by reference kind argA argB            
    001100     returning res.                               
    001200     if kind equal "add" then                     
    001300       compute res = argA + argB                  
    001400     end-if                                       
    001500     goback.                                      
    001600 End function docalc.                             
    001700 Identification division.                         
    001800   Program-id. 'mainprog'.                        
    001900 Environment division.                            
    002000  Configuration section.                          
    002100   Repository.                                    
    002200      function docalc.                            
    002300 Data division.                                   
    002400  Working-storage section.                        
    002500   1 result pic 999v999 usage display.            
    002600 Procedure division.                              
    002700     compute result = docalc("add" 10 0.23)       
    002800     display "hello from mainprog, result=" result
    002900     goback.                                      
    003000 End program 'mainprog'.
    //                            
    



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 3.  RE: User Defined Functions in Cobol 6.4

    Posted Thu July 25, 2024 10:03 PM

    Thank you Frank.

    I modified my JCL a bit as below to use IGYWCL., and set the entry point as my MAINPROG thru SYSIN as below

    //MAINPRGJ JOB ('FUNC'),MSGLEVEL=(1,1),NOTIFY=&SYSUID
    //***************************************************/
    //COBRUN  EXEC IGYWCL
    //COBOL.SYSIN  DD DSN=&SYSUID..CBL(MAINPROG),DISP=SHR
    //COBOL.SYSLIB DD DSN=&SYSUID..COPY,DISP=SHR
    //LKED.SYSLMOD DD DSN=&SYSUID..LOAD(MAINPROG),DISP=SHR
    //LKED.SYSIN DD *
       ENTRY MAINPROG
    //***************************************************/
    //***************************************************/
    //RUN     EXEC PGM=MAINPROG
    //STEPLIB   DD DSN=&SYSUID..LOAD,DISP=SHR
    //SYSOUT    DD SYSOUT=*
    //CEEDUMP   DD DUMMY
    //SYSUDUMP  DD DUMMY
    //***************************************************/

    BTW,  IGYWCLG was my starting point as shared for OpenMainframeProjects JCL as below for their sample  program called HELLO.

    //HELLOCBL JOB  1,NOTIFY=&SYSUID
    //COBRUN   EXEC IGYWCLG,SRC=HELLO
    

    Next up for me to try the function as PROTOTYPE, and see if I can dynamically call it from any module as we call intrinsic functions. Please let me know if anyone had some luck experimenting the Function Prototypes.



    ------------------------------
    Hamidali Kottaparamban
    ------------------------------



  • 4.  RE: User Defined Functions in Cobol 6.4

    Posted Fri July 26, 2024 11:42 PM
    Edited by Frank Swarbrick Sat July 27, 2024 04:09 PM

    Here's one I wrote for a project I'm currently working on.  There are three separate source files.  One for the prototype, one for the function itself, and once for the main/test program.

    * member name = PROTOTYP
    
     identification division.                                 
     function-id. hhmmss-from-seconds as 'HHMMSS' is prototype
         entry-interface is dynamic                          
         entry-name is longupper.                             
     data division.                                           
     linkage section.                                         
     01  seconds                     comp-2.                  
     01  hhmmss                      pic 9(6) comp-5.         
     procedure division using seconds returning hhmmss.       
     end function hhmmss-from-seconds.                        

     copy prototyp suppress.                                      
                                                                  
     identification division.                                     
     function-id. hhmmss-from-seconds as 'HHMMSS'.                
                                                                  
     environment division.                                        
     configuration section.                                       
     repository.                                                  
         function all intrinsic.                                  
                                                                  
     data division.                                               
     local-storage section.                                       
     01  hours                       pic 99v9(6) comp-5.          
     01  minutes                     pic 99v9(6) comp-5.          
     01  seconds                     pic 99v9(6) comp-5.          
                                                                  
     linkage section.                                             
     01  seconds-in                  comp-2.                      
     01  hhmmss                      pic 9(6) comp-5.             
                                                                  
     procedure division using seconds-in returning hhmmss.        
         compute hours = seconds-in / 3600                        
         compute minutes = (hours - integer-part(hours)) * 60     
         compute seconds = (minutes - integer-part(minutes)) * 60 
         compute hhmmss = (integer-part(hours) * 10000)           
                        + (integer-part(minutes) * 100)           
                        + integer-part(seconds)                   
         goback.                                                  
                                                                  
     end function hhmmss-from-seconds.                            

     copy prototyp suppress.                                         
                                                                     
     identification division.                                        
     program-id. dttmmain.                                           
                                                                     
     environment division.                                           
     configuration section.                                          
     repository.                                                     
         function hhmmss-from-seconds                                
         function all intrinsic.                                     
                                                                     
     data division.                                                  
     working-storage section.                                        
     01  timestamp                   pic x(29).                      
     01  date-mmdd                   pic 9(4).                       
     01  time-hhmm                   pic 9(4).                       
                                                                     
     procedure division.                                             
         accept timestamp                                            
         compute date-mmdd = date-of-integer(                        
                                 integer-of-formatted-date(          
                                     "YYYY-MM-DDThh:mm:ss.sss+hh:mm" 
                                     timestamp))                     
         compute time-hhmm =                                         
                 integer-part(                                       
                     hhmmss-from-seconds(                            
                         function seconds-from-formatted-time(       
                             "YYYY-MM-DDThh:mm:ss.sss+hh:mm"         
                              timestamp)) / 100)                     
         display date-mmdd space time-hhmm                           
         goback.                                                     
                                                                     
     end program dttmmain.                                           

    Note that you can have more than one prototype in a source member.  (Not shown here.)  Well, for that matter, you can have more than one function, and even more than one program, in a source member.  Something to utilize when it makes sense.

    Something for IBM Cobol personnel:  I had to specify the FUNCTION keyword for the seconds-from-formatted-time function, even though I have "function all intrinsic" in the repository.  It looks like this function was missed.



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 5.  RE: User Defined Functions in Cobol 6.4

    Posted Sat July 27, 2024 06:04 PM

    FUNCTION ALL INTRINSIC would just let you to skip using FUNCTION keyword right before all built in functions. I will try your code with  just the user defined function under repository para, and see if it works.



    ------------------------------
    Hamidali Kottaparamban
    ------------------------------



  • 6.  RE: User Defined Functions in Cobol 6.4

    Posted Mon July 29, 2024 08:02 AM
    Hi Frank,

    Yes, seconds-from-formatted-time does appear to be missing from the list of intrinsic functions. I've opened a work item for development to correct this.

    Bernie

    _________________________________________

    Bernie Rataj

    Technical Support Professional

    Enterprise COBOL & PL/I for z/OS Technical Support

    905-413-2857  brataj@ca.ibm.com

     

    https://www.ibm.com/products/cobol-compiler-zos

    https://www.ibm.com/products/pli-compiler-zos 

     






  • 7.  RE: User Defined Functions in Cobol 6.4

    Posted Mon July 29, 2024 06:04 PM

    Another "issue".  Currently it appears that the OMITTED keyword is not being allowed when doing a function call.  According to the 2002 standard this should be allowed.  Is this anywhere on the roadmap, or do I need to make an official request for it?



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 8.  RE: User Defined Functions in Cobol 6.4

    Posted Sat July 27, 2024 04:40 PM

    By the way, if you use prototypes and then have the function in a separate compile unit from the main program, you shouldn't need an ENTRY statement, because there will no longer be any CSECTs before the main program.



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 9.  RE: User Defined Functions in Cobol 6.4

    Posted Tue July 30, 2024 11:16 AM

    Hi Frank,

    re: OMITTED, it is not yet in plan and yes! - it would help if you can please open a request in the ideas portal to bring it to attention.  Link: https://ideas.ibm.com/

    Also note: this is closely related to the OMITTED argument on the CALL statement, which is also not supported yet.  We did have a request for this one already (I believe you may have opened it :) ) but it was rejected as not a priority...this was a while ago...but we are keeping track of it internally.  https://ibm-z-software-portal.ideas.ibm.com/ideas/COBOLVUE-I-48



    ------------------------------
    Jeffery Shimoda
    ------------------------------



  • 10.  RE: User Defined Functions in Cobol 6.4

    Posted Tue July 30, 2024 12:26 PM

    Just opened https://ibm-z-software-portal.ideas.ibm.com/ideas/COBOLVUE-I-396.  Thanks.



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 11.  RE: User Defined Functions in Cobol 6.4

    Posted Wed July 31, 2024 08:42 AM

    Hi,

    If I may intervene in this conversation... I can also open a dedicated conversation.

    We want to use "user function prototype" to interface routines in C language, in particular to access the file opening/reading/writing/closing functions, to do real dynamic file management in COBOL, (BPXWDYN allows to allocate files, but then we cannot access them in reading or writing except by using a COBOL declaration of the file).

    This use case is mentioned in the reference documentation, but no example is provided.

    Would it be possible to have an example of a call to a C function via a "user function prototype" declaration?

    Thank you.



    ------------------------------
    Denis FALLAI
    BPCE SI, BPCE group.
    ------------------------------



  • 12.  RE: User Defined Functions in Cobol 6.4

    Posted Wed July 31, 2024 01:11 PM

    Here are a few examples I've been working with:

    000100 identification division.                                         COBOL6.4
    000200 function-id. perror as 'perror' is prototype
    000300     entry-interface is static
    000400     entry-name is longmixed.
    000500 data division.
    000600 linkage section.
    000700 01  str                     pic x(1024).
    000800 01  dummy-ptr               pointer.
    000900 procedure division using str
    001000                    returning dummy-ptr.
    001100 end function perror.
    001200
    001300 identification division.                                         COBOL6.4
    001400 function-id. fopen as 'fopen' is prototype
    001500     entry-interface is static
    001600     entry-name is longmixed.
    001700 data division.
    001800 linkage section.
    001900 01  filename                pic x(1024).
    002000 01  filemode                pic x(255).
    002100 01  fileptr                 pointer.
    002200 procedure division using filename filemode
    002300                    returning fileptr.
    002400 end function fopen.
    002500
    002600 identification division.                                         COBOL6.4
    002700 function-id. fread as 'fread' is prototype
    002800     entry-interface is static
    002900     entry-name is longmixed.
    003000 data division.
    003100 linkage section.
    003200 01  readcnt                 pic s9(9) comp-5.
    003300 01  bufptr                  pointer.
    003400 01  len                     pic s9(9) comp-5.
    003500 01  cnt                     pic s9(9) comp-5.
    003600 01  fileptr                 pointer.
    003700 procedure division using value bufptr len cnt fileptr
    003800                    returning readcnt.
    003900 end function fread.
    004000
    004100 identification division.                                         COBOL6.4
    004200 function-id. fclose as 'fclose' is prototype
    004300     entry-interface is static
    004400     entry-name is longmixed.
    004500 data division.
    004600 linkage section.
    004700 01  fileptr                 pointer.
    004800 01  result                  pic s9(9) comp-5.
    004900 procedure division using value fileptr
    005000                    returning result.
    005100 end function fclose.
    005200
    005300 identification division.                                         COBOL6.4
    005400 function-id. printf as 'printf' is prototype
    005500     entry-interface is static
    005600     entry-name is longmixed.
    005700 data division.
    005800 linkage section.
    005900 01  fmt                     pic x(100).
    006000 01  num                     pic s9(9) comp-5.
    006100 01  out                     pic x(10000).
    006200 01  result                  pic s9(9) comp-5.
    006300 procedure division using reference fmt
    006400                          value num
    006500                          reference out
    006600                    returning result.
    006700 end function printf.
    006800
    006900 identification division.                                         COBOL6.4
    007000 function-id. errnoptr as '__errno' is prototype
    007100     entry-interface is static
    007200     entry-name is longmixed.
    007300 data division.
    007400 linkage section.
    007500 01  ep                      pointer.
    007600 procedure division returning ep.
    007700 end function errnoptr.
    007800
    007900 identification division.                                         COBOL6.4
    008000 function-id. errno is prototype
    008100     entry-interface is static
    008200     entry-name is longupper.
    008300 data division.
    008400 linkage section.
    008500 01  errno-val                  pic z(8)9.
    008600 procedure division returning errno-val.
    008700 end function errno.

    A few notes:

    1. printf, as declared here, will work only with a 3 parameters, a format string, a number, and another string.  COBOL prototypes (from what I can tell) don't support C style varargs.
    2. The errnoptr prototype accesses the __errno pointer to errno.  I wrote a small function ERRNO (prototype also show here) to address the pointer and return the actual value of errno.  I'll show it below.
    3. Remember that C only passes by value.  The only reason I can pass a "string" by reference is because a string is actually the address of (reference to) the string.

    000200 copy cprotos suppress.
    000300 identification division.                                         COBOL6.4
    000400 function-id. errno
    000500     entry-name is longupper.
    000600 data division.
    000700 linkage section.
    000800 01  errno-val                  pic z(8)9.
    000900 01  errno-num                  pic s9(9) comp-5.
    001000 procedure division returning errno-val.
    001100     set address of errno-num to function errnoptr
    001200     move errno-num to errno-val.
    001300     goback.
    001400 end function errno.

    CPROTOS copybook contains all of the prototypes shown earlier.  While you don't need to include it's prototype when defining a function, it's a good idea to do so, to make sure your function actually conforms to your prototype.

    Here they are in use:

     open-crd.                                                         
         string "//'" trim(dslib) "(" trim(member) ")" z"'"            
                delimited by size into dsname                          
         set fp to fopen(content-of(dsname) z"rb")                     
         if fp = null                                                  
             set dummy-p to perror(z"open copybook")                   
             move 16 to return-code                                    
             stop run                                                  
         end-if                                                        
         exit.                                                         
                                                                       
     read-crd.                                                         
         compute crdlen = fread(address of crd 1 length(crd) fp)       
         if crdlen < zero                                              
             set dummy-p to perror(z"read copybook")                   
             move 16 to return-code                                    
             stop run                                                  
         end-if                                                        
         display crdlen                                                
         exit.                                                         
                                                                       
     close-crd.                                                        
         if fclose(fp) < zero                                          
             set dummy-p to perror(z"close copybook")                  
             move 16 to return-code                                    
             stop run                                                  
         end-if                                                        
         exit.                                                         
    

    Also:

        if printf(z"**doc** %.*s" doclen content-of(doc)) < 0 
            display errno                                     
            set dummy-p to perror(z"printf doc")              
            move 16 to return-code                            
            stop run                                          
        end-if                                                



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 13.  RE: User Defined Functions in Cobol 6.4

    Posted Wed July 31, 2024 02:40 PM

    I don't know if there is much advantage of calling BPXWDYN regularly vs calling it as a function.  But below is an example of both.

    000100 identification division.                                         COBOL6.4
    000200 function-id. dd-dynamic-alloc as 'BPXWDYN' is prototype
    000300     entry-interface is dynamic.
    000400 data division.
    000500 linkage section.
    000600 01  parm                 pic x(254).
    000700 01  rc                   pic s9(9) comp-5.
    000800 procedure division using parm returning rc.
    000900 end function dd-dynamic-alloc.
    001000
    001100 identification division.                                         COBOL6.4
    001200 program-id. dyndd.
    001300
    001400 environment division.
    001500 configuration section.
    001600 repository.
    001700     function dd-dynamic-alloc
    001800     function all intrinsic.
    001900
    002000 data division.
    002100 working-storage section.
    002200 01  ddname               pic x(8).
    002300 01  dsname               pic x(44).
    002400 01  wdyn-parm            pic x(100) value spaces.
    002500 01  rc                   pic s9(8) comp-5.
    002600 01  redefines rc.
    002700     05  rcx              pic xx occurs 2.
    002800
    002900 procedure division.
    003000     move 'FJS00001' to ddname
    003100     move 'DATA1.TXT' to dsname
    003200     string "alloc "
    003300            "file(" trim(ddname) ")" space
    003400            "dataset(" trim(dsname) ")" space
    003500            "shr "
    003600            "msg(2)"
    003700            z''
    003800            delimited by size
    003900            into wdyn-parm
    004000     display wdyn-parm
    004100     perform allocate-via-call
    004200     perform allocate-via-function
    004300     goback.
    004400
    004500 allocate-via-call.
    004600 >>callint dynamic
    004700     call 'BPXWDYN' using wdyn-parm returning rc
    004800 >>callint
    004900     display rc space hex-of(rcx(1)) space hex-of(rcx(2))
    005000     exit.
    005100
    005200 allocate-via-function.
    005300     compute rc = dd-dynamic-alloc(content-of(wdyn-parm))
    005400     display rc space hex-of(rcx(1)) space hex-of(rcx(2))
    005500     exit.
    005600
    005700 end program dyndd.
    

    Note that this is returning an error (in rc) in both cases (same error), so I must have the input incorrect somehow.  Not sure what the issue is, and I've never used dynamic allocation in a program that works.



    ------------------------------
    Frank Swarbrick
    ------------------------------



  • 14.  RE: User Defined Functions in Cobol 6.4

    Posted Thu August 01, 2024 12:52 PM

    Hi Franck,

    Thank you very much, the examples correspond exactly to what we wanted to set up.
    The BPXWDYN interface allows you to allocate or deallocate files by dynamically managing the DSNAME, but you still need a file declaration in the COBOL program to be able to read or write in these files.
    With the interface to C functions fopen, fread, fwrire, fclose it is possible to do the allocation / deallocation dynamically, but in addition to be able to read and write in these files without having to declare them at the COBOL program level.
    The need arises when you have to manage in parallel an unknown number of files in advance: for example, a data flow splitting or grouping program.

    Best regards,



    ------------------------------
    Denis FALLAI
    BPCE SI, BPCE group.
    ------------------------------



  • 15.  RE: User Defined Functions in Cobol 6.4

    Posted Wed August 07, 2024 07:37 AM
    Edited by Denis FALLAI Wed August 07, 2024 07:37 AM

    Hi Franck,

    dataset is an illegal keyword in bpxwdyn allocate command: you must use da or dsn.



    ------------------------------
    Denis FALLAI
    BPCE SI, BPCE group.
    ------------------------------



  • 16.  RE: User Defined Functions in Cobol 6.4

    Posted Wed August 07, 2024 01:07 PM

    Hi Frank,

    For performance reasons, it's highly recommended to call entry point BPXWDY2 of BPXWDYN as it preserves the program mask, especially if you're running ARCH(12) or earlier.

    Bernie



    ------------------------------
    Bernie Rataj
    Technical Support Professional
    IBM Canada Ltd.
    Markham

    https://www.ibm.com/products/cobol-compiler-zos
    https://www.ibm.com/products/pli-compiler-zos
    ------------------------------



  • 17.  RE: User Defined Functions in Cobol 6.4

    Posted Wed August 07, 2024 02:01 PM

    Here's what I have now, with changes as per Denis and Bernie, and also actually utilizing the allocated DD.

     identification division.                             
     function-id. dd-dyn as 'BPXWDY2' is prototype        
         entry-interface is dynamic.                      
     data division.                                       
     linkage section.                                     
     01  parm-ptr             pointer.                    
     01  rc                   pic s9(9) comp-5.           
     procedure division using value parm-ptr returning rc.
     end function dd-dyn.                                 
                                                          
     process dynam                                        
     identification division.                             
     program-id. dyndd.                                   
                                                          
     environment division.                                
     configuration section.                               
     repository.                                          
         function dd-dyn                                  
         function all intrinsic.                          
                                                          
     input-output section.                                
     file-control.                                        
         select my-dyn assign to FJS00001.                
                                                          
     data division.                                       
     file section.                                        
     fd  my-dyn.                                          
     01  my-dyn-rec           pic x(80).                  
                                                          
     working-storage section.                             
     01  ddname               pic x(8).                   
     01  dsname               pic x(44).                  
     01  wdyn-parm            pic x(100) value spaces.    
     01  rc                   pic s9(8) comp-5.           
     01  redefines rc.                                       
         05  rcx              pic xx occurs 2.               
                                                             
     procedure division.                                     
         move 'FJS00001' to ddname                           
         move "'DVFJS.DATA1.TXT'" to dsname                  
         perform alloc-dd                                    
         open output my-dyn                                  
         move 'This is test' to my-dyn-rec                   
         write my-dyn-rec                                    
         close my-dyn                                        
         perform free-dd                                     
         goback.                                             
                                                             
     alloc-dd.                                               
         string "ALLOC FILE(" trim(ddname) ")" space         
                "DSN(" trim(dsname) ")" space z"SHR MSG(2)"  
                delimited by size into wdyn-parm             
         display wdyn-parm                                   
         perform wdyn-via-func                               
         exit.                                               
                                                             
     free-dd.                                                
         string "FREE DD(" trim(ddname) ")" space z"MSG(2)"  
                delimited by size into wdyn-parm             
         display wdyn-parm                                   
         perform wdyn-via-call                               
         exit.                                               
                                                             
     wdyn-via-call.                                          
         call 'BPXWDY2' using wdyn-parm returning rc         
         display rc space hex-of(rcx(1)) space hex-of(rcx(2))
         exit.                                               
                                                             
     wdyn-via-func.                                          
         compute rc = dd-dyn(address of wdyn-parm)                 
         display rc space hex-of(rcx(1)) space hex-of(rcx(2))      
         exit.                                                     
                                                                   
     end program dyndd.                                            
    

    Note that I also changed the prototype parameter to be a "pointer by value" rather than a "string by reference", since this is more in line with how C works.



    ------------------------------
    Frank Swarbrick
    ------------------------------