perl/xs/Lucy/Object/Host.c

/* Licensed to the Apache Software Foundation (ASF) under one or more
 * contributor license agreements.  See the NOTICE file distributed with
 * this work for additional information regarding copyright ownership.
 * The ASF licenses this file to You under the Apache License, Version 2.0
 * (the "License"); you may not use this file except in compliance with
 * the License.  You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

#include "XSBind.h"

#include "Lucy/Object/VTable.h"

#include "Lucy/Object/Obj.h"
#include "Lucy/Object/Host.h"
#include "Lucy/Object/CharBuf.h"
#include "Lucy/Object/Err.h"
#include "Lucy/Util/Memory.h"

static SV*
S_do_callback_sv(void *vobj, char *method, uint32_t num_args, va_list args);

// Convert all arguments to Perl and place them on the Perl stack.
static CHY_INLINE void
SI_push_args(void *vobj, va_list args, uint32_t num_args) {
    lucy_Obj *obj = (lucy_Obj*)vobj;
    SV *invoker;
    uint32_t i;
    dSP;

    uint32_t stack_slots_needed = num_args < 2
                                  ? num_args + 1
                                  : (num_args * 2) + 1;
    EXTEND(SP, stack_slots_needed);

    if (Lucy_Obj_Is_A(obj, LUCY_VTABLE)) {
        lucy_VTable *vtable = (lucy_VTable*)obj;
        // TODO: Creating a new class name SV every time is wasteful.
        invoker = XSBind_cb_to_sv(Lucy_VTable_Get_Name(vtable));
    }
    else {
        invoker = (SV*)Lucy_Obj_To_Host(obj);
    }

    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    PUSHs(sv_2mortal(invoker));

    for (i = 0; i < num_args; i++) {
        uint32_t arg_type = va_arg(args, uint32_t);
        char *label = va_arg(args, char*);
        if (num_args > 1) {
            PUSHs(sv_2mortal(newSVpvn(label, strlen(label))));
        }
        switch (arg_type & CFISH_HOST_ARGTYPE_MASK) {
            case CFISH_HOST_ARGTYPE_I32: {
                    int32_t value = va_arg(args, int32_t);
                    PUSHs(sv_2mortal(newSViv(value)));
                }
                break;
            case CFISH_HOST_ARGTYPE_I64: {
                    int64_t value = va_arg(args, int64_t);
                    if (sizeof(IV) == 8) {
                        PUSHs(sv_2mortal(newSViv((IV)value)));
                    }
                    else {
                        // lossy
                        PUSHs(sv_2mortal(newSVnv((double)value)));
                    }
                }
                break;
            case CFISH_HOST_ARGTYPE_F32:
            case CFISH_HOST_ARGTYPE_F64: {
                    // Floats are promoted to doubles by variadic calling.
                    double value = va_arg(args, double);
                    PUSHs(sv_2mortal(newSVnv(value)));
                }
                break;
            case CFISH_HOST_ARGTYPE_STR: {
                    lucy_CharBuf *string = va_arg(args, lucy_CharBuf*);
                    PUSHs(sv_2mortal(XSBind_cb_to_sv(string)));
                }
                break;
            case CFISH_HOST_ARGTYPE_OBJ: {
                    lucy_Obj* anObj = va_arg(args, lucy_Obj*);
                    SV *arg_sv = anObj == NULL
                                 ? newSV(0)
                                 : XSBind_cfish_to_perl(anObj);
                    PUSHs(sv_2mortal(arg_sv));
                }
                break;
            default:
                CFISH_THROW(LUCY_ERR, "Unrecognized arg type: %u32",
                            arg_type);
        }
    }

    PUTBACK;
}

void
lucy_Host_callback(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;

    va_start(args, num_args);
    SI_push_args(vobj, args, num_args);
    va_end(args);

    {
        int count = call_method(method, G_VOID | G_DISCARD);
        if (count != 0) {
            CFISH_THROW(LUCY_ERR, "callback '%s' returned too many values: %i32",
                        method, (int32_t)count);
        }
        FREETMPS;
        LEAVE;
    }
}

int64_t
lucy_Host_callback_i64(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;
    SV *return_sv;
    int64_t retval;

    va_start(args, num_args);
    return_sv = S_do_callback_sv(vobj, method, num_args, args);
    va_end(args);
    if (sizeof(IV) == 8) {
        retval = (int64_t)SvIV(return_sv);
    }
    else {
        if (SvIOK(return_sv)) {
            // It's already no more than 32 bits, so don't convert.
            retval = SvIV(return_sv);
        }
        else {
            // Maybe lossy.
            double temp = SvNV(return_sv);
            retval = (int64_t)temp;
        }
    }

    FREETMPS;
    LEAVE;

    return retval;
}

double
lucy_Host_callback_f64(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;
    SV *return_sv;
    double retval;

    va_start(args, num_args);
    return_sv = S_do_callback_sv(vobj, method, num_args, args);
    va_end(args);
    retval = SvNV(return_sv);

    FREETMPS;
    LEAVE;

    return retval;
}

lucy_Obj*
lucy_Host_callback_obj(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;
    SV *temp_retval;
    lucy_Obj *retval = NULL;

    va_start(args, num_args);
    temp_retval = S_do_callback_sv(vobj, method, num_args, args);
    va_end(args);

    retval = XSBind_perl_to_cfish(temp_retval);

    FREETMPS;
    LEAVE;

    return retval;
}

lucy_CharBuf*
lucy_Host_callback_str(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;
    SV *temp_retval;
    lucy_CharBuf *retval = NULL;

    va_start(args, num_args);
    temp_retval = S_do_callback_sv(vobj, method, num_args, args);
    va_end(args);

    // Make a stringified copy.
    if (temp_retval && XSBind_sv_defined(temp_retval)) {
        STRLEN len;
        char *ptr = SvPVutf8(temp_retval, len);
        retval = lucy_CB_new_from_trusted_utf8(ptr, len);
    }

    FREETMPS;
    LEAVE;

    return retval;
}

void*
lucy_Host_callback_host(void *vobj, char *method, uint32_t num_args, ...) {
    va_list args;
    SV *retval;

    va_start(args, num_args);
    retval = S_do_callback_sv(vobj, method, num_args, args);
    va_end(args);
    SvREFCNT_inc(retval);

    FREETMPS;
    LEAVE;

    return retval;
}

static SV*
S_do_callback_sv(void *vobj, char *method, uint32_t num_args, va_list args) {
    SV *return_val;
    SI_push_args(vobj, args, num_args);
    {
        int num_returned = call_method(method, G_SCALAR);
        dSP;
        if (num_returned != 1) {
            CFISH_THROW(LUCY_ERR, "Bad number of return vals from %s: %i32",
                        method, (int32_t)num_returned);
        }
        return_val = POPs;
        PUTBACK;
    }
    return return_val;
}