/*
 *                 WARNING!
 * 
 * this file is `twin_tunnel_c' and is preprocessed by m4 to produce `twin_tunnel_m4.c'
 * 
 * It must be a valid m4 file, and must produce a valid C file.
 * 
 */


#include <Tw/Tw.h>
#include <Tw/Twavl.h>
#include <Tw/Twstat.h>
#include <Tw/Twstat_defs.h>
#include <Tw/Twerrno.h>


DECL_BEFORE

#include "array.h"

static ttobject OverwriteIdFromNative(ttobject o);
static ttany TunnelCall(opaque method_order, ...);

/*
 * We need to write down almost all methods in orded to call them on the server
 */

dnl m4_begin "

divert(-1)

include(`m4/TTdecay.m4')

define(`protected', `ifdef(`mtd_$1_$2', `', `
/*
 *   WARNING:   undefined `protected' tunnel_$1_$2()
 */
')')
define(`public', `ifdef(`mtd_$1_$2', `', `
tunnel_decl($@) {
    tunnel_body($@)
}')')
define(`public_set', `public($@)')

    
define(`tunnel_decl', `static c_arg_type($4,$5) DEF($1_$2)`'(c_args_decl(NSHIFT(6, $@)))')
define(`tunnel_body', `return_c_arg_ret_decay_ifnotvoid($4,$5)TunnelCall(ttmethod_$1_$2`'dnl
`'ifelse(`$9', `', `', `, tunnel_c_args_call_ttany(NSHIFT(6, $@))'));')

define(`tunnel_c_args_call_ttany', `ifelse($3, `', `', `tunnel_c_arg_call_ttany($1,$2,$3)`'_tunnel_c_args_call_ttany(NSHIFT(3,$@))')')
define(`_tunnel_c_args_call_ttany', `ifelse($3, `', `', `, tunnel_c_arg_call_ttany($1,$2,$3)`'_tunnel_c_args_call_ttany(NSHIFT(3,$@))')')
define(`tunnel_c_arg_call_ttany', `(ttany)opaque_ifpointer($1,$2)$3')

define(`return_c_arg_ret_decay_ifnotvoid', `ifelse($2, void, `', `return (addspace_ifnotempty($1)`'$2)opaque_ifpointer($1,$2)')')
define(`opaque_ifpointer', `ifelse(regexp(`$1', `_fn$'), -1, ifelse(index(`$1', `*'), -1, `', (opaque)), (opaque))')



									     


divert

dnl " m4_end



    
    
    
    
    
    
    
    
    
    
/* ttobject hand-made methods */


static BUILD(ttobject) {
    /*
     * rough but simple method: we redefine object ->id to be the same
     * as the returned ->native.
     */
    o->native = TunnelCall(ttmethod_New, (ttany)o->Class->id);
    
    return OverwriteIdFromNative(o);
}

static BREAK(ttobject) {
    TunnelCall(ttmethod_Del, o->native);
}


/* ttnative hand-made methods */

static ttnative DEF(GetRoot_ttnative)(void) {
    /*
     * FIXME: Create_ttnative also calls TNEW()... which creates
     * another ttnative on server side libTT: leak!
     */
    ttnative o = Create_ttnative(TunnelCall(ttmethod_GetRoot_ttnative));

    return (ttnative)OverwriteIdFromNative((ttobject)o);
}


/* ttapplication hand-made methods */

static BUILD(ttapplication) {
    o->native = TunnelCall(ttmethod_Create_ttapplication, (ttany)(opaque)o->name);

    return (ttapplication)OverwriteIdFromNative((ttobject)o);
}





/* autogenerated methods */

dnl m4_begin "

define(`extends')
define(`el', `
/* $1 */
TTdef_ttclass_$1($1)')

TTnlist()

undefine(`el')
define(`public')
define(`public_set')
define(`protected')
define(`extends')

define(`CALL', `Tw$1(shift($@))')
define(`SYM', `Tw$1')

include(`twin_hw_h')
	
dnl " m4_end;



static textension eid = TW_NOID;

TW_DECL_MAGIC(TT_Tw_magic);


#ifdef THIS_MODULE
ttclasses InitModule(tthw *HW)
#else
ttclasses _TT_twin_tunnel_InitHW(tthw *HW)
#endif
{
    ttuint tunnel_libTT_version;
    /*
     * (*HW) must be set even if initialization fails,
     * to report error messages.
     */
    *HW = &twin_tunnel_TTClasses.HW;
    
    TwConfigMalloc(TTAllocMem, TTReallocMem, TTFreeMem);
    
    if (TwCheckMagic(TT_Tw_magic) && TwOpen(TTD.HWOptions)) {
	if ((eid = TwOpenExtension(2, "TT"))) {
	    if ((tunnel_libTT_version = TunnelCall(ttmethod_LibraryVersion)) == TT_PROTOCOL_VERSION)
		return &twin_tunnel_TTClasses;
	    else
		FAIL_TT(TT_ETARGET_BAD_EXTENSION_VERSION, tunnel_libTT_version);
	} else {
	    FAIL_TT(TT_ETARGET_NO_EXTENSION, TT_EDETAIL_TARGET_TWIN_TUNNEL);
	}
	TwClose();
    }
    
    if (TwErrno)
	FAIL(TwErrno, TwErrnoDetail);
    
    return (ttclasses)0;
}


static udat TTType2TWS(ttopaque type) {
    udat tws_type = 0;
    
    if (type & ttclass_type_array)
	tws_type |= TWS_vec|TWS_vecW;

    switch ((opaque)TTFromType_ttclass(type) & TT_MAGIC_MASK) {
#define C(t1,t2) case TT_CAT(order_,t1): tws_type |= TT_CAT(TWS_,t2); break;
	C(void,     void);
	C(ttbyte,   byte);
	C(ttshort,  dat);
	C(ttint,    ldat);
	C(ttcol,    hwcol);
	C(ttfont,   hwfont);
	C(ttattr,   hwattr);
	C(ttopaque, topaque);
	C(ttany,    tany);
#undef C
      default:
	tws_type |= TWS_tany;
    }
    return tws_type;
}

/*
 * rough but simple method: we redefine object ->id to be the same
 * as the returned ->native.
 */
static ttobject OverwriteIdFromNative(ttobject o) {
    ttopaque saved_id;
    
    /* fast-failure or fast-success */
    if (!o || o->native == o->id)
	return o;
    
    /* sanity checks */
    if (o->native && o->native == (ttopaque)o->native && 
	(o->native >> TT_MAGIC_SHIFT) == (o->id >> TT_MAGIC_SHIFT) &&
	!ID2OBJ(o->native)) {
	
	saved_id = o->id;
	DropId((ttobj)o);
	o->id = (ttopaque)o->native;
	if (FixedAssignId((ttclass)o->Class, (ttobj)o))
	    return o;
	
	/* try to recover... */
	o->id = saved_id;
	(void)FixedAssignId((ttclass)o->Class, (ttobj)o);
    }
    return NULL;
}

#ifdef DEBUG_TUNNEL
static void debug_method(ttopaque args_n, tsfield a) {
    ttopaque i;
    
    printf("%s(", TTGetName_ttmethod((tt_obj)(ttopaque)a[1].TWS_field_scalar));

    for (i = 2; i <= args_n + 1; i++) {
	if (i == args_n + 1) {
	    i = 0;
	    printf(") =\t ");
	} else if (i != 2) {
	    printf(", ");
	}
	
	if (a[i].type == (TWS_vec|TWS_vecW|TWS_byte))
	    printf("\"%.*s\"", (int)a[i].TWS_field_vecL, (TW_CONST byte *)a[i].TWS_field_vecV);
	else if (a[i].type & TWS_vec)
	    printf("0x%08lX[%ld]", (unsigned long)a[i].TWS_field_vecV, (unsigned long)a[i].TWS_field_vecL);
	else if (a[i].type == TWS_void)
	    printf("<void>");
	else if (a[i].TWS_field_scalar > 0xFFFF)
	    printf("0x%08lX", (unsigned long)a[i].TWS_field_scalar);
	else
	    printf("%ld", (unsigned long)a[i].TWS_field_scalar);
	
	if (i == 0)
	    break;
    }
    printf("\n");
    fflush(stdout);
}
#endif

static ttany TunnelCall(opaque o, ...) {
    struct s_tsfield ta[TT_MAX_ARG_N];
    ttarg aa[TT_MAX_ARG_N];
    
    tsfield a;
    va_list vargs;
    ttmethod M;
    ttopaque type, i, args_n;
    ttany *args_type;
    tany val;
    ttobject O;
    tt_obj _Class;
    ttclass Class;
    
    /*
     * FIXME: if we work on a user-created ttobject it's ok,
     * else we should work on our local copy, NOT call the server-side libTT
     */
    
    if (!(M = (ttmethod)IdList[order_ttmethod][o]))
	return (ttany)0;
	
    args_n = M->parameter_type->array_n;
    args_type = M->parameter_type->array;
    if (args_n >= TT_MAX_ARG_N - 2)
	return (ttany)0;

    /* set type of return value */
    ta[0].type = TTType2TWS(M->return_type);

    /* set first arg (method) */
    ta[1].type = TWS_tany;
    ta[1].TWS_field_scalar = o | (order_ttmethod << TT_MAGIC_SHIFT);
    
    va_start(vargs, o);
    
    /* skip a[0] (return value) */
    /* skip a[1] (method, already encoded above) */
    for (a = ta+2, i = 0; i < args_n; i++) {

	
	a[i].type = TTType2TWS(	aa[i].type = type = *args_type );

	val = va_arg(vargs, tany);

	_Class = TTFromType_ttclass(type);
	
	if (type == id_ttclass_void) {
	    ;
	} else if (type & ttclass_type_array) {
	    
	    a[i].TWS_field_vecV = (void *)(opaque)( aa[i].value = val );
	    a[i].TWS_field_vecL = aa[i].size =
		TTGetArraySizeA_ttmethod((tt_obj)M->id, i, args_n, aa);
	    
	} else {
	    if ((Class = ID2CLASS(_Class)) && ISCLASS(ttobj, Class) && /* we are sending a libTT obj */
		(O = (ttobject)(opaque)val) && Is(Class, O)) { /* and it is a valid obj of the correct type */
		
		if (IS(ttobject,O) &&
		    !(O->oflags & (ttobject_oflags_static|ttobject_oflags_const)))
		    /* it is a user-created ttobject */
		    
		    val = O->native;
		else
		    /* it is a library immutable object */
		    val = O->id;
		
	    }
	    aa[i].value = a[i].TWS_field_scalar = val;
	    break;
	}
    }
    va_end(vargs);
    
#ifdef DEBUG_TUNNEL
    TwCallTExtension(eid, args_n+1, ta);
    
    debug_method(args_n+1, ta);
    return a->TWS_field_scalar;
#else
    
    /* FIXME: if the return value is an object of server-side libTT,
     * we must must find our object having ->native equal to the return value */
    
    /* (args_n+1) since we prepended method to invoke (o) as first arg */
    return (ttany)TwCallTExtension(eid, args_n+1, a);
#endif
}


DECL_AFTER
