Multilanguage

Index Unicon

Multilanguage programming

By necessity, this chapter is not solely Unicon focused. Development with multiple programming languages, across multiple paradigms can be highly rewarding when applied to non-trivial application development. This can be as basic as adding a scripting engine to a program, or far more sophisticated, with multiple modules integrated into a cohesive whole.

For example, Emacs, a text editor now over 30 years old, merged a C programming core with Lisp scripting. Not the first multilanguage environment, but a relatively famous, and highly successful one.

Unicon is well placed for general purpose programming, the feature set allowing for many problems to be solved with only Unicon source code. This is especially true when programming in the small, utility programs and light applications. One thing missing from base Unicon is end user scripting. Extending a core Unicon program means writing new Unicon source and recompiling the application. Emacs has shown that allowing the end user to extend a program with scripts is a powerful attribute, providing a path to add useful features that were not originally designed into an application.

Along with scripting, there are vast quantities of libraries written in other languages that may benefit a Unicon program, alleviating the need to write new code to solve an already solved problem.

Luckily, Unicon allows for extending programs with foreign language libraries and exposing some powerful scripting engines (with some small effort).

A small downside is that Unicon requires a specific interface protocol,[1] so there is usually a few lines of C language source involved. This extra effort is fairly boilerplate, and working samples already exist, making this a rather convenient inconvenience.

Unicon ships with multiple forms of C integration (loadfunc and callout to name two), and from there, all kinds of potential is exposed.

Multilanguage programming with Unicon will usually be a two or three language mix, Unicon, C, and any other language in use for the modules at hand. This is possible because almost every programming language in existence provides access to an ABI, application binary interface, compatible with platform specific C compilers. C becomes the crossroads of a many to one to many integration hub. The required C layer is usually small in terms of binary size and source code line count, and as mentioned earlier, there are existing examples to ease the burden on a Unicon developer.

See S-Lang, COBOL integration, Javascripting and Mini Ruby for some example integrations.

[1]	(1, 2) The Unicon foreign function interface protocol is in place to manage the high level Unicon datatypes expectations. Unicon data types are held in encoded descriptors, and these need conversion to and from the native ABI.

loadfunc

loadfunc is a handy piece of kit. It allows Unicon to load libraries and then define Unicon functions that will invoke special C functions. The [1] requires a small piece of C that accepts int argc, descpriptor argv[], or a count of arguments and pointer to an array of Unicon descriptors.

Argument 0 is reserved for the return result, so argc is always at least 1.

The descriptor data structures are define in ipl/cfuncs/icall.h and that header file must be included in the source that defines the callable functions.

The descriptor is what gives Unicon its variant data type powers. A data item can be a string, a number, a list, a real, etcetera and the structure can assigned to a variable (or passed to C functions). Variables do not have a type, and can reference any data, determined by the descriptor. The Programs section has many examples of using loadfunc.

The small wrappers, written in C, are then free to call any other C function as a native call. Results from these functions can then be passed back to Unicon by setting the argv[0] element. There are macros to make this very easy. Fail, Return, RetString, RetInteger, RetReal, and so on, all documented in ipl/cfuncs/icall.h.

There are also a helper macros for testing the Unicon type passed into the wrapper, and for converting the descriptor values to native C data types.

IconType is used for testing. ArgString will ensure (and convert if necessary) a particular descriptor is a C char pointer. StringVal will return the char *. Same for ArgInteger, ArgReal, ArgList (and others) along with the corresponding IntegerVal, RealVal, ListVal, etcetera. Read icall.h for all current details.

C Native

Note

Superseded, see libffi below. But read through this section as it details a lot of important background. The libffi version uses a very similar Unicon programmer interface, but offers a lot more platforms from a much more mature and well tested codebase.

Here is an experimental enhancement to Unicon that allows directly calling almost any C function, without need for a wrapper. This builds on loadfunc and defines 2 (or 3) new loadable functions. addLibrary will add a dynamic shared object library to the loader search path. native allows for calling C functions directly, by string name and an enumerated constant to determine the return type. Other arguments are tested by Unicon type and passed to C having built a call frame, using inline assembler.

The listing below provides support for x86_64, System V ABI calling conventions. Other platform specific assembler will be required to add support for other systems. This is relatively straight forward inline assembler, 17 instructions for the initial trials. It allows up to 6 arguments, mixed integer, real or pointer/handle argument types and handles void returns along with integral (numbers/pointers), and double floating point data for use as Unicon Real numbers, along with String types.

