Unicob*>-<*
      *> Author: Brian Tiffin
      *> Dedicated to the public domain
      *>
      *> Date started: October 2016
      *> Modified: 2016-12-30/02:00-0500
      *>+<*
      *> Unicon interfacing with COBOL
       identification division.
       program-id. unicob.

      *> tectonics: cobc -m -fimplicit-init unicob.cob
      *> In Unicon: unicob := loadfunc("./unicob.so", "unicob")
      *>   result := unicob(integer, real, or strin, ...)

       environment division.
       configuration section.
       repository.
           function all intrinsic.

       data division.
       working-storage section.
       01 actual usage binary-long.

       01 arguments based.
          05 args occurs 1 to 96 times depending on actual.
             10 dword usage binary-double unsigned.
             10 vword usage binary-double.

       01 unicon-int usage binary-c-long based.
       01 unicon-real usage float-long based.
       01 unicon-string usage pointer based.
       01 cobol-buffer pic x(8192) based.
       01 cobol-string pic x(8192).

      *> If DESCRIPTOR-DOUBLE not found in environment, default to set
       >>DEFINE DESCRIPTOR-DOUBLE PARAMETER
       >>IF DESCRIPTOR-DOUBLE IS NOT DEFINED
       >>DEFINE DESCRIPTOR-DOUBLE 1
       >>END-IF

       >>IF P64 IS SET
       01 FLAG-NOT-STRING constant as H"8000000000000000".
       01 FLAG-VARIABLE   constant as H"4000000000000000".
       01 FLAG-POINTER    constant as H"2000000000000000".
       01 FLAG-TYPECODE   constant as H"1000000000000000".
       01 DESCRIPTOR-TYPE constant as H"A000000000000000".
       01 DESCRIPTOR-NULL constant as H"A000000000000000".
       01 DESCRIPTOR-INT  constant as H"A000000000000001".
       >>IF DESCRIPTOR-DOUBLE IS DEFINED
       01 DESCRIPTOR-REAL constant as H"A000000000000003".
       >>ELSE
       01 DESCRIPTOR-REAL constant as H"B000000000000003".
       >>END-IF
       >>ELSE  *> not 64 bit
       01 FLAG-NOT-STRING constant as H"80000000".
       01 FLAG-VARIABLE   constant as H"40000000".
       01 FLAG-POINTER    constant as H"20000000".
       01 FLAG-TYPECODE   constant as H"10000000".
       01 DESCRIPTOR-TYPE constant as H"A0000000".
       01 DESCRIPTOR-NULL constant as H"A0000000".
       01 DESCRIPTOR-INT  constant as H"A0000001".
       >>IF DESCRIPTOR-DOUBLE IS DEFINED
       01 DESCRIPTOR-REAL constant as H"A0000003".
       >>ELSE
       01 DESCRIPTOR-REAL constant as H"B0000003".
       >>END-IF
       >>END-IF

      *> take argc int, argv array pointer
       linkage section.
       01 argc usage binary-long.
       01 argv usage pointer.

       procedure division using by value argc, argv.
       unicob-main.

      *> if there is a null argv, report program malfunction
       if argv equal null or argc less than 1 then
           move 500 to return-code
           goback
       end-if

      *> argc needs one extra allocation to account for zeroth
       add 1 to argc giving actual
       set address of arguments to argv
       display actual " arguments"
       display space

      *> Let's see the arguments (including current &null result slot)
       perform varying tally from 1 by 1 until tally > actual
           *> display "Arg: " tally " = " dword(tally), ", ", vword(tally)
           evaluate dword(tally)
              when equal DESCRIPTOR-NULL
                  display "&null      :"
              when equal DESCRIPTOR-INT
                  perform show-integer
              when equal DESCRIPTOR-REAL
                  perform show-real
              when less than FLAG-NOT-STRING
                  perform show-string
              when other
                  display "unsupported: type code is " dword(tally)
           end-evaluate
       end-perform

      *> send back the universal answer
       move DESCRIPTOR-INT to dword(1)
       move 42 to vword(1)
    
      *> the loadfunc function returns 0 on success
       move 0 to return-code
       goback.

      *> ****************
       show-integer.
       call "cnv_c_int" using args(tally) args(tally)
       display "integer    : " vword(tally)
       .

       show-real.
       call "cnv_c_dbl" using args(tally) args(tally)
       set address of unicon-real to address of vword(tally)
       display "float-long : " unicon-real
       .

       show-string.
       call "cnv_c_str" using args(tally) args(tally)
       set address of unicon-string to address of vword(tally)
       set address of cobol-buffer to unicon-string
       string cobol-buffer delimited by low-value into cobol-string
       *> The length is in dword(tally)
       display 'string     : "' trim(cobol-string) '"'
       .

       end program unicob.