The following code makes a dynamically-loaded function "ctoil()" that returns to
a Unicon/Icon program an array of ints created in C. The code consists of Icon,
C, and RTL. (To compile you need the Unicon source.)
There is only one small problem that I haven't been able to resolve: see the
"Bug!" comment in the C file. If you can help with this, it would be greatly
appreciated.
Kostas
------------------------------- Icon --------------------------------
link fullimag
procedure main()
local L
ctoil := loadfunc("./ctoil.so", "CtoIlist")
L := ctoil()
write("type(L) = ", type(L))
write("*L = ", *L)
write(fullimage(L))
end
------------------------------- C ------------------------------
#include "icall.h"
/* Additions to icall.h: */
#define T_List 8
#define D_List (T_List | D_Typecode | F_Ptr)
#define RetList(L) return (argv[0].dword = D_List, argv[0].vword = *L, 0)
/* Create an array x in C and return it as a list L in Icon. */
int CtoIlist(int argc, descriptor argv[])
{
int n = 8;
int x[n];
word *L;
{
int i;
for(i=0;i<n;i++) x[i] = i*i*i*i;
}
printf("Calling mkIlist...\n"); /* Bug! Can't remove this! */
mkIlist(x,n,L);
RetList(L);
}
------------------------------- RTL ------------------------------
/* Attempt to get around the fact that runerr() isn't allowed in a C function.
Don't know how to do better. */
#define runerr0 {err_msg(0,NULL); return A_Resume;}
/* L is returned as the vword of the list descriptor: */
int mkIlist(int x[], int n, word *L)
{
tended struct b_list *hp;
register word i, size;
word nslots;
register struct b_lelem *bp;
register struct descrip *intd;
nslots = size = n;
if (nslots == 0) nslots = MinListSlots;
/* Protect is a macro defined in h/grttin.h */
Protect(hp = alclist_raw(size, nslots), runerr0);
bp = (struct b_lelem *)hp->listhead;
/* Set slot i to a descriptor for the integer x[i] */
for (i = 0; i < size; i++) {
intd->dword = D_Integer;
intd->vword.integr = x[i];
bp->lslots[i] = *intd;
}
Desc_EVValD(hp, E_Lcreate, D_List);
*L = (word)hp;
return 0;
}
------------------------------- Makefile --------------------------------
# C arrays to Icon lists
RTT = /opt/unicon/bin/rtt -r /opt/unicon/bin/
xmkIlist.c : mkIlist.r
$(RTT) -x -P $< > $@
xmkRlist.c : mkRlist.r
$(RTT) -x -P $< > $@
# icall.h assumed to be in /opt/unicon/local/C:
%.o : %.c
gcc -I/opt/unicon/local/C -I/opt/unicon/src/libtp -c -fpic $<
ctoil.so : CtoIlist.o xmkIlist.o
gcc -I/opt/unicon/local/C -shared -fpic -o $@ $^
lt : lt.icn ctoil.so
/opt/unicon/bin/icont $@
clean:
rm *.o *.so
-------------------------------------------------------------------------
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Oh, it's good to be a geek.
http://thinkgeek.com/sf
_______________________________________________
Unicon-group mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/unicon-group