The code needs to be loaded into Unicon space, using loadfunc. addLibrary allows Unicon to add libraries to the dynamic search path. native is then used to lookup the call vectors (by string name, similar to loadfunc but then marshals the other arguments and sets up a valid Unicon return descriptor. No other wrappers are required.

First the new functions:

/* A new Unicon C native FFI layer, with a little assembler thrown in */
#include <stdio.h>
#include <dlfcn.h>

#include "icall.h"
#include "natives.h"

static void *dlHandle;

int
addLibrary(int argc, descriptor argv[])
{
    //union block dlBlock;
    //descriptor dlBlock;

    /* Add a new library to the dynamic search path */
    ArgString(1)
    if (!dlHandle) {
        dlHandle = dlopen(StringVal(argv[1]), RTLD_LAZY | RTLD_GLOBAL);
        if (!dlHandle) {
            fprintf(stderr, "dlHandle error\n");
            fflush(stderr);
            Error(500);
        }
    }

    //dlBlock = mkExternal(dlHandle, sizeof(dlHandle));    
    //RetExternal(dlBlock);
    RetInteger((long)dlHandle);
}

//static void *(*func)();
static void (*func)();
union blob {
    long lvalue;
    double rvalue;
    float fvalue;
    char *svalue;
};

static union blob fromc;
static union blob fromf;

/* Let the good times roll */
int
native(int argc, descriptor argv[])
{
    /* a dlsym function pointer */
    char *dlMsg;

    /* Integers and pointers go in RDI, RSI, RDX, RCX/R10, R8, R9 */
    /* Floating point in XMM0 - XMM6 */
    /* They are two seperate sets */ 
    union blob ipregs[7];
    union blob fregs[7];

    long retType;
    char inType;

    int ips = 1; /* count of integer/pointer args, reserve 0 */
    int rs = 1;  /* count of floating args, reserved 0, might not use */

    /* first the function name */
    ArgString(1);

    /* second is return type, encoded in natives.inc matched in natives.h */
    ArgInteger(2);
    retType = IntegerVal(argv[2]);

    /* Load the function pointer */
    dlerror();
    *(void **)(&func) = dlsym(dlHandle, StringVal(argv[1]));
    dlMsg = dlerror();
    if (dlMsg) {
        fprintf(stderr, "dlsym fail: %s\n", dlMsg);
        fflush(stderr);
        Error(500);
    }
    if (!func) Fail;

    /* marshalling by assembly to set up the variant call frames */
    for (int argi = 3; argi <= argc; argi++) {
        inType = IconType(argv[argi]);
    
        /* Integers and pointers go in RDI, RSI, RDX, RCX/R10, R8, R9 */
        /* Floating point in XMM0 - XMM6 */
        /* They are two seperate sets */ 
        switch(inType) {
        case 'i':
            ArgInteger(argi);
            ipregs[ips++].lvalue = IntegerVal(argv[argi]);
            break;
        case 'r': 
            ArgReal(argi);
            fregs[rs++].rvalue = RealVal(argv[argi]);
            break;
        case 's': 
            ArgString(argi);
            ipregs[ips++].svalue = StringVal(argv[argi]);
            break;
        }
     
    }

    /* Function vector in r11 */
    asm("movq func(%%rip), %%r11;"
        : /* no output operand */
        : /* no input operand */
        :"%r11"
    );
    /* Take values from ipregs ints and fregs floats */
    asm("movq %0, %%r9;"
        : /* no output operand */
        :"r"(ipregs[6])
        :"%r9" /* clobber */
    );
    asm("movq %0, %%r8;"
        :
        :"r"(ipregs[5])
        :"%r8"
    );
    asm("movq %0, %%rcx;"
        :
        :"r"(ipregs[4])
        :"%rcx"
    );
    asm("movq %0, %%r10;"   /* For Linux kernel calls instead of RCX */
        :
        :"r"(ipregs[4])
        :"%r10"
    );
    asm("movq %0, %%rdx;"
        :
        :"r"(ipregs[3])
        :"%rdx"
    );
    asm("movq %0, %%rsi;"
        :
        :"r"(ipregs[2])
        :"rsi"
    );
    asm("movq %0, %%rdi;"
        :
        :"r"(ipregs[1])
        :"%rdi"
    );

    asm("movsd %0, %%xmm5;"
        :
        :"m"(fregs[6])
        :"xmm5"
    );
    asm("movsd %0, %%xmm4;"
        :
        :"m"(fregs[5])
        :"xmm4"
    );
    asm("movsd %0, %%xmm3;"
        :
        :"m"(fregs[4])
        :"xmm3"
    );
    asm("movsd %0, %%xmm2;"
        :
        :"m"(fregs[3])
        :"xmm2"
    );
    asm("movsd %0, %%xmm1;"
        :
        :"m"(fregs[2])
        :"xmm1"
    );
    asm("movsd %0, %%xmm0;"
        :
        :"m"(fregs[1])
        :"xmm0"
    );
    
    asm("call *%r11");
    asm("movsd %xmm0, fromf(%rip)");
    asm("movq %rax, fromc(%rip)");

    /* Return type, as specfied in argument 2 enum */
    switch(retType) {
    case TYPEVOID:
        Return;
        break;
    case TYPESTAR:
        RetInteger(fromc.lvalue);
        break;
    case TYPEINT:
        RetInteger((long)fromc.lvalue);
        break;
    case TYPEFLOAT:
        RetReal((float)fromf.rvalue);
        break;
    case TYPEDOUBLE:
        RetReal((double)fromf.rvalue);
        break;
    case TYPESTRING:
        RetString(fromc.svalue);
        break;
    default:
        RetInteger((long)fromc.lvalue);
        break;
    }
}

/* Delta between managing float versus double */
/* Requires some refactoring to merge with above */
int
nativeFloat(int argc, descriptor argv[])
{
    /* a dlsym function pointer */
    char *dlMsg;

    /* Integers and pointers go in RDI, RSI, RDX, RCX/R10, R8, R9 */
    /* Floating point in XMM0 - XMM6 */
    /* They are two seperate sets here, duplicate work, more coverage */ 
    union blob ipregs[7];
    union blob fregs[7];

    long retType;
    char inType;

    int ips = 1; /* count of integer/pointer args, reserve 0 */
    int rs = 1;  /* count of floating args, reserved 0, might not use */

    /* first the function name */
    ArgString(1);

    /* second is return type, encoded in natives.inc */
    ArgInteger(2);
    retType = IntegerVal(argv[2]);

    /* load the function pointer */
    dlerror();
    *(void **)(&func) = dlsym(dlHandle, StringVal(argv[1]));
    dlMsg = dlerror();
    if (dlMsg) {
        fprintf(stderr, "dlsym fail: %s\n", dlMsg);
        fflush(stderr);
        Error(500);
    }
    if (!func) Fail;

    /* marshalling by assembly to set up the variant call frames */
    for (int argi = 3; argi <= argc; argi++) {
        inType = IconType(argv[argi]);
        /* Integers and pointers go in RDI, RSI, RDX, RCX/R10, R8, R9 */
        /* Floating point in XMM0 - XMM6 */
        /* They are two seperate sets */ 
        switch(inType) {
        case 'i':
            ArgInteger(argi);
            ipregs[ips++].lvalue = IntegerVal(argv[argi]);
            break;
        case 'r': 
            ArgReal(argi);
            fregs[rs++].fvalue = (float)RealVal(argv[argi]);
            break;
        case 's': 
            ArgString(argi);
            ipregs[ips++].svalue = StringVal(argv[argi]);
            break;
        }
     
    }

    /* Function vector in r11 */
    asm("movq func(%%rip), %%r11;"
        : /* no output operand */
        : /* no input operand */
        :"%r11"
    );
    /* Take values from ipregs ints and fregs floats */
    asm("movq %0, %%r9;"
        : /* no output operand */
        :"r"(ipregs[6])
        :"%r9" /* clobber */
    );
    asm("movq %0, %%r8;"
        :
        :"r"(ipregs[5])
        :"%r8"
    );
    asm("movq %0, %%rcx;"
        :
        :"r"(ipregs[4])
        :"%rcx"
    );
    asm("movq %0, %%r10;"   /* For Linux kernel calls instead of RCX */
        :
        :"r"(ipregs[4])
        :"%r10"
    );
    asm("movq %0, %%rdx;"
        :
        :"r"(ipregs[3])
        :"%rdx"
    );
    asm("movq %0, %%rsi;"
        :
        :"r"(ipregs[2])
        :"rsi"
    );
    asm("movq %0, %%rdi;"
        :
        :"r"(ipregs[1])
        :"%rdi"
    );

    asm("movss %0, %%xmm5;"
        :
        :"m"(fregs[6])
        :"xmm5"
    );
    asm("movss %0, %%xmm4;"
        :
        :"m"(fregs[5])
        :"xmm4"
    );
    asm("movss %0, %%xmm3;"
        :
        :"m"(fregs[4])
        :"xmm3"
    );
    asm("movss %0, %%xmm2;"
        :
        :"m"(fregs[3])
        :"xmm2"
    );
    asm("movss %0, %%xmm1;"
        :
        :"m"(fregs[2])
        :"xmm1"
    );
    asm("movss %0, %%xmm0;"
        :
        :"m"(fregs[1])
        :"xmm0"
    );
    
    asm("call *%r11");
    asm("movss %xmm0, fromf(%rip)");
    asm("movq %rax, fromc(%rip)");

    /* Return type, as specfied in argument 2 enum */
    switch(retType) {
    case TYPEVOID:
        Return;
        break;
    case TYPESTAR:
        RetInteger(fromc.lvalue);
        break;
    case TYPEINT:
        RetInteger((long)fromc.lvalue);
        break;
    case TYPEFLOAT:
        RetReal((float)fromf.fvalue);
        break;
    case TYPEDOUBLE:
        RetReal((double)fromf.fvalue);
        break;
    case TYPESTRING:
        RetString(fromc.svalue);
        break;
    default:
        RetInteger((long)fromc.lvalue);
        break;
    }
}

programs/uniffi/native.c

Before the sample run, here are the two small support files for enumerating the encoded return types, and other related paperwork. These two files must be kept in synch.

A Unicon $include file:

#
# native.inc, Native type constants
#
$define TYPEVOID 0
$define TYPESTAR 1
$define TYPECHAR 2
$define TYPESHORT 3
$define TYPEINT 4
$define TYPEFLOAT 5
$define TYPEDOUBLE 6
$define TYPESTRING 7

programs/uniffi/natives.inc

(Note the filename, .inc), it is a Unicon preprocessor include file.

A small C #include header.

/* Native return types, must match natives.icn from Unicon */
#define TYPEVOID 0
#define TYPESTAR 1
#define TYPECHAR 2
#define TYPESHORT 3
#define TYPEINT 4
#define TYPEFLOAT 5
#define TYPEDOUBLE 6
#define TYPESTRING 7

programs/uniffi/natives.h

Now a test head of small C functions to try out various call frames.

/* testnative.c, testing an experimental Unicon native call layer */
#include <stdio.h>

int
testnative(int one, int two)
{
    int ivalue;
    fprintf(stderr, "In testnative %d %d\n", one, two);
    fflush(stderr);
    ivalue = one + two;
    return ivalue;
}

double
testdouble(double one, double two)
{
    fprintf(stderr, "In testdouble %f %f\n", one, two);
    fflush(stderr);
    return one + two;
}

double
testfive(double one, double two, int three, double four, double five)
{
    double sum;
    fprintf(stderr, "In testfive %f %f %d %f %f\n", one, two, three,
                                                    four, five);
    fflush(stderr);
    sum = one + two + three + four + five;
    return sum;
}

void *
teststar()
{
    fprintf(stderr, "In teststar\n");
    fflush(stderr);
    return &teststar;
}

char *
teststring(char *echo)
{
    fprintf(stderr, "In teststring with #%s#\n", echo);
    fflush(stderr);
    return echo;
}

char *
testmulti(char *echo, int i, double d)
{
    fprintf(stderr, "In testmulti with #%s# %d %f\n", echo, i, d);
    fflush(stderr);
    return echo;
}

double
testmultid(char *echo, int i, double d)
{
    fprintf(stderr, "In testmultid with #%s# %d %f\n", echo, i, d);
    fflush(stderr);
    return d;
}

/* Requires using nativeFloat from Unicon */
float
testfloat(float one, float two)
{
    fprintf(stderr, "In testfloat %f %f\n", one, two);
    fflush(stderr);
    return one + two;
}

float
testmultif(char *echo, int i, float f)
{
    fprintf(stderr, "In testmultif with #%s# %d %f\n", echo, i, f);
    fflush(stderr);
    return f;
}

programs/uniffi/testnative.c

Unicon code to put in all in motion:

#
# testffi.icn, demonstrate an experimental C FFI
#
$include "natives.inc"

procedure main()
    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := loadfunc("./uninative.so", "addLibrary")

    # allow arbitrary C functions, marshalled by a piece of assembler
    native := loadfunc("./uninative.so", "native")

    # add the testing functions to the dlsym search path,
    #  the handle is somewhat irrelevant, but won't be soonish
    dlHandle := addLibrary("./libtestnative.so")
    write("Unicon dlHandle: ", dlHandle)
    write()

    # pass two integers, get the sum as int
    ans := native("testnative", TYPEINT, 40, 2)
    write("Unicon: called testnative and got ", ans)
    if ans ~= 42 then write("ERROR with testnative")
    write()

    # pass two reals, get the sum as real
    ans := native("testdouble", TYPEDOUBLE, 9.0, 8.0)
    write("Unicon: called testdouble and got ", ans)
    if ans ~= 17.0 then write("ERROR with testdouble")
    write()

    # third arg is an integer, returns real
    ans := native("testfive", TYPEDOUBLE, 1.0, 2.0, 3, 4.0, 5.0)
    write("Unicon: called testfive and got ", ans)
    if ans ~= 15.0 then write("ERROR with testfive")
    write()

    # get a pointer/handle
    ans := native("teststar", TYPESTAR)
    write("Unicon: called teststar and got ", ans)
    if ans = 0 then write("ERROR with teststar")
    write()

    # a string
    ans := native("teststring", TYPESTRING, "this is a string")
    write("Unicon: called teststring and got ", ans)
    if ans ~== "this is a string" then write("ERROR with teststring")
    write()

    # a string, and int and a real, returning string
    ans := native("testmulti", TYPESTRING,
                  "this is a string for multi", 42, &pi)
    write("Unicon: called testmulti and got ", ans)
    if ans ~== "this is a string for multi" then
        write("ERROR with testmulti")
    write()

    # a string, and int and a real, returning real
    ans := native("testmultid", TYPEDOUBLE,
                  "this is a string for multid", 42, &pi)
    write("Unicon: called testmultid and got ", ans)
    if ans ~= &pi then write("ERROR with testmultid")
    write()

    #
    # Variant for float versus double
    #
    # pass two reals, get the sum as real
    write("float variant")
    nativeFloat := loadfunc("./uninative.so", "nativeFloat")

    ans := nativeFloat("testfloat", TYPEFLOAT, 9.0, 8.0)
    write("Unicon: called testfloat and got ", ans)
    if ans ~= 17.0 then write("ERROR with testfloat")
    write()

    # a string, and int and a real, returning real
    ans := nativeFloat("testmultif", TYPEFLOAT,
                       "this is a short string for multif", 21, &pi/2)
    write("Unicon: called testmultif and got ", ans)
    if ans - &pi/2 > 0.0000001 then write("ERROR with testmultif")
    write()
end

programs/uniffi/testffi.icn

Two commands to prep the new support function and build the test heads

prompt$ gcc -o uninative.so -shared -fPIC native.c

prompt$ gcc -o libtestnative.so -shared -fPIC testnative.c

And finally, the sample run:

prompt$ unicon -s testffi.icn -x
Unicon dlHandle: 22708080

In testnative 40 2
Unicon: called testnative and got 42

In testdouble 9.000000 8.000000
Unicon: called testdouble and got 17.0

In testfive 1.000000 2.000000 3 4.000000 5.000000
Unicon: called testfive and got 15.0

In teststar
Unicon: called teststar and got 140061578336819

In teststring with #this is a string#
Unicon: called teststring and got this is a string

In testmulti with #this is a string for multi# 42 3.141593
Unicon: called testmulti and got this is a string for multi

In testmultid with #this is a string for multid# 42 3.141593
Unicon: called testmultid and got 3.141592653589793

float variant
In testfloat 9.000000 8.000000
Unicon: called testfloat and got 17.0

In testmultif with #this is a short string for multif# 21 1.570796
Unicon: called testmultif and got 1.570796370506287

Woohoo, swing you partner round and round. Calling C without any wrapper functions.

---

libharu

This makes things a little easier when it comes to some of the more feature rich libraries available, first trial is libharu a C library for creating PDF documents.

#
# haru.icn, demonstrate a new C FFI (first fail, double versus float)
#
$include "natives.inc"

$define HPDF_COMP_ALL 15
$define HPDF_PAGE_MODE_USE_OUTLINE 1
$define HPDF_PAGE_SIZE_LETTER 0
$define HPDF_PAGE_PORTRAIT 0
 
procedure main()
    local dlHandle, pdf, page1, rc, savefile := "harutest.pdf"

    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := loadfunc("./uninative.so", "addLibrary")

    # allow arbitrary C functions, marshalled by a piece of assembler
    # assume float instead of double, changes the inline assembler
    # movsd versus movdd
    native := loadfunc("./uninative.so", "nativeFloat")

    # add libhpdf to the dlsym search path, the handle is irrelevant
    dlHandle := addLibrary("libhpdf.so")

    pdf := native("HPDF_New", TYPESTAR, 0, 0)

    rc := native("HPDF_SetCompressionMode", TYPEINT, pdf, HPDF_COMP_ALL)
    rc := native("HPDF_SetPageMode", TYPEINT, pdf,
                 HPDF_PAGE_MODE_USE_OUTLINE)

$ifdef PROTECTED
    rc := native("HPDF_SetPassword", TYPEINT, pdf, "owner", "user")
    savefile := "harutest-pass.pdf"
$endif

    page1 := native("HPDF_AddPage", TYPESTAR, pdf)

    rc := native("HPDF_Page_SetHeight", TYPEINT, page1, 220.0)
    rc := native("HPDF_Page_SetWidth", TYPEINT, page1, 200.0);

    #/* A part of libharu pie chart sample, Red*/
    rc := native("HPDF_Page_SetRGBFill", TYPEINT, page1, 1.0, 0.0, 0.0);
    rc := native("HPDF_Page_MoveTo", TYPEINT, page1, 100.0, 100.0);
    rc := native("HPDF_Page_LineTo", TYPEINT, page1, 100.0, 180.0);
    rc := native("HPDF_Page_Arc", TYPEINT, page1, 100.0, 100.0, 80.0,
                                                  0.0, 360 * 0.45);
    
    #pos := native("HPDF_Page_GetCurrentPos (page);

    rc := native("HPDF_Page_LineTo", TYPEINT, page1, 100.0, 100.0);
    rc := native("HPDF_Page_Fill", TYPEINT, page1); 

    rc := native("HPDF_SaveToFile", TYPEINT, pdf, savefile)
    native("HPDF_Free", TYPEVOID, pdf)
end

programs/uniffi/haru-v1.icn

And then generating a password protected sample PDF.

prompt$ unicon -s -DPROTECTED haru-v1.icn -x

In a less short example, the password PROTECTED option would be tested at runtime, not at compile time, along with other control options for things like supported page sizes, compression and default character encodings.

prompt$ ls -l harutest-pass.pdf
-rw-rw-r-- 1 btiffin btiffin 1113 Oct 27 04:47 harutest-pass.pdf

---

GnuCOBOL

Calling COBOL modules is now a breeze.

      *>
      *> Demonstrate Unicon native call of COBOL modules
      *>
       identification division.
       program-id. cobolnative.

       data division.
       working-storage section.
       linkage section.
       01 one usage binary-long.
       01 two usage binary-long.

       procedure division using by value one two.
       display "GnuCOBOL got " one ", " two
       compute return-code = one + two
       goback.
       end program cobolnative.

programs/uniffi/cobolnative.cob

A caller:

#
# testcob.icn, test calling COBOL without wrapper
#
$include "natives.inc"

procedure main()
    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := loadfunc("./uninative.so", "addLibrary")

    # allow arbitrary C functions, marshalled by a small piece of assembler
    native := loadfunc("./uninative.so", "native")

    # add the testing functions to the dlsym search path,
    #  the handle is somewhat irrelevant, but won't be soonish
    dlHandle := addLibrary("./cobolnative.so")

    # initialize GnuCOBOL
    native("cob_init", TYPEVOID)

    # pass two integers, get back a sum
    ans := native("cobolnative", TYPEINT, 40, 2)
    write("Unicon: called sample and got ", ans)

    # rundown the libcob runtime
    native("cob_tidy", TYPEVOID)
end

programs/uniffi/testcob.icn

A build, and a run:

prompt$ cobc -m cobolnative.cob -Wno-unfinished

prompt$ unicon -s testcob.icn -x
GnuCOBOL got +0000000040, +0000000002
Unicon: called sample and got 42

And there is Unicon calling COBOL, with no additional wrappers, besides the native functions. Data passed, and results returned to Unicon.

Supported platforms

Currently, the assembler required to make this work is x86_64 GNU/Linux only. That will change if/when people show interest.

Note

libffi fixes that support problem, lots of platforms supported. libffi supersedes, but does not displace, the above information.

---

libffi

After playing with the C Native interface, and actually looking into how many platforms would require the assembly layer, bumped into libffi. libffi is a library that does the call frame setup, very much like the native interface described above. Except it is mature, well tested, and already supports many tens of platforms and various compiler systems. So, while the above interface works, and will be available, the libffi system is already ahead of the game, and will be put to use instead of hand rolled assembler.

https://sourceware.org/libffi/

The user interface from a Unicon point of view, is almost identical to what is shown above, but extended with a few more features, like support for struct, something that would have been a little trickier with hand rolled assembly developed from scratch.

A new native(...) function is defined in the same way with loadfunc, but instead of including inline assembler, it uses ffi_prep_cif and ffi_call.

FFI

Foreign Function Interface

CIF

Call InterFace

The only visible change is uninative in now uniffi, and -lffi is included for access to the libffi features.

Using libffi suffers the same problem of float versus double that was in the previous native sequence. A Unicon Real is a double and sometimes C requires a float. A new interface was developed to help get around this problem; a datatype override can be included by using a List (arrays) structure as part of any arguments passed on to C.

As an explanation:

The current marshalling layer pulls data from Unicon and tests the type of data passed. Integer values are mapped to long, Real values are mapped to double.

For example, the following code, just works:

ans := native("j0", TYPEDOUBLE, &pi)

That code will call the libm Bessel function of the first kind, order 0, which assumes a double floating point input and returns a double. The Unicon type does not need any further conversion. A real is effectively a double.

The problem comes when you want to call a lower precision float version.

The first crack at a solution was to have native(...) and nativeFloat(...) routines. The nativeFloa(...) function assumed that all real values were to be demoted to float values. It worked, but it meant that you could never mix float and double arguments. The new sequence drops the nativeFloat function and provides an override option to the Unicon programmer.

The new experiment uses List (arrays) data for those times when an override is required.

# pass pi as a real (as double), get back a real (as double)
ans := native("j0", TYPEDOUBLE, &pi)
write("j0(pi) = ", ans)

# pass pi as a real (as float), get back a real (as float)
ans := naitive("j0f", TYPEFLOAT, [&pi, TYPEFLOAT])
write("j0f(pi) = ", ans)

# pass pi as a normal double, pass e as a float, get back a double
ans := native("mymath", TYPEDOUBLE, &pi, [&e, TYPEFLOAT])

The override allows freely mixed float and double arguments pulled from the Unicon Real type.

An alternative was an overly burdensome type specifier required for every argument, which make the source code less friendly to write and a little bit harder to read with all the extra type specifiers getting in the way.

As a bonus, it also allows other hard to qualify options in Unicon, such as

# pass integer i (by address) get back an integer
ans := native("indirect", TYPEINT, [i, TYPESTAR])
write("indirect( ", i, ") = ", ans)

If the C function is defined as

int
indirect(int *i)
{
    return *i * 2;
}

The Unicon code listing above will call the function by passing the address of a copy of the integer value. This is not quite the same as pass by reference, but is pass by content. The called routine gets a pointer (common in C library functions) but will not be able to change the source data.

This is a limitation, but it protects the immutable property of Unicon base data types. This limitation will stand. The type override opens the possibility of calling a C functions with pointers, without falling back to writing a wrapper (unless the routine actually needs to change the referenced data for proper functioning). At that point, to protect Unicon immutable data, an extra wrapper routine would need to be written, burden on the Unicon programmer to follow the loadfunc model of C integration. It’s not a huge burden really, but does require a little bit of C code.

There may be a future addition to the uniffi.c feature set to allow changing referenced data, by passing a list from Unicon. The caller would then be able to reassign the output values using normal Unicon assignment operators.

Note

There will never be a feature added that allows immutable Unicon data to be changed in place with uniffi. That goes too far against the grain and the spirit of Unicon programming.

The current libffi interface tests just as well as the hand rolled assembler. To be honest it actually works better, many edge and corner cases have been debugged in libffi, and the cross platform support is a complete boon.

/*
  A new Unicon C native FFI layer, with libffi
  Tectonics: gcc -o uniffi.so -shared -fPIC uniffi.c -lffi
  Phase 2 trial
     todo refactor the argument scanner
          work out ORing in the TYPESTAR arg override
*/
#include <stdio.h>
#include <ffi.h>

#include "icall.h"
#include "natives.h"

/* a dlopen handle */
static void *dlHandle;
/* a dlsym function pointer */
static void (*func)();

/* storage blob for arguments */
union blob {
    long lvalue;
    double rvalue;
    float fvalue;
    char *svalue;
};


#ifndef RTLD_LAZY                       /* normally from <dlfcn.h> */
#define RTLD_LAZY 1
#endif                                  /* RTLD_LAZY */

#if NT
void *
dlopen(char *name, int flag)
{ /* LoadLibrary */
    return (void *)LoadLibrary(name);
}
void *
dlsym(void *handle, char *sym)
{
    return (void *)GetProcAddress((HMODULE)handle, sym);
}
int
dlclose(void *handle)
{ /* FreeLibrary */
    return FreeLibrary((HMODULE)handle);
}

char *
dlerror(void)
{
    return "undiagnosed dynamic load error";
}
#else                                   /* NT */
#include <dlfcn.h>
#endif                                  /* NT */

#ifdef FreeBSD
/*
  If DL_GETERRNO exists, this is an FreeBSD 1.1.5 or 2.0 
  which lacks dlerror(); supply a substitute.
*/
#ifdef DL_GETERRNO
char *
dlerror(void)
{
    int no;

    if (0 == dlctl(NULL, DL_GETERRNO, &no))
        return(strerror(no));
    else
        return(NULL);
}
#endif
#endif                                  /* __FreeBSD__ */

int
ffi(int argc, descriptor argv[])
{

    /* ffi_retval will point to an appropriate return slot */
    void *ffi_retval;
    /* ffi_rettype will point to the address of an ffi_type indicator */
    void *ffi_rettype;

    /* The cif setup requires the return type and value slot */
    ffi_cif cif;

    /* allow for 127 arguments, the C standard minimum limit */
    ffi_type *args[127];
    void *values[127];

    /* a variant result block */
    ffi_arg rc;

    /* ffi library call result codes */
    int ffi_stat;

    /* function lookup name, and possible alternate */
    char *funcname;
    char *funcname2;

    /* dlsym lookup error messages */
    char *dlMsg;

    /* local copy of args, probably dumped in phase 2 */
    union blob ipregs[127];
    union blob fregs[127];

    /* the return type enum from Unicon, in natives.h */
    long retType;
    /* the base Unicon argument data type, may be overridden */
    char inType;

    /* pointed to by ffi_retval, for ffi_prep_cif */
    long intSlot;
    double doubleSlot;
    void *pointerSlot;
    float floatSlot;

    /* current count stashed arguments */
    int ips = 0;

    /* first the function name */
    ArgString(1);

    /* second is return type, from natives.inc matched in natives.h */
    ArgInteger(2);
    retType = IntegerVal(argv[2]);

    /* look up the function entry point */
    funcname = StringVal(argv[1]);
    dlerror();
    *(void **)(&func) = dlsym(dlHandle, funcname);
    dlMsg = dlerror();
    if (dlMsg) {
        fprintf(stderr, "dlsym fail: %s\n", dlMsg);
        fflush(stderr);
        Fail; //Error(500);
    }

    /* try alternative name with initial underscore */
    if (!func) {
        funcname2 = malloc(strlen(funcname + 2));
        if (funcname2) {
            *funcname2 = '_';
            strcpy(funcname2 + 1, funcname);
            *(void **)(&func) = dlsym(dlHandle, funcname2);
            free(funcname2);
        }
    }
    if (!func) Fail;

    /* Return type, pass an indirect pointer to ffi_call */
    switch(retType) {
    case TYPEVOID:
        ffi_rettype = &ffi_type_void;
        ffi_retval = NULL;
        break;
    case TYPESTAR:
        ffi_rettype = &ffi_type_pointer;
        ffi_retval = &pointerSlot;
        break;
    case TYPEINT:
        ffi_rettype = &ffi_type_slong;
        ffi_retval = &intSlot;
        break;
    case TYPEFLOAT:
        ffi_rettype = &ffi_type_float;
        ffi_retval = &floatSlot;
        break;
    case TYPEDOUBLE:
        ffi_rettype = &ffi_type_double;
        ffi_retval = &doubleSlot;
        break;
    case TYPESTRING:
        ffi_rettype = &ffi_type_pointer;
        ffi_retval = &pointerSlot;
        break;
    default:
        ffi_rettype = &ffi_type_slong;
        ffi_retval = &intSlot;
        break;
    }

    /* pull out types and values */
    for (int argi = 3; argi <= argc; argi++) {

        inType = IconType(argv[argi]);
        /*
          fprintf(stderr, "%d arg: %d, IconType: %d '%c'\n",
                argc, argi, inType, inType);
          fflush(stderr);
        */
        int llen;
        struct descrip slot[2];

        int forceType;

        switch(inType) {
        /* Special case for lists, second value is forced datatype */
        /* currently a cheater stub only handling double/float cases */
        case 'L':
            llen = ListLen(argv[argi]);
            if (llen != 2) {
                ipregs[ips].rvalue = 0.0;
                ipregs[ips].fvalue = 0.0;
                break;
            }
            /* from looking at IListVal and RListVal */
            cpslots(&argv[argi], &slot[0], 1, 3);
            forceType = IntegerVal(slot[1]);
            switch(forceType) {
            case TYPEFLOAT:
                ipregs[ips].fvalue = (float)RealVal(slot[0]);
                args[ips] = &ffi_type_float;
                values[ips] = &ipregs[ips].fvalue;
                ips++;
                break;
            case TYPEDOUBLE:
                ipregs[ips].rvalue = RealVal(slot[0]);
                fregs[ips].rvalue = RealVal(slot[0]);
                args[ips] = &ffi_type_double;
                values[ips] = &(fregs[ips].rvalue);
                ips++;
                break;
            default:
                fprintf(stderr, "forceType %d not yet supported\n",
                        forceType);
                fflush(stderr);
                break;
            }
            break;
        case 'i':
            ArgInteger(argi);
            ipregs[ips].lvalue = IntegerVal(argv[argi]);

            args[ips] = &ffi_type_slong;
            values[ips] = &(ipregs[ips].lvalue);
            ips++;
            break;
        case 'r':
            ArgReal(argi);
            fregs[ips].rvalue = RealVal(argv[argi]);
            args[ips] = &ffi_type_double;
            values[ips] = &(fregs[ips].rvalue);
            ips++;
            break;
        case 's':
            ArgString(argi);
            ipregs[ips].svalue = StringVal(argv[argi]);

            args[ips] = &ffi_type_pointer;
            values[ips] = &(ipregs[ips].svalue);
            ips++;
            break;
        }
    }

    /* Initialize the cif */
    ffi_stat = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argc - 2,
                            ffi_rettype, args);

    if (ffi_stat == FFI_OK) {
        /* the magic call */
        ffi_call(&cif, *func, ffi_retval, values);
    } else {
        fprintf(stderr, "ffi_prep_cif failed: %d\n", ffi_stat);
        fflush(stderr);
        Fail;
    }

    /* Return type, as specfied in argument 2 enum */
    switch(retType) {
    case TYPEVOID:
        Return;
        break;
    case TYPESTAR:
        RetInteger((long)pointerSlot);
        break;
    case TYPEINT:
        RetInteger(intSlot);
        break;
    case TYPEFLOAT:
        RetReal(floatSlot);
        break;
    case TYPEDOUBLE:
        RetReal(doubleSlot);
        break;
    case TYPESTRING:
        RetString(pointerSlot);
        break;
    default:
        RetInteger(intSlot);
        break;
    }
    Error(500);
}

