      $set rtncode-size"2" nolitlink
      ************************************************************************
      * Copyright (C) 1986-1999 Micro Focus International Ltd.
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") and may be used, 
      * modified and distributed as part of your application provided 
      * that you properly acknowledge the copyright of Micro Focus in this
      * material.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************
      *
      * Start of source module cobmain1.cbl
      *
      ************************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. cobmain1.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.

       WORKING-STORAGE SECTION.
       copy "ctypes.cpy".
	01 cobol-double d-float.
	01 cobol-float float.
	01 cobol-long long.
	01 cobol-int int.
	01 cobol-char pic x(25) value all x"00".

	01 mainline pic x(80).
	01 subline pic x(80) value
	    "Value 1 is %x : Value 2 is %s : Value 3 is %d".
        01 num1 pic 9(8) comp-x.
	01 num2 pic 99.
	01 filler pic x value x"00".
	01 num3 pic 9(8) comp-x.

	01 preloadobj	procedure-pointer.
	01 preloaderr	procedure-pointer.

	01 result pic 9(4) comp-x.
       PROCEDURE DIVISION.

     ***
     *** This part demonstrates COBOL
     *** calling a C function directly
     ***
	move 9999 to cobol-double
	move 10 to cobol-long
	move 10.5 to cobol-float
	move -10 to cobol-int
	move "abcdefghijklmnopqrst" & x"00" to cobol-char

	call "csub1" using	by value cobol-int
				by reference cobol-float
				by reference cobol-long
				by reference cobol-char
				by reference cobol-double
				returning result

	if result = 0
	    display "cobmain1 running correctly"
	else
	    display "cobmain1 failed"
	end-if

     ***
     *** This part just demonstrates COBOL
     *** calling a C library routine
     ***
	    move 1234 to num1
	    move 10 to num2
	    move 25 to num3
	    call "sprintf" using by reference	mainline
				 by reference	subline
				 by value	num1
				 by reference	num2
				 by value	num3
	    display mainline


     ***
     *** This part demonstrates COBOL
     *** calling a C++ function. We're also using this
     *** opportunity to demo calling a function with a
     *** differing name to the shared object.
     ***

     ***
     *** As none of the function names are the same name as the
     *** shared object, we need to preload the shared object to make
     *** the functions available.
     ***
	    set preloadobj to entry "cxxsub1"
	    set preloaderr to entry "doesnotexit"
	    if preloadobj equal preloaderr
	        display "Unable to load cxxsub1"
		stop run
	    end-if

	move 9999 to cobol-double
	move 10 to cobol-long
	move 10.5 to cobol-float
	move -10 to cobol-int
	move "abcdefghijklmnopqrst" & x"00" to cobol-char

	call "cplusfunc" using	by value cobol-int
				by reference cobol-float
				by reference cobol-long
				by reference cobol-char
				by reference cobol-double
				returning result

	if result = 0
	    display "cobmain1 running correctly"
	else
	    display "cobmain1 failed"
	end-if

	display "return-code" result
	move result to return-code
	exit program.
