From: Terrance S. <ts...@us...> - 2006-06-23 14:56:43
|
Update of /cvsroot/xsb/XSB/lib In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25577 Modified Files: wrapping.P Log Message: Changes to support MT engine in higher-level FLI. Index: wrapping.P =================================================================== RCS file: /cvsroot/xsb/XSB/lib/wrapping.P,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- wrapping.P 28 Feb 2005 14:55:51 -0000 1.6 +++ wrapping.P 23 Jun 2006 14:56:36 -0000 1.7 @@ -55,7 +55,11 @@ xsb_configuration(install_dir,InstallDir), write('#include "'), write(InstallDir), - write('/emu/cinterf.h"'),nl,nl. + write('/emu/cinterf.h"'),nl, + write('#include "'), + write(InstallDir), + write('/emu/context.h"'),nl,nl. + process_directive(':-'(foreign_pred(PredDecl))) :- !, % write(PredDecl), @@ -163,6 +167,7 @@ (mod_type(Type,MType), out_postcall(Var,Use,MType)); out_postcall(Var,Use,Type)). +/* write_cargs([],EngType) :- !, (EngType = 'multi-threading' -> write('th_context *th') ; write(void)). write_cargs(Listin,EngType) :- @@ -174,6 +179,15 @@ write(Type), write(' '), write(Var). +*/ + +write_cargs([],EngType) :- !. +write_cargs(List,EngType) :- + List = [carg(Var,Type)|Rest], + write_cargs0(Rest), + write(Type), + write(' '), + write(Var). write_cargs0([]) :- !. write_cargs0([carg(Var,Type)|Rest]) :- @@ -441,143 +455,143 @@ %out_precall(Var,Mode,Type,InPos,OutPos). out_precall(Var,'+',int,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_int(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_int(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_int(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',float,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_float(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_float(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_float(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',atom,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = (unsigned long) p2c_string(%sIn);', + fmt_write(' %s = (unsigned long) extern_p2c_string(%sIn);', args(Var,Var)),nl. out_precall(Var,'+',chars,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_charlist(%sIn,&%ssize)) return FALSE;', args(Var,Var)),nl, fmt_write(' %s = (char *) malloc((%ssize+1)*sizeof(char));', args(Var,Var)),nl, - fmt_write(' p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl, - write(' printf("After call to p2c_chars\n");'),nl. + fmt_write(' extern_p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl, + write(' printf("After call to extern_p2c_chars\n");'),nl. out_precall(Var,'+',string,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_string(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_string(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',term,InPos,_) :- - fmt_write(' %s = reg_term(%d);',args(Var,InPos)),nl. + fmt_write(' %s = extern_reg_term(%d);',args(Var,InPos)),nl. out_precall(Var,'+',chars(Size),InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_charlist(%sIn,&%ssize)) return FALSE;', args(Var,Var)),nl, - fmt_write(' p2c_chars(%sIn,%s,%d);',args(Var,Var,Size)),nl, + fmt_write(' extern_p2c_chars(%sIn,%s,%d);',args(Var,Var,Size)),nl, fmt_write(' %s[%d] = (char) NULL;',args(Var,Size)),nl. out_precall(Var,'+',string(Size),InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %sTemp = p2c_string(%sIn);',args(Var,Var)),nl, + fmt_write(' %sTemp = extern_p2c_string(%sIn);',args(Var,Var)),nl, fmt_write(' strncpy(%s,%sTemp,%d);',args(Var,Var,Size)),nl, fmt_write(' %s[%d] = (char) NULL;',args(Var,Size)),nl. out_precall(Var,'+',intptr,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_int(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_int(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_int(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',floatptr,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_float(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_float(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_float(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',atomptr,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = (unsigned long) p2c_string(%sIn);', + fmt_write(' %s = (unsigned long) extern_p2c_string(%sIn);', args(Var,Var)),nl. out_precall(Var,'+',charsptr,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_charlist(%sIn,&%ssize)) return FALSE;', args(Var,Var)),nl, fmt_write(' %s=%sTemp=(char *)malloc((%ssize+1)*sizeof(char));', args(Var,Var,Var)),nl, - fmt_write(' p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl. + fmt_write(' extern_p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl. out_precall(Var,'+',stringptr,InPos,_) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_string(%sIn);',args(Var,Var)),nl. + fmt_write(' %s = extern_p2c_string(%sIn);',args(Var,Var)),nl. out_precall(Var,'+',termptr,InPos,_) :- - fmt_write(' %s = reg_term(%d);',args(Var,InPos)),nl. + fmt_write(' %s = extern_reg_term(%d);',args(Var,InPos)),nl. out_precall(Var,'-',intptr,_,OutPos) :- - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'-',floatptr,_,OutPos) :- - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'-',charsptr,_,OutPos) :- - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'-',stringptr,_,OutPos) :- - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'-',atomptr,_,OutPos) :- - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'-',termptr,_,OutPos) :- - fmt_write(' %s = reg_term(%d);',args(Var,OutPos)),nl. + fmt_write(' %s = extern_reg_term(%d);',args(Var,OutPos)),nl. out_precall(Var,'+-',chars(Size),InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_charlist(%sIn,&%ssize)) return FALSE;', args(Var,Var)),nl, - fmt_write(' p2c_chars(%sIn,%s,%d);',args(Var,Var,Size)),nl, + fmt_write(' extern_p2c_chars(%sIn,%s,%d);',args(Var,Var,Size)),nl, fmt_write(' %s[%d] = (char) NULL;',args(Var,Size)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',string(Size),InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %sTemp = p2c_string(%sIn);',args(Var,Var)),nl, + fmt_write(' %sTemp = extern_p2c_string(%sIn);',args(Var,Var)),nl, fmt_write(' strncpy(%s,%sTemp,%d);',args(Var,Var,Size)),nl, fmt_write(' %s[%d] = (char) NULL;',args(Var,Size)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',intptr,InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_int(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_int(%sIn);',args(Var,Var)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %s = extern_p2c_int(%sIn);',args(Var,Var)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',floatptr,InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_float(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_float(%sIn);',args(Var,Var)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %s = extern_p2c_float(%sIn);',args(Var,Var)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',atomptr,InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = (unsigned long) p2c_string(%sIn);', + fmt_write(' %s = (unsigned long) extern_p2c_string(%sIn);', args(Var,Var)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',charsptr,InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_charlist(%sIn,&%ssize)) return FALSE;', args(Var,Var)),nl, fmt_write(' %s=%sTemp=(char *)malloc((%ssize+1)*sizeof(char));', args(Var,Var,Var)),nl, - fmt_write(' p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' extern_p2c_chars(%sIn,%s,%ssize);',args(Var,Var,Var)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',stringptr,InPos,OutPos) :- - fmt_write(' %sIn = reg_term(%d);',args(Var,InPos)),nl, + fmt_write(' %sIn = extern_reg_term(%d);',args(Var,InPos)),nl, fmt_write(' if (!is_string(%sIn)) return FALSE;',args(Var)),nl, - fmt_write(' %s = p2c_string(%sIn);',args(Var,Var)),nl, - fmt_write(' %sOut = reg_term(%d);',args(Var,OutPos)),nl, + fmt_write(' %s = extern_p2c_string(%sIn);',args(Var,Var)),nl, + fmt_write(' %sOut = extern_reg_term(%d);',args(Var,OutPos)),nl, fmt_write(' if(!is_var(%sOut)) return FALSE;',args(Var)),nl. out_precall(Var,'+-',termptr,InPos,_) :- - fmt_write(' %s = reg_term(%d);',args(Var,InPos)),nl. + fmt_write(' %s = extern_reg_term(%d);',args(Var,InPos)),nl. %out_postcall(Var,Mode,Type). @@ -599,40 +613,40 @@ out_postcall(_,'+',atomptr). out_postcall(Var,'-',intptr) :- - fmt_write(' c2p_int(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_int(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'-',floatptr) :- - fmt_write(' c2p_float(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_float(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'-',chars(_)) :- - fmt_write(' c2p_chars(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_chars(%s,3,%sOut);',args(Var,Var)),nl. out_postcall(Var,'-',string(_)) :- - fmt_write(' c2p_string(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'-',charsptr) :- - fmt_write(' c2p_chars(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_chars(%s,3,%sOut);',args(Var,Var)),nl. out_postcall(Var,'-',stringptr) :- - fmt_write(' c2p_string(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string(%s,%sOut);',args(Var,Var)),nl. out_postcall(_,'-',termptr). out_postcall(_,'-',atomptr) :- - fmt_write(' c2p_string((char *)%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string((char *)%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'+-',intptr) :- - fmt_write(' c2p_int(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_int(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'+-',floatptr) :- - fmt_write(' c2p_float(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_float(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'+-',chars(_)) :- - fmt_write(' c2p_chars(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_chars(%s,3,%sOut);',args(Var,Var)),nl. out_postcall(Var,'+-',string(_)) :- - fmt_write(' c2p_string(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string(%s,%sOut);',args(Var,Var)),nl. out_postcall(Var,'+-',charsptr) :- - fmt_write(' c2p_chars(%s,%sOut);',args(Var,Var)),nl, + fmt_write(' extern_c2p_chars(%s,3,%sOut);',args(Var,Var)),nl, fmt_write(' free(%sTemp);',args(Var)),nl. out_postcall(Var,'+-',stringptr) :- - fmt_write(' c2p_string(%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string(%s,%sOut);',args(Var,Var)),nl. out_postcall(_,'+-',termptr). out_postcall(_,'+-',atomptr) :- - fmt_write(' c2p_string((char *)%s,%sOut);',args(Var,Var)),nl. + fmt_write(' extern_c2p_string((char *)%s,%sOut);',args(Var,Var)),nl. out_funchead(FuncName) :- - fmt_write('DllExport int call_conv %s(void)',args(FuncName)),nl, + fmt_write('DllExport int call_conv %s(CTXTdecl)',args(FuncName)),nl, write('{'),nl. out_functail :- |