/* add a library to the dlsym search path */
/* need to pull code from src/runtime/fload.r */
int
addLibrary(int argc, descriptor argv[])
{
    //union block dlBlock;
    //descriptor dlBlock;
    /* Add a new library to the dynamic search path */
    ArgString(1)
    dlHandle = dlopen(StringVal(argv[1]), RTLD_LAZY | RTLD_GLOBAL);
    if (!dlHandle) {
        /*
          fprintf(stderr, "dlHandle error\n");
          fflush(stderr);
          Error(500);
        */
        Fail;
    }

    /* The return pointer, needs to get stashed properly */
    //dlBlock = mkExternal(dlHandle, sizeof(dlHandle));
    //RetExternal(dlBlock);
    RetInteger((long)dlHandle);
}

programs/uniffi/uniffi.c

And an updated test head:

#
# uniffi.icn, demonstrate an experimental C FFI with libffi
#
$include "natives.inc"

link io
procedure main()
    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := pathload("uniffi.so", "addLibrary")

    # allow arbitrary C functions, marshalled by libffi
    native := pathload("uniffi.so", "ffi")

    # add the testing functions to the dlsym search path,
    #  the handle is somewhat irrelevant, but won't be soonish
    dlHandle := addLibrary("./testnative.so")
    write("Unicon dlHandle: ", dlHandle)
    write()

    # pass two integers, get the sum as int
    ans := native("testnative", TYPEINT, 40, 2)
    write("Unicon: called testnative and got ", ans)
    if ans ~= 42 then write("ERROR with testnative")
    write()

    # pass two reals, get the sum as real
    ans := native("testdouble", TYPEDOUBLE, 9.0, 8.0)
    write("Unicon: called testdouble and got ", ans)
    if ans ~= 17.0 then write("ERROR with testdouble")
    write()

    # third arg is an integer, returns real
    ans := native("testfive", TYPEDOUBLE, 1.0, 2.0, 3, 4.0, 5.0)
    write("Unicon: called testfive and got ", ans)
    if ans ~= 15.0 then write("ERROR with testfive")
    write()

    # get a pointer/handle
    ans := native("teststar", TYPESTAR)
    write("Unicon: called teststar and got ", ans)
    if ans = 0 then write("ERROR with teststar")
    write()

    # a string
    ans := native("teststring", TYPESTRING, "this is a string")
    write("Unicon: called teststring and got ", ans)
    if ans ~== "this is a string" then write("ERROR with teststring")
    write()

    # a string, and int and a real, returning string
    ans := native("testmulti", TYPESTRING,
                  "for multi", 42, &pi)
    write("Unicon: called testmulti and got ", ans)
    if ans ~== "for multi" then
        write("ERROR with testmulti")
    write()

    # a string, and int and a real, returning real
    ans := native("testmultid", TYPEDOUBLE,
                  "for multid", 42, &pi)
    write("Unicon: called testmultid and got ", ans)
    if ans ~= &pi then write("ERROR with testmultid")
    write()

    #
    # Variant for float versus double
    # 
    write("float variant")

    # pass two reals (as float), get the sum as real (float)
    ans := native("testfloat", TYPEFLOAT,
                  [9.0, TYPEFLOAT], [8.0, TYPEFLOAT])
    write("Unicon: called testfloat and got ", ans)
    if ans ~= 17.0 then write("ERROR with testfloat")
    write()

    # a string, and int and a real (as float), returning real (as float)
    ans := native("testmultif", TYPEFLOAT,
                  "for multif",
                  21, [&pi/2, TYPEFLOAT])
    write("Unicon: called testmultif and got ", ans)
    if ans - &pi/2 > 0.0000001 then write("ERROR with testmultif")
    write()

    #
    # standard math lib
    #
    # todo: loader needs a path, but pathload stops, need a fail version
    dlHandle := addLibrary("libm.so")
    write("Unicon libm dlHandle: ", dlHandle)

    # call a Bessel function double form
    ans := native("j0", TYPEDOUBLE, &pi)
    write("j0(pi) = ", ans)
    # call Bessel function float form
    ans := native("j0f", TYPEFLOAT, [&pi, TYPEFLOAT])
    write("j0f(pi) = ", ans)
    write()

    # test switching back to the previous load library
    ans := native("testfloat", TYPEFLOAT,
                  [9.0, TYPEFLOAT], [8.0, TYPEFLOAT])
    write("Unicon: called testfloat and got: ", ans)
    if ans ~= 17.0 then write("ERROR with testfloat")
    write()
