cob_field and runtime reflection

GnuCOBOL
2014-06-21
2014-06-24
  • Brian Tiffin

    Brian Tiffin - 2014-06-21

    It's built into the COBOL CALL sequence, and is ripe for exploitation; a shadow argument structure providing access to cob_field definitions, not just the raw data.

    This is early works, (as per usual) and isn't as fleshed out as it will be on a second cut. (This cut assumes 64bit, will bork hard on 32).

    First some C, part of the "getting to grips" phase

    /**
     * reflective properties of GNU Cobol
     */
    
    #include <stdio.h>
    #include <stddef.h>
    #include <libcob.h>
    
    int
    creflect(void *passed_value)
    {
        cob_global              *cobol_global;
        cob_module              *cobol_module;
        cob_field               **cobol_fields;
        cob_field               *cobol_field;
        size_t                  cobol_size;
    
        cobol_global = cob_get_global_ptr();
        cobol_module = cobol_global->cob_current_module;
        cobol_fields = cobol_module->cob_procedure_params;
        cobol_field = cobol_fields[0];
        cobol_size = cobol_fields[0]->size;
    
        printf("global: 0x%016x\n", cobol_global);
        printf("module: 0x%016x\n", cobol_module);
        printf(" csize: %d %d %d\n", cobol_size, sizeof(cobol_size), offsetof(cob_global, cob_current_module));
    }
    

    and then a test head in COBOL, two part, a caller main, and a supporting called subprogram that will squirrel into the shadow data structures.

    GNU    >>SOURCE FORMAT IS FIXED
    Cobol *> ***************************************************************
          *> Author:    Brian Tiffin
          *> Date:      20140621
          *> Purpose:   cob_global and down, cob_module, cob_call_params
          *> Tectonics: cobc -x reflect.cob creflect.c
          *> ***************************************************************
    id     identification division.
           program-id. reflect.
    
           environment division.
           configuration section.
           repository.
               function all intrinsic.
    
          *> ***************************************************************
    code   procedure division.
    
          *> C function isn't necessary, a crutch while exploring
           display "C point of view" end-display
           call "creflect" using by reference "abcde"
               on exception display "not linked: creflect.c" end-display
           end-call
           display space end-display
    
           display "COBOL point of view" end-display
           call "reflective" using by reference "ABCDE" end-call
    done   goback.
           end program reflect.
    
          *> ***************************************************************
          *> ***************************************************************
    
           identification division.
    id     program-id. reflective.
    
           environment division.
           configuration section.
           repository.
               function all intrinsic.
    
    data   data division.
           working-storage section.
           01 cobol-linkage        usage pointer.
           01 cobol-global         usage pointer.
           01 cobol-deref          usage pointer based.
           01 cobol-module         usage pointer based.
           01 cobol-fields         usage pointer based.
           01 cobol-field          usage pointer based.
           01 cobol-size           usage binary-long based.
           01 cobol-data           usage pointer based.
           01 cobol-buffer         pic x(5) based.
           01 cobol-attr           usage pointer based.
           01 cobol-attributes     usage binary-short based.
    
           linkage section.
           01 linkage-value        pic x(5).
    
    code   procedure division using linkage-value.
    
          *> show the normal COBOL view
           display "passed: " linkage-value end-display
    
           set cobol-linkage to address of linkage-value
           display "    at: " cobol-linkage end-display
    
          *> get the runtime global structure pointer
           call "cob_get_global_ptr" returning cobol-global end-call
           display "global: " cobol-global end-display
    
          *> skip over the cob_error_file pointer and dereference
           set cobol-global up by 8
           set address of cobol-deref to cobol-global
           display " deref: " cobol-deref end-display
    
          *> this derefed pointer is the cob_current_module
           set address of cobol-module to cobol-deref
           display "module: " cobol-module end-display
    
          *> dereference the module, and skip a pointer
          *>   see libcob/libcob.h for details 
           set cobol-deref to cobol-module
           set cobol-deref up by 8
           set address of cobol-fields to cobol-deref
           display "fields: " cobol-fields end-display
    
          *> this derefed pointer is the array for cob_field arg pointers
          *>   dereference once more for cob_procedure_params[0]
          *>   which is the first cob_field pointer
           set address of cobol-field to cobol-fields
           display " field: " cobol-field end-display
    
          *> cob_field elements are size, *data, *attr       
           set address of cobol-size to cobol-field
           display "  size: " cobol-size end-display
    
          *> skip over the size, to the data pointer
           set cobol-deref to cobol-field
           set cobol-deref up by 8
           set address of cobol-data to cobol-deref
           display "  data: " cobol-data end-display
    
          *> set a buffer to the data space
           set address of cobol-buffer to cobol-data
           display "buffer: " cobol-buffer end-display
    
          *> skip over the data pointer to attr pointer
           set cobol-deref up by 8
           set address of cobol-attr to cobol-deref
           display "  attr: " cobol-attr end-display
    
          *> cobol attributes are more complicated than shown here
          *> dereference the attr, to get the actual type, 16 bits
           if cobol-attr not equal null
               set address of cobol-attributes to cobol-attr
               display
                   "  type: " cobol-attributes
                   with no advancing
               end-display
               if cobol-attributes equal H"21" then
                   display " COB_TYPE_ALPHANUMERIC" end-display
               else
                   display " not alphanumeric" end-display
               end-if
           end-if
    
    done   goback.
           end program reflective.
    

    and a run test of

    $ cobc -x reflect.cob creflect.c 
    $ ./reflect 
    C point of view
    global: 0x000000000249d420
    module: 0x00000000024aa440
     csize: 5 8 8
    
    COBOL point of view
    passed: ABCDE
        at: 0x0000000000401bc8
    global: 0x000000000249d420
     deref: 0x00000000024aa610
    module: 0x00000000024aa440
    fields: 0x00007fff300d2070
     field: 0x0000000000401bd0
      size: +0000000005
      data: 0x0000000000401bc8
    buffer: ABCDE
      attr: 0x0000000000401ac0
      type: +00033 COB_TYPE_ALPHANUMERIC
    

    And, just to get across the point that C isn't necessary for this...

    $ cobc -x reflect.cob
    $ ./reflect 
    C point of view
    not linked: creflect.c
    
    COBOL point of view
    passed: ABCDE
        at: 0x0000000000401a58
    global: 0x0000000001735420
     deref: 0x00000000017425e0
    module: 0x0000000001742440
    fields: 0x00007fff81456a60
     field: 0x0000000000401a60
      size: +0000000005
      data: 0x0000000000401a58
    buffer: ABCDE
      attr: 0x0000000000401950
      type: +00033 COB_TYPE_ALPHANUMERIC
    

    So it has begun, the oft promised article on cob_field support in GNU Cobol.

    This is just the proof of concept, but it looks like GNU Cobol can safely reflect upon itself, in GNU Cobol.

    Cheers,
    Brian

     
    Last edit: Brian Tiffin 2014-07-11
  • Simon Sobisch

    Simon Sobisch - 2014-06-22

    I've never thought about the COBOL part. Could be especially useful for programs running an older version of cobc/libcob with missing support for (newer/still to come) system calls - newer should use the safer ways via libcob calls to get this information.

    Hint: if someone EVER use this in COBOL: put it in a sub program as you may need to tweak these calls for newer versions of libcob.

    Simon

     
    • Brian Tiffin

      Brian Tiffin - 2014-06-24

      Yeah, ditto Simon. I'm posting unsafe, liable to break, source code so far.

      This type of code will likely end up in the Guile SMOB definitions, letting Guile create, access and free COBOL fields, and in other utility layers; not really meant for applications.

      Cheers,
      Brian

       

Log in to post a comment.