end

programs/uniffi/uniffi.icn

Nearly the same commands to prep the support function and build the test heads, as listed above under C Native. The only addition is -lffi to the gcc compile line, and a change of filename from native.c to uniffi.c. (I’ve taken to pronouncing that as “unify”).

prompt$ gcc -o uniffi.so -shared -fPIC uniffi.c -lffi

The testnative.c C code remains almost the same, but added libm.so to test the j0 and j0f functions (and to test that loaded libraries stick around and function lookups are cumulative).

prompt$ gcc -o testnative.so -shared -fPIC testnative.c

Here is a test run with a new top level Unicon filename uniffi.icn with the new list [arg, TYPE] specifiers included in some of the tests:

prompt$ unicon -s uniffi.icn -x
Unicon dlHandle: 17621520

In testnative 40 2
Unicon: called testnative and got 42

In testdouble 9.000000 8.000000
Unicon: called testdouble and got 17.0

In testfive 1.000000 2.000000 3 4.000000 5.000000
Unicon: called testfive and got 15.0

In teststar
Unicon: called teststar and got 139768978840115

In teststring with #this is a string#
Unicon: called teststring and got this is a string

In testmulti with #for multi# 42 3.141593
Unicon: called testmulti and got for multi

In testmultid with #for multid# 42 3.141593
Unicon: called testmultid and got 3.141592653589793

float variant
In testfloat 9.000000 8.000000
Unicon: called testfloat and got 17.0

In testmultif with #for multif# 21 1.570796
Unicon: called testmultif and got 1.570796370506287

Unicon libm dlHandle: 17621520
j0(pi) = -0.3042421776440938
j0f(pi) = -0.3042422235012054

In testfloat 9.000000 8.000000
Unicon: called testfloat and got: 17.0

Unified Foreign Function Interface. (Uniconified FFI). Running your Unicon on a Mac, Windows, 32bit, 64bit, FreeBSD or a z/Linux mainframe? uniffi has your back. Call as many library functions as you like, all from Unicon sources, no wrappers required.

The GnuCOBOL sample listed in C Native is identical.

The libharu integration now uses the type override system, as the PDF generator prefers float data arguments. It makes the listing a listing a little less easy to read, with all the type overrides, but not too bad, given the level of flexibility provided.

#
# haru.icn, demonstrate a newer C FFI
#
$include "natives.inc"

$define HPDF_COMP_ALL 15
$define HPDF_PAGE_MODE_USE_OUTLINE 1
$define HPDF_PAGE_SIZE_LETTER 0
$define HPDF_PAGE_PORTRAIT 0
 
procedure main()
    local dlHandle, pdf, page1, rc, savefile := "harutest.pdf"

    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := loadfunc("./uniffi.so", "addLibrary")

    # allow arbitrary C functions, marshalled by a piece of assembler
    # assume float instead of double, changes the inline assembler
    # movsd versus movdd
    native := loadfunc("./uniffi.so", "ffi")

    # add libhpdf to the dlsym search path, the handle is irrelevant
    dlHandle := addLibrary("libhpdf.so")

    pdf := native("HPDF_New", TYPESTAR, 0, 0)

    rc := native("HPDF_SetCompressionMode", TYPEINT, pdf, HPDF_COMP_ALL)
    rc := native("HPDF_SetPageMode", TYPEINT, pdf,
                 HPDF_PAGE_MODE_USE_OUTLINE)

$ifdef PROTECTED
    rc := native("HPDF_SetPassword", TYPEINT, pdf, "owner", "user")
    savefile := "harutest-pass.pdf"
$endif

    page1 := native("HPDF_AddPage", TYPESTAR, pdf)

    rc := native("HPDF_Page_SetHeight", TYPEINT, page1,
                 [220.0, TYPEFLOAT]);
    rc := native("HPDF_Page_SetWidth", TYPEINT, page1,
                 [200.0, TYPEFLOAT]);

    #/* A part of libharu pie chart sample, Red*/
    rc := native("HPDF_Page_SetRGBFill", TYPEINT, page1,
                 [1.0, TYPEFLOAT], [0.0, TYPEFLOAT], [0.0, TYPEFLOAT]);
    rc := native("HPDF_Page_MoveTo", TYPEINT, page1,
                 [100.0, TYPEFLOAT], [100.0, TYPEFLOAT]);
    rc := native("HPDF_Page_LineTo", TYPEINT, page1,
                 [100.0,  TYPEFLOAT],[180.0, TYPEFLOAT]);
    rc := native("HPDF_Page_Arc", TYPEINT, page1,
                 [100.0, TYPEFLOAT], [100.0, TYPEFLOAT],
                 [80.0, TYPEFLOAT], [0.0, TYPEFLOAT],
                 [360 * 0.45, TYPEFLOAT]);
    
    #pos := native("HPDF_Page_GetCurrentPos (page);

    rc := native("HPDF_Page_LineTo", TYPEINT, page1,
                 [100.0, TYPEFLOAT], [100.0, TYPEFLOAT]);
    rc := native("HPDF_Page_Fill", TYPEINT, page1); 

    rc := native("HPDF_SaveToFile", TYPEINT, pdf, savefile);
    native("HPDF_Free", TYPEVOID, pdf);
end

programs/uniffi/haru.icn

What comes next? That is up to the creativity, imagination and needs of august Unicon developers. No need to write any C to get at C, or any language that uses the C application binary interface. As a (not completely) informed guess, I’d peg that at well over 75% of currently available computing resources, world wide. Even an Android phone plays nice with the C ABI internally.

Other features of libffi can be exposed as needs are determined. The ffi_call layer supports sysv, unix64, win64, stdcall, fastcall, thiscall and cdecl call conventions. Possibly others, depending on platform specific builds. By default, uniffi uses the calling convention most appropriate for the system used during builds by using FFI_DEFAULT_ABI when preparing the Call InterFace block.

---

baconffi

Putting libffi to use with BaCon, the BASIC Converter.

Like the GnuCOBOL example, this routine just sums two numbers passed in as arguments and returns the resulting integer.

REM basicnative.bac, uniffi call to BaCon BASIC
FUNCTION basic(NUMBER one, NUMBER two)
    RETURN one + two
END FUNCTION

programs/uniffi/basicnative.bac

This source is then converted to C, and a shared library is created.

prompt$ bacon -q -f basicnative.bac

Converting 'basicnative.bac'... 
Converting 'basicnative.bac'... done, 15 lines were processed in 0.003 seconds.
Compiling 'basicnative.bac'... make[1]: Entering directory '/home/btiffin/wip/writing/unicon/programs/uniffi'
cc  -fPIC -c basicnative.bac.c
cc -o basicnative.so basicnative.bac.o -L. -lbacon -lm -shared -rdynamic 
make[1]: Leaving directory '/home/btiffin/wip/writing/unicon/programs/uniffi'
Done, program 'basicnative.so' ready.

A slightly more sophisticated BaCon program, that embeds some inline assembler. Sample derived from a thread on the BaCon forums by vovchik and Axelfish, http://basic-converter.proboards.com/thread/752/assembler-bacon

REM mixedbacon.bac, uniffi call to BaCon BASIC
FUNCTION embed(int operand1,int operand2) TYPE int
    USEC
    #define ASM asm(
    #define GAS );

    int sum, accumulator;

    ASM
        "movl %1, %0\n\t"
        "addl %2, %0"
        : "=r" (sum)                       /* output operands */
        : "r" (operand1), "r" (operand2)   /* input operands */
        : "0"                              /* clobbered operands */
    GAS
    accumulator = sum;

    ASM
        "addl %1, %0\n\t"
        "addl %2, %0"
        : "=r" (accumulator)
        : "0" (accumulator), "g" (operand1), "r" (operand2)
        : "0"
    GAS
    END USEC

    RETURN accumulator
END FUNCTION

REM
REM asmmix, to be called from Unicon uniffi
REM
FUNCTION asmmix(int one, int two)
    PRINT "BaCon received: ", one, ", ", two
    my_accumulator=embed(one, two)
    RETURN my_accumulator
END FUNCTION

programs/uniffi/asmmix.bac

Again, convert the source and compile to a shared library.

prompt$ bacon -q -f asmmix.bac

Converting 'asmmix.bac'... 
Converting 'asmmix.bac'... done, 48 lines were processed in 0.005 seconds.
Compiling 'asmmix.bac'... make[1]: Entering directory '/home/btiffin/wip/writing/unicon/programs/uniffi'
cc  -fPIC -c asmmix.bac.c
cc -o asmmix.so asmmix.bac.o -L. -lbacon -lm -shared -rdynamic 
make[1]: Leaving directory '/home/btiffin/wip/writing/unicon/programs/uniffi'
Done, program 'asmmix.so' ready.

A Unicon test head to load in the basic function defined in basicnative.bac and then invoke the function through the libffi interface. Same sequence for the asmmix call.

#
# baconffi.icn, test calling BaCon without wrapper with libffi
#
$include "natives.inc"

procedure main()
    # will be RTLD_LAZY | RTLD_GLOBAL (so add to the search path)
    addLibrary := loadfunc("./uniffi.so", "addLibrary")

    # allow arbitrary C functions, marshalled by libffi
    native := loadfunc("./uniffi.so", "ffi")

    # add the testing functions to the dlsym search path,
    #  the handle is somewhat irrelevant, but won't be soonish
    dlHandle := addLibrary("./basicnative.so")

    # pass two integers, get back a sum
    write("Unicon calling BaCon function \"basic\" with 40 and 2")
    ans := native("basic", TYPEINT, 40, 2)
    write("Unicon got ", ans)

    # pass two integers that create an accumulator in assembly
    dlHandle := addLibrary("./asmmix.so")
    write("Unicon calling \"asmmix\" with 2 and 4")
    ans := native("asmmix", TYPEINT, 2, 4)
    write("Unicon accumulator of 2+4 + 2+4 + 2: ", ans)
end

programs/uniffi/baconffi.icn

Sample run:

prompt$ unicon -s baconffi.icn -x
Unicon calling BaCon function "basic" with 40 and 2
Unicon got 42
Unicon calling "asmmix" with 2 and 4
BaCon received: 2, 4
Unicon accumulator of 2+4 + 2+4 + 2: 14

And mixing Unicon with BASIC becomes another easy thing to do.

BaCon is an extraordinarily powerful BASIC translator. Lots of features.

http://www.basic-converter.org/

---

Index | Previous: Programs | Next: Theory