static struct tuple*
__exec_type_from_tgtlist(struct list *targetList, bool hasoid, bool skipjunk)
{
struct tuple* typeInfo;
struct list_cell* l;
int len;
int cur_resno = 1;
if (skipjunk)
len = ExecCleanTargetListLength(targetList);
else
len = exec_tgtlist_len(targetList);
typeInfo = create_template_tupdesc(len, hasoid);
foreach(l, targetList) {
tgt_entry_xp *tle = lfirst(l);
if (skipjunk && tle->resjunk)
continue;
tupdesc_init_attr(typeInfo,
cur_resno,
tle->resname,
expr_type((node_n*) tle->expr),
expr_typmod((node_n*) tle->expr),
0);
tupdesc_init_collation(typeInfo,
cur_resno,
expr_collation((node_n *) tle->expr));
cur_resno++;
}
static Value *emit_arraylen(Value *t, jl_value_t *ex, jl_codectx_t *ctx)
{
jl_arrayvar_t *av = arrayvar_for(ex, ctx);
if (av!=NULL)
return builder.CreateLoad(av->len);
return emit_arraylen_prim(t, expr_type(ex,ctx));
}
static Value *julia_to_native(Type *ty, jl_value_t *jt, Value *jv,
jl_value_t *argex, bool addressOf,
int argn, jl_codectx_t *ctx)
{
Type *vt = jv->getType();
if (ty == jl_pvalue_llvmt) {
return boxed(jv);
}
else if (ty == vt && !addressOf) {
return jv;
}
else if (vt != jl_pvalue_llvmt) {
// argument value is unboxed
if (addressOf) {
if (ty->isPointerTy() && ty->getContainedType(0)==vt) {
// pass the address of an alloca'd thing, not a box
// since those are immutable.
Value *slot = builder.CreateAlloca(vt);
builder.CreateStore(jv, slot);
return builder.CreateBitCast(slot, ty);
}
}
else if ((vt->isIntegerTy() && ty->isIntegerTy()) ||
(vt->isFloatingPointTy() && ty->isFloatingPointTy()) ||
(vt->isPointerTy() && ty->isPointerTy())) {
if (vt->getPrimitiveSizeInBits() ==
ty->getPrimitiveSizeInBits()) {
return builder.CreateBitCast(jv, ty);
}
}
// error. box for error handling.
jv = boxed(jv);
}
else if (jl_is_cpointer_type(jt) && addressOf) {
jl_value_t *aty = expr_type(argex, ctx);
if (jl_is_array_type(aty) &&
(jl_tparam0(jt) == jl_tparam0(aty) ||
jl_tparam0(jt) == (jl_value_t*)jl_bottom_type)) {
// array to pointer
return builder.CreateBitCast(emit_arrayptr(jv), ty);
}
Value *p = builder.CreateCall3(value_to_pointer_func,
literal_pointer_val(jl_tparam0(jt)), jv,
ConstantInt::get(T_int32, argn));
assert(ty->isPointerTy());
return builder.CreateBitCast(p, ty);
}
// TODO: error for & with non-pointer argument type
assert(jl_is_bits_type(jt));
std::stringstream msg;
msg << "ccall argument ";
msg << argn;
emit_typecheck(jv, jt, msg.str(), ctx);
Value *p = bitstype_pointer(jv);
return builder.CreateLoad(builder.CreateBitCast(p,
PointerType::get(ty,0)),
false);
}
static void
private_array_resolve_symbols (type_t * tself, container_t * context, logger_t * log)
{
estring_t * tmp = NULL;
t_array_t * self = &(tself->t_array);
// We need to resolve array bounds.
boundspair_t * bp = self->bounds;
expression_t * hi = boundspair_hi (bp);
expression_t * lo = boundspair_lo (bp);
// symbols in bounds are resolved with use of parental
// symtab. The following is illegal:
// 'begin' 'integer' y; 'integer' 'array' z[1:y]; 'end';
expr_resolve_symbols (lo, container_parent (context), log);
expr_resolve_symbols (hi, container_parent (context), log);
type_resolve_symbols (self->host, context, log);
type_t * lot = expr_type (lo);
type_t * hit = expr_type (hi);
// Type of `unknown' means that appropriate reporting action has
// already been taken. Type of `implicit' means the symbol is yet
// to be resolved.
if (!type_is_unknown (lot) && !type_is_implicit (lot)
&& !types_match (lot, type_int ()))
{
log_printfc (log, ll_error, expr_cursor (lo),
"invalid type %s in lower boundary",
estr_cstr (tmp = type_to_str (lot, tmp)));
boundspair_set_lo (bp, expr_primitive_for_type (type_int ()));
}
if (!type_is_unknown (hit) && !type_is_implicit (hit)
&& !types_match (hit, type_int ()))
{
log_printfc (log, ll_error, expr_cursor (hi),
"invalid type %s in upper boundary",
estr_cstr (tmp = type_to_str (hit, tmp)));
boundspair_set_hi (bp, expr_primitive_for_type (type_int ()));
}
delete_estring (tmp);
}
/*
* Transform the subscript expressions.
*/
foreach(idx, indirection) {
A_Indices *ai = (A_Indices *) lfirst(idx);
node_n *subexpr;
ASSERT(IS_A(ai, A_Indices));
if (isSlice) {
if (ai->lidx) {
subexpr = xfrm_expr(pstate, ai->lidx);
/* If it's not int4 already, try to coerce */
subexpr = coerce_to_target_type(pstate, subexpr, expr_type(subexpr), INT4OID, -1,
COERCION_ASSIGNMENT, COERCE_IMPLICIT_CAST, -1);
if (subexpr == NULL)
ereport(ERROR, (
errcode(E_DATATYPE_MISMATCH),
errmsg("array subscript must have type integer"),
parser_errpos(pstate, expr_location(ai->lidx))));
} else {
/* Make a constant 1 */
subexpr = (node_n *) makeConst(INT4OID, -1, INVALID_OID, sizeof(int32), INT32_TO_D(1),
false, true);
/* pass by value */
}
lowerIndexpr = lappend(lowerIndexpr, subexpr);
}
subexpr = xfrm_expr(pstate, ai->uidx);
/* If it's not int4 already, try to coerce */
subexpr = coerce_to_target_type(pstate, subexpr, expr_type(subexpr), INT4OID, -1,
COERCION_ASSIGNMENT, COERCE_IMPLICIT_CAST, -1);
if (subexpr == NULL)
ereport(ERROR, (
errcode(E_DATATYPE_MISMATCH),
errmsg("array subscript must have type integer"),
parser_errpos(pstate, expr_location(ai->uidx))));
upperIndexpr = lappend(upperIndexpr, subexpr);
}
/*
* gen_shift
*
* Shifts are a little tricky, since LLVM has explicit left-shift and
* right-shift instructions, which take non-negative shift values. BLISS,
* on the other hand, has a single shift operator and generates right-shifts
* when the RHS is negative. If the RHS is a constant, we can do the translation
* here; otherwise, we have to build a conditional to check at runtime.
*/
static LLVMValueRef
gen_shift (gencodectx_t gctx, expr_node_t *lhs, expr_node_t *rhs, LLVMTypeRef neededtype)
{
LLVMBuilderRef builder = gctx->curfn->builder;
LLVMTypeRef inttype = gctx->fullwordtype;
LLVMValueRef lval, rval, result, test;
lval = (lhs == 0 ? 0 : llvmgen_expression(gctx, lhs, inttype));
if (expr_type(rhs) == EXPTYPE_PRIM_LIT) {
long count = expr_litval(rhs);
if (count < 0) {
rval = LLVMConstInt(inttype, -count, 0);
result = LLVMBuildLShr(builder, lval, rval, llvmgen_temp(gctx));
} else {
rval = LLVMConstInt(inttype, count, 0);
result = LLVMBuildShl(builder, lval, rval, llvmgen_temp(gctx));
}
} else {
LLVMBasicBlockRef exitblock = llvmgen_exitblock_create(gctx, 0);
LLVMBasicBlockRef lshiftblk, rshiftblk;
llvm_btrack_t *bt = llvmgen_btrack_create(gctx, exitblock);
lshiftblk = LLVMInsertBasicBlockInContext(gctx->llvmctx, exitblock, llvmgen_label(gctx));
rshiftblk = LLVMInsertBasicBlockInContext(gctx->llvmctx, exitblock, llvmgen_label(gctx));
rval = llvmgen_expression(gctx, rhs, inttype);
test = LLVMBuildICmp(builder, LLVMIntSLT, rval, LLVMConstNull(inttype), llvmgen_temp(gctx));
LLVMBuildCondBr(builder, test, rshiftblk, lshiftblk);
LLVMPositionBuilderAtEnd(builder, lshiftblk);
result = LLVMBuildShl(builder, lval, rval, llvmgen_temp(gctx));
llvmgen_btrack_update(gctx, bt, result);
LLVMPositionBuilderAtEnd(builder, rshiftblk);
rval = LLVMBuildNeg(builder, rval, llvmgen_temp(gctx));
result = LLVMBuildLShr(builder, lval, rval, llvmgen_temp(gctx));
llvmgen_btrack_update(gctx, bt, result);
result = llvmgen_btrack_finalize(gctx, bt, inttype);
}
return llvmgen_adjustval(gctx, result, neededtype, 0);
} /* gen_shift */
/* How many child expressions are used by each type of expression. */
int expr_nr_kids(struct expression *expr)
{
switch (expr_type(expr)) {
case EXPR_ARRAY_DEREF:
case EXPR_BINOP:
case EXPR_ARGS_LIST:
return 2;
case EXPR_UNARY_OP:
case EXPR_CONVERSION:
case EXPR_CONVERSION_TO_FLOAT:
case EXPR_CONVERSION_FROM_FLOAT:
case EXPR_INSTANCE_FIELD:
case EXPR_INVOKE:
case EXPR_INVOKEINTERFACE:
case EXPR_INVOKEVIRTUAL:
case EXPR_FINVOKE:
case EXPR_FINVOKEVIRTUAL:
case EXPR_ARG:
case EXPR_NEWARRAY:
case EXPR_ANEWARRAY:
case EXPR_MULTIANEWARRAY:
case EXPR_ARRAYLENGTH:
case EXPR_INSTANCEOF:
case EXPR_NULL_CHECK:
case EXPR_ARRAY_SIZE_CHECK:
case EXPR_MULTIARRAY_SIZE_CHECK:
return 1;
case EXPR_VALUE:
case EXPR_FVALUE:
case EXPR_LOCAL:
case EXPR_TEMPORARY:
case EXPR_CLASS_FIELD:
case EXPR_NO_ARGS:
case EXPR_NEW:
case EXPR_EXCEPTION_REF:
case EXPR_MIMIC_STACK_SLOT:
return 0;
default:
assert(!"Invalid expression type");
}
}
/*
* make_scalar_array_op()
* Build expression tree for "scalar op ANY/ALL (array)" construct.
*/
expr_n*
make_scalar_array_op(
parse_state_s* pstate,
struct list* opname,
bool useOr,
node_n *ltree,
node_n *rtree,
int location)
{
oid_t ltypeId;
oid_t rtypeId;
oid_t atypeId;
oid_t res_atypeId;
Operator tup;
Form_pg_operator opform;
oid_t actual_arg_types[2];
oid_t declared_arg_types[2];
struct list* args;
oid_t rettype;
scalar_array_opr_xp *result;
ltypeId = expr_type(ltree);
atypeId = expr_type(rtree);
/*
* The right-hand input of the operator will be the element type of the
* array. However, if we currently have just an untyped literal on the
* right, stay with that and hope we can resolve the operator.
*/
if (atypeId == UNKNOWNOID) {
rtypeId = UNKNOWNOID;
} else {
rtypeId = get_base_element_type(atypeId);
if (!OID_VALID(rtypeId))
ereport(ERROR, (
errcode(E_WRONG_OBJECT_TYPE),
errmsg("op ANY/ALL (array) requires array on right side"),
parser_errpos(pstate, location)));
}
/* Now resolve the operator */
tup = oper(pstate, opname, ltypeId, rtypeId, false, location);
opform = (Form_pg_operator) GET_STRUCT(tup);
/* Check it's not a shell */
if (!REGPROC_VALID(opform->oprcode)) {
ereport(ERROR, (
errcode(E_UNDEFINED_FUNCTION),
errmsg("operator is only a shell: %s",
opr_signature_string(opname, opform->oprkind, opform->oprleft, opform->oprright)),
parser_errpos(pstate, location)));
}
args = list_make2(ltree, rtree);
actual_arg_types[0] = ltypeId;
actual_arg_types[1] = rtypeId;
declared_arg_types[0] = opform->oprleft;
declared_arg_types[1] = opform->oprright;
/*
* enforce consistency with polymorphic argument and return types,
* possibly adjusting return type or declared_arg_types (which will be
* used as the cast destination by make_fn_arguments)
*/
rettype = enforce_generic_type_consistency(actual_arg_types, declared_arg_types, 2, opform->oprresult, false);
/*
* Check that operator result is boolean
*/
if (rettype != BOOLOID)
ereport(ERROR, (
errcode(E_WRONG_OBJECT_TYPE),
errmsg("op ANY/ALL (array) requires operator to yield boolean"),
parser_errpos(pstate, location)));
if (get_func_retset(opform->oprcode))
ereport(ERROR, (
errcode(E_WRONG_OBJECT_TYPE),
errmsg("op ANY/ALL (array) requires operator not to return a set"),
parser_errpos(pstate, location)));
/*
* Now switch back to the array type on the right, arranging for any
* needed cast to be applied. Beware of polymorphic operators here;
* enforce_generic_type_consistency may or may not have replaced a
* polymorphic type with a real one.
*/
if (is_polymorphic_type(declared_arg_types[1])) {
/* assume the actual array type is OK */
res_atypeId = atypeId;
} else {
res_atypeId = get_array_type(declared_arg_types[1]);
if (!OID_VALID(res_atypeId))
ereport(ERROR, (
errcode(E_UNDEFINED_OBJECT),
errmsg("could not find array type for data type %s",
format_type_be(declared_arg_types[1])),
parser_errpos(pstate, location)));
}
actual_arg_types[1] = atypeId;
declared_arg_types[1] = res_atypeId;
/* perform the necessary typecasting of arguments */
make_fn_arguments(pstate, args, actual_arg_types, declared_arg_types);
/* and build the expression node */
result = MK_N(ScalarArrayOpExpr,scalar_array_opr_xp);
result->opno = opr_id(tup);
result->opfuncid = opform->oprcode;
result->useOr = useOr;
/* inputcollid will be set by parse_collate.c */
result->args = args;
result->location = location;
release_syscache(tup);
return (expr_n *) result;
}
static Value *julia_to_native(Type *ty, jl_value_t *jt, Value *jv,
jl_value_t *argex, bool addressOf,
int argn, jl_codectx_t *ctx,
bool *mightNeedTempSpace, bool *needStackRestore)
{
Type *vt = jv->getType();
if (ty == jl_pvalue_llvmt) {
return boxed(jv,ctx);
}
else if (ty == vt && !addressOf) {
return jv;
}
else if (vt != jl_pvalue_llvmt) {
// argument value is unboxed
if (addressOf) {
if (ty->isPointerTy() && ty->getContainedType(0)==vt) {
// pass the address of an alloca'd thing, not a box
// since those are immutable.
*needStackRestore = true;
Value *slot = builder.CreateAlloca(vt);
builder.CreateStore(jv, slot);
return builder.CreateBitCast(slot, ty);
}
}
else if ((vt->isIntegerTy() && ty->isIntegerTy()) ||
(vt->isFloatingPointTy() && ty->isFloatingPointTy()) ||
(vt->isPointerTy() && ty->isPointerTy())) {
if (vt->getPrimitiveSizeInBits() ==
ty->getPrimitiveSizeInBits()) {
return builder.CreateBitCast(jv, ty);
}
}
// error. box for error handling.
jv = boxed(jv,ctx);
}
else if (jl_is_cpointer_type(jt)) {
assert(ty->isPointerTy());
jl_value_t *aty = expr_type(argex, ctx);
if (jl_is_array_type(aty) &&
(jl_tparam0(jt) == jl_tparam0(aty) ||
jl_tparam0(jt) == (jl_value_t*)jl_bottom_type)) {
// array to pointer
return builder.CreateBitCast(emit_arrayptr(jv), ty);
}
if (aty == (jl_value_t*)jl_ascii_string_type || aty == (jl_value_t*)jl_utf8_string_type) {
return builder.CreateBitCast(emit_arrayptr(emit_nthptr(jv,1,tbaa_const)), ty);
}
if (jl_is_structtype(aty) && jl_is_leaf_type(aty) && !jl_is_array_type(aty)) {
if (!addressOf) {
emit_error("ccall: expected & on argument", ctx);
return literal_pointer_val(jl_nothing);
}
return builder.CreateBitCast(emit_nthptr_addr(jv, (size_t)1), ty); // skip type tag field
}
*mightNeedTempSpace = true;
Value *p = builder.CreateCall4(prepare_call(value_to_pointer_func),
literal_pointer_val(jl_tparam0(jt)), jv,
ConstantInt::get(T_int32, argn),
ConstantInt::get(T_int32, (int)addressOf));
return builder.CreateBitCast(p, ty);
}
else if (jl_is_structtype(jt)) {
if (addressOf)
jl_error("ccall: unexpected & on argument"); // the only "safe" thing to emit here is the expected struct
assert (ty->isStructTy() && (Type*)((jl_datatype_t*)jt)->struct_decl == ty);
jl_value_t *aty = expr_type(argex, ctx);
if (aty != jt) {
std::stringstream msg;
msg << "ccall argument ";
msg << argn;
emit_typecheck(jv, jt, msg.str(), ctx);
}
//TODO: check instead that prefix matches
//if (!jl_is_structtype(aty))
// emit_typecheck(emit_typeof(jv), (jl_value_t*)jl_struct_kind, "ccall: Struct argument called with something that isn't a struct", ctx);
// //safe thing would be to also check that jl_typeof(aty)->size > sizeof(ty) here and/or at runtime
Value *pjv = builder.CreateBitCast(emit_nthptr_addr(jv, (size_t)1), PointerType::get(ty,0));
return builder.CreateLoad(pjv, false);
}
else if (jl_is_tuple(jt)) {
return emit_unbox(ty,jv,jt);
}
// TODO: error for & with non-pointer argument type
assert(jl_is_bitstype(jt));
std::stringstream msg;
msg << "ccall argument ";
msg << argn;
emit_typecheck(jv, jt, msg.str(), ctx);
Value *p = data_pointer(jv);
return builder.CreateLoad(builder.CreateBitCast(p,
PointerType::get(ty,0)),
false);
}
// included from constructor for function_signatures() in
// src/stan/gm/ast.hpp
std::vector<base_expr_type> base_types;
base_types.push_back(INT_T);
base_types.push_back(DOUBLE_T);
base_types.push_back(VECTOR_T);
base_types.push_back(ROW_VECTOR_T);
base_types.push_back(MATRIX_T);
std::vector<expr_type> vector_types;
vector_types.push_back(DOUBLE_T); // scalar
vector_types.push_back(expr_type(DOUBLE_T,1U)); // std vector
vector_types.push_back(VECTOR_T); // Eigen vector
vector_types.push_back(ROW_VECTOR_T); // Eigen row vector
std::vector<expr_type> int_vector_types;
int_vector_types.push_back(INT_T); // scalar
int_vector_types.push_back(expr_type(INT_T,1U)); // std vector
std::vector<expr_type> primitive_types;
primitive_types.push_back(INT_T);
primitive_types.push_back(DOUBLE_T);
add_unary("abs");
add("abs",INT_T,INT_T);
add_unary("acos");
add_unary("acosh");
add("add",VECTOR_T,VECTOR_T,VECTOR_T);
add("add",ROW_VECTOR_T,ROW_VECTOR_T,ROW_VECTOR_T);
add("add",MATRIX_T,MATRIX_T,MATRIX_T);
/*
* make_opr()
* Operator expression construction.
*
* Transform operator expression ensuring type compatibility.
* This is where some type conversion happens.
*
* As with coerce_type, pstate may be NULL if no special unknown-Param
* processing is wanted.
*/
expr_n*
make_opr(parse_state_s *pstate, struct list *opname, node_n *ltree, node_n *rtree, int location)
{
oid_t ltypeId;
oid_t rtypeId;
Operator tup;
Form_pg_operator opform;
oid_t actual_arg_types[2];
oid_t declared_arg_types[2];
int nargs;
struct list* args;
oid_t rettype;
opr_xp* result;
/* Select the operator */
if (rtree == NULL) {
/* right operator */
ltypeId = expr_type(ltree);
rtypeId = INVALID_OID;
tup = right_opr(pstate, opname, ltypeId, false, location);
} else if (ltree == NULL) {
/* left operator */
rtypeId = expr_type(rtree);
ltypeId = INVALID_OID;
tup = left_opr(pstate, opname, rtypeId, false, location);
} else {
/* otherwise, binary operator */
ltypeId = expr_type(ltree);
rtypeId = expr_type(rtree);
tup = oper(pstate, opname, ltypeId, rtypeId, false, location);
}
opform = (Form_pg_operator) GET_STRUCT(tup);
/* Check it's not a shell */
if (!REGPROC_VALID(opform->oprcode))
ereport(ERROR, (
errcode(E_UNDEFINED_FUNCTION),
errmsg("operator is only a shell: %s",
opr_signature_string(opname, opform->oprkind, opform->oprleft, opform->oprright)),
parser_errpos(pstate, location)));
/* Do typecasting and build the expression tree */
if (rtree == NULL) {
/* right operator */
args = list_make1(ltree);
actual_arg_types[0] = ltypeId;
declared_arg_types[0] = opform->oprleft;
nargs = 1;
} else if (ltree == NULL) {
/* left operator */
args = list_make1(rtree);
actual_arg_types[0] = rtypeId;
declared_arg_types[0] = opform->oprright;
nargs = 1;
} else {
/* otherwise, binary operator */
args = list_make2(ltree, rtree);
actual_arg_types[0] = ltypeId;
actual_arg_types[1] = rtypeId;
declared_arg_types[0] = opform->oprleft;
declared_arg_types[1] = opform->oprright;
nargs = 2;
}
/*
* enforce consistency with polymorphic argument and return types,
* possibly adjusting return type or declared_arg_types (which will be
* used as the cast destination by make_fn_arguments)
*/
rettype = enforce_generic_type_consistency(actual_arg_types, declared_arg_types, nargs, opform->oprresult,
false);
/* perform the necessary typecasting of arguments */
make_fn_arguments(pstate, args, actual_arg_types, declared_arg_types);
/* and build the expression node */
result = MK_N(OpExpr,opr_xp);
result->opno = opr_id(tup);
result->opfuncid = opform->oprcode;
result->opresulttype = rettype;
result->opretset = get_func_retset(opform->oprcode);
/* opcollid and inputcollid will be set by parse_collate.c */
result->args = args;
result->location = location;
release_syscache(tup);
return (expr_n *) result;
}
/* ----------------------------------------------------------------
* procedure_create
*
* Note: allParameterTypes, parameterModes, parameterNames, and proconfig
* are either arrays of the proper types or NULL. We declare them Datum,
* not "ArrayType *", to avoid importing array.h into pg_proc_fn.h.
* ----------------------------------------------------------------
*/
oid_t
procedure_create(
const char *procedureName,
oid_t procNamespace,
bool replace,
bool returnsSet,
oid_t returnType,
oid_t languageObjectId,
oid_t languageValidator,
const char *prosrc,
const char *probin,
bool isAgg,
bool isWindowFunc,
bool security_definer,
bool isStrict,
char volatility,
oid_vector_s *parameterTypes,
datum_t allParameterTypes,
datum_t parameterModes,
datum_t parameterNames,
struct list *parameterDefaults,
datum_t proconfig,
float4 procost,
float4 prorows)
{
oid_t retval;
int parameterCount;
int allParamCount;
oid_t* allParams;
bool genericInParam = false;
bool genericOutParam = false;
bool internalInParam = false;
bool internalOutParam = false;
oid_t variadicType = INVALID_OID;
oid_t proowner = get_uid();
acl_s* proacl = NULL;
struct relation* rel;
struct heap_tuple* tup;
struct heap_tuple* oldtup;
bool nulls[Natts_pg_proc];
datum_t values[Natts_pg_proc];
bool replaces[Natts_pg_proc];
oid_t relid;
struct name procname;
struct tuple* tupDesc;
bool is_update;
struct objaddr myself;
struct objaddr referenced;
int i;
/*
* sanity checks
*/
ASSERT(PTR_VALID(prosrc));
parameterCount = parameterTypes->dim1;
if (parameterCount < 0 || parameterCount > FUNC_MAX_ARGS) {
ereport(ERROR, (
errcode(E_TOO_MANY_ARGUMENTS),
errmsg_plural("functions cannot have more than %d argument",
"functions cannot have more than %d arguments",
FUNC_MAX_ARGS,
FUNC_MAX_ARGS)));
}
/* note: the above is correct, we do NOT count output arguments */
if (allParameterTypes != PTR_TO_D(NULL)) {
/*
* We expect the array to be a 1-D OID array; verify that. We don't
* need to use deconstruct_array() since the array data is just going
* to look like a C array of OID values.
*/
array_s *allParamArray;
allParamArray = (array_s*) D_TO_PTR(allParameterTypes);
allParamCount = ARR_DIMS(allParamArray)[0];
if (ARR_NDIM(allParamArray) != 1
|| allParamCount <= 0
|| ARR_HASNULL(allParamArray)
|| ARR_ELEMTYPE(allParamArray) != OIDOID)
elog(ERROR, "allParameterTypes is not a 1-D oid_t array");
allParams = (oid_t*) ARR_DATA_PTR(allParamArray);
ASSERT(allParamCount >= parameterCount);
/* we assume caller got the contents right */
} else {
allParamCount = parameterCount;
allParams = parameterTypes->values;
}
/*
* Do not allow polymorphic return type unless at least one input argument
* is polymorphic. Also, do not allow return type INTERNAL unless at
* least one input argument is INTERNAL.
*/
for (i = 0; i < parameterCount; i++) {
switch (parameterTypes->values[i]) {
case ANYARRAYOID:
case ANYELEMENTOID:
case ANYNONARRAYOID:
case ANYENUMOID:
genericInParam = true;
break;
case INTERNALOID:
internalInParam = true;
break;
}
}
if (allParameterTypes != PTR_TO_D(NULL)) {
for (i = 0; i < allParamCount; i++) {
/*
* We don't bother to distinguish input and output params here, so
* if there is, say, just an input INTERNAL param then we will
* still set internalOutParam. This is OK since we don't really
* care.
*/
switch (allParams[i]) {
case ANYARRAYOID:
case ANYELEMENTOID:
case ANYNONARRAYOID:
case ANYENUMOID:
genericOutParam = true;
break;
case INTERNALOID:
internalOutParam = true;
break;
}
}
}
if ((is_polymorphic_type(returnType) || genericOutParam)
&& !genericInParam) {
ereport(ERROR, (
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot determine result data type"),
errdetail("A function returning a polymorphic type must have"
" at least one polymorphic argument.")));
}
if ((returnType == INTERNALOID || internalOutParam)
&& !internalInParam) {
ereport(ERROR, (
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("unsafe use of pseudo-type \"internal\""),
errdetail("A function returning \"internal\" must have at"
" least one \"internal\" argument.")));
}
/*
* don't allow functions of complex types that have the same name as
* existing attributes of the type
*/
if (parameterCount == 1
&& OID_VALID(parameterTypes->values[0])
&& (relid = typeid_to_relid(parameterTypes->values[0])) != INVALID_OID
&& get_attnum(relid, procedureName) != INVALID_ATTR_NR) {
ereport(ERROR, (
errcode(E_DUPLICATE_COLUMN),
errmsg("\"%s\" is already an attribute of type %s",
procedureName,
format_type_be(parameterTypes->values[0]))));
}
if (parameterModes != PTR_TO_D(NULL)) {
/*
* We expect the array to be a 1-D CHAR array; verify that. We don't
* need to use deconstruct_array() since the array data is just going
* to look like a C array of char values.
*/
array_s* modesArray;
char* modes;
modesArray = (array_s *) D_TO_PTR(parameterModes);
if (ARR_NDIM(modesArray) != 1
|| ARR_DIMS(modesArray)[0] != allParamCount
|| ARR_HASNULL(modesArray)
|| ARR_ELEMTYPE(modesArray) != CHAROID)
elog(ERROR, "parameterModes is not a 1-D char array");
modes = (char*) ARR_DATA_PTR(modesArray);
/*
* Only the last input parameter can be variadic; if it is, save its
* element type. Errors here are just elog since caller should have
* checked this already.
*/
for (i = 0; i < allParamCount; i++) {
switch (modes[i]) {
case PROARGMODE_IN:
case PROARGMODE_INOUT:
if (OID_VALID(variadicType))
elog(ERROR, "variadic parameter must be last");
break;
case PROARGMODE_OUT:
case PROARGMODE_TABLE:
/* okay */
break;
case PROARGMODE_VARIADIC:
if (OID_VALID(variadicType))
elog(ERROR, "variadic parameter must be last");
switch (allParams[i]) {
case ANYOID:
variadicType = ANYOID;
break;
case ANYARRAYOID:
variadicType = ANYELEMENTOID;
break;
default:
variadicType = get_element_type(allParams[i]);
if (!OID_VALID(variadicType))
elog(ERROR, "variadic parameter is not an array");
break;
}
break;
default:
elog(ERROR, "invalid parameter mode '%c'", modes[i]);
break;
}
}
}
/*
* All seems OK; prepare the data to be inserted into pg_proc.
*/
for (i = 0; i < Natts_pg_proc; ++i) {
nulls[i] = false;
values[i] = (datum_t) 0;
replaces[i] = true;
}
namestrcpy(&procname, procedureName);
values[Anum_pg_proc_proname - 1] = NAME_TO_D(&procname);
values[Anum_pg_proc_pronamespace - 1] = OID_TO_D(procNamespace);
values[Anum_pg_proc_proowner - 1] = OID_TO_D(proowner);
values[Anum_pg_proc_prolang - 1] = OID_TO_D(languageObjectId);
values[Anum_pg_proc_procost - 1] = FLOAT4_TO_D(procost);
values[Anum_pg_proc_prorows - 1] = FLOAT4_TO_D(prorows);
values[Anum_pg_proc_provariadic - 1] = OID_TO_D(variadicType);
values[Anum_pg_proc_proisagg - 1] = BOOL_TO_D(isAgg);
values[Anum_pg_proc_proiswindow - 1] = BOOL_TO_D(isWindowFunc);
values[Anum_pg_proc_prosecdef - 1] = BOOL_TO_D(security_definer);
values[Anum_pg_proc_proisstrict - 1] = BOOL_TO_D(isStrict);
values[Anum_pg_proc_proretset - 1] = BOOL_TO_D(returnsSet);
values[Anum_pg_proc_provolatile - 1] = CHAR_TO_D(volatility);
values[Anum_pg_proc_pronargs - 1] = UINT16_TO_D(parameterCount);
values[Anum_pg_proc_pronargdefaults - 1] = UINT16_TO_D(list_length(parameterDefaults));
values[Anum_pg_proc_prorettype - 1] = OID_TO_D(returnType);
values[Anum_pg_proc_proargtypes - 1] = PTR_TO_D(parameterTypes);
if (allParameterTypes != PTR_TO_D(NULL))
values[Anum_pg_proc_proallargtypes - 1] = allParameterTypes;
else
nulls[Anum_pg_proc_proallargtypes - 1] = true;
if (parameterModes != PTR_TO_D(NULL))
values[Anum_pg_proc_proargmodes - 1] = parameterModes;
else
nulls[Anum_pg_proc_proargmodes - 1] = true;
if (parameterNames != PTR_TO_D(NULL))
values[Anum_pg_proc_proargnames - 1] = parameterNames;
else
nulls[Anum_pg_proc_proargnames - 1] = true;
if (parameterDefaults != NIL)
values[Anum_pg_proc_proargdefaults - 1] = CStringGetTextDatum(
node_to_string(parameterDefaults));
else
nulls[Anum_pg_proc_proargdefaults - 1] = true;
values[Anum_pg_proc_prosrc - 1] = CStringGetTextDatum(prosrc);
if (probin)
values[Anum_pg_proc_probin - 1] = CStringGetTextDatum(probin);
else
nulls[Anum_pg_proc_probin - 1] = true;
if (proconfig != PTR_TO_D(NULL))
values[Anum_pg_proc_proconfig - 1] = proconfig;
else
nulls[Anum_pg_proc_proconfig - 1] = true;
/*
* proacl will be determined later
*/
rel = heap_open(ProcedureRelationId, ROW_EXCL_LOCK);
tupDesc = REL_DESC(rel);
/* Check for pre-existing definition */
oldtup = search_syscache3(
PROCNAMEARGSNSP,
PTR_TO_D(procedureName),
PTR_TO_D(parameterTypes),
OID_TO_D(procNamespace));
if (HT_VALID(oldtup)) {
/* There is one; okay to replace it? */
Form_pg_proc oldproc;
datum_t proargnames;
bool isnull;
oldproc = (Form_pg_proc) GET_STRUCT(oldtup);
if (!replace) {
ereport(ERROR, (
errcode(E_DUPLICATE_FUNCTION),
errmsg("function \"%s\" already exists with same argument types",
procedureName)));
}
if (!pg_proc_ownercheck(HEAPTUP_OID(oldtup), proowner))
aclcheck_error(ACLCHECK_NOT_OWNER, ACL_KIND_PROC, procedureName);
/*
* Not okay to change the return type of the existing proc, since
* existing rules, views, etc may depend on the return type.
*/
if (returnType != oldproc->prorettype
|| returnsSet != oldproc->proretset) {
ereport(ERROR, (
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot change return type of existing function"),
errhint("Use DROP FUNCTION first.")));
}
/*
* If it returns RECORD, check for possible change of record type
* implied by OUT parameters
*/
if (returnType == RECORDOID) {
struct tuple* olddesc;
struct tuple* newdesc;
olddesc = build_function_result_tupdesc_t(oldtup);
newdesc = build_function_result_tupdesc_d(
allParameterTypes,
parameterModes,
parameterNames);
if (olddesc == NULL
&& newdesc == NULL) {
/* ok, both are runtime-defined RECORDs */ ;
} else if (olddesc == NULL
|| newdesc == NULL
|| !tupdesc_equal(olddesc, newdesc)) {
ereport(ERROR, (
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot change return type of existing function"),
errdetail("Row type defined by OUT parameters is different."),
errhint("Use DROP FUNCTION first.")));
}
}
/*
* If there were any named input parameters, check to make sure the
* names have not been changed, as this could break existing calls. We
* allow adding names to formerly unnamed parameters, though.
*/
proargnames = syscache_attr(
PROCNAMEARGSNSP,
oldtup,
Anum_pg_proc_proargnames,
&isnull);
if (!isnull) {
datum_t proargmodes;
char** old_arg_names;
char** new_arg_names;
int n_old_arg_names;
int n_new_arg_names;
int j;
proargmodes = syscache_attr(
PROCNAMEARGSNSP,
oldtup,
Anum_pg_proc_proargmodes,
&isnull);
if (isnull)
proargmodes = PTR_TO_D(NULL); /* just to be sure */
n_old_arg_names = get_func_input_arg_names(
proargnames,
proargmodes,
&old_arg_names);
n_new_arg_names = get_func_input_arg_names(
parameterNames,
parameterModes,
&new_arg_names);
for (j = 0; j < n_old_arg_names; j++) {
if (old_arg_names[j] == NULL)
continue;
if (j >= n_new_arg_names
|| new_arg_names[j] == NULL
|| strcmp(old_arg_names[j], new_arg_names[j]) != 0) {
ereport(ERROR,(
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot change name of input parameter \"%s\"",
old_arg_names[j]),
errhint("Use DROP FUNCTION first.")));
}
}
}
/*
* If there are existing defaults, check compatibility: redefinition
* must not remove any defaults nor change their types. (Removing a
* default might cause a function to fail to satisfy an existing call.
* Changing type would only be possible if the associated parameter is
* polymorphic, and in such cases a change of default type might alter
* the resolved output type of existing calls.)
*/
if (oldproc->pronargdefaults != 0) {
datum_t proargdefaults;
struct list* oldDefaults;
struct list_cell* oldlc;
struct list_cell* newlc;
if (list_length(parameterDefaults) < oldproc->pronargdefaults) {
ereport(ERROR, (
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot remove parameter defaults from existing function"),
errhint("Use DROP FUNCTION first.")));
}
proargdefaults = syscache_attr(
PROCNAMEARGSNSP,
oldtup,
Anum_pg_proc_proargdefaults,
&isnull);
ASSERT(!isnull);
oldDefaults = (struct list*) string_to_node(
TextD_TO_CSTRING(proargdefaults));
ASSERT(IS_A(oldDefaults, List));
ASSERT(list_length(oldDefaults) == oldproc->pronargdefaults);
/* new list can have more defaults than old, advance over 'em */
newlc = list_head(parameterDefaults);
for (i = list_length(parameterDefaults) - oldproc->pronargdefaults;
i > 0;
i--)
newlc = lnext(newlc);
foreach(oldlc, oldDefaults) {
node_n* oldDef;
node_n* newDef;
oldDef = (node_n*) lfirst(oldlc);
newDef = (node_n*) lfirst(newlc);
if (expr_type(oldDef) != expr_type(newDef)) {
ereport(ERROR,(
errcode(E_INVALID_FUNCTION_DEFINITION),
errmsg("cannot change data type of existing"
" parameter default value"),
errhint("Use DROP FUNCTION first.")));
}
newlc = lnext(newlc);
}
}
/*
* Parse a function call
*
* For historical reasons, Postgres tries to treat the notations tab.col
* and col(tab) as equivalent: if a single-argument function call has an
* argument of complex type and the (unqualified) function name matches
* any attribute of the type, we take it as a column projection. Conversely
* a function of a single complex-type argument can be written like a
* column reference, allowing functions to act like computed columns.
*
* Hence, both cases come through here. The is_column parameter tells us
* which syntactic construct is actually being dealt with, but this is
* intended to be used only to deliver an appropriate error message,
* not to affect the semantics. When is_column is true, we should have
* a single argument (the putative table), unqualified function name
* equal to the column name, and no aggregate or variadic decoration.
* Also, when is_column is true, we return NULL on failure rather than
* reporting a no-such-function error.
*
* The argument expressions (in fargs) must have been transformed already.
* But the agg_order expressions, if any, have not been.
*/
node_n*
ParseFuncOrColumn(
parse_state_s* pstate,
struct list *funcname,
struct list *fargs,
struct list *agg_order,
bool agg_star,
bool agg_distinct,
bool func_variadic,
WindowDef* over,
bool is_column,
int location)
{
oid_t rettype;
oid_t funcid;
struct list_cell *l;
struct list_cell *nextl;
node_n *first_arg = NULL;
int nargs;
int nargsplusdefs;
oid_t actual_arg_types[FUNC_MAX_ARGS];
oid_t *declared_arg_types;
struct list *argnames;
struct list *argdefaults;
node_n *retval;
bool retset;
int nvargs;
func_code_e fdresult;
/*
* Most of the rest of the parser just assumes that functions do not have
* more than FUNC_MAX_ARGS parameters. We have to test here to protect
* against array overruns, etc. Of course, this may not be a function,
* but the test doesn't hurt.
*/
if (list_length(fargs) > FUNC_MAX_ARGS) {
ereport(ERROR, (
errcode(E_TOO_MANY_ARGUMENTS),
errmsg_plural("cannot pass more than %d argument to a function",
"cannot pass more than %d arguments to a function",
FUNC_MAX_ARGS, FUNC_MAX_ARGS),
parser_errpos(pstate, location)));
}
/*
* Extract arg type info in preparation for function lookup.
*
* If any arguments are param_xp markers of type VOID, we discard them from
* the parameter list. This is a hack to allow the JDBC driver to not
* have to distinguish "input" and "output" parameter symbols while
* parsing function-call constructs. We can't use foreach() because we
* may modify the list ...
*/
nargs = 0;
for (l = list_head(fargs); l != NULL; l = nextl) {
node_n *arg;
oid_t argtype;
arg = lfirst(l);
argtype = expr_type(arg);
nextl = lnext(l);
if (argtype == VOIDOID
&& IS_A(arg, Param)
&& !is_column) {
fargs = list_delete_ptr(fargs, arg);
continue;
}
actual_arg_types[nargs++] = argtype;
}
/*
* Check for named arguments; if there are any, build a list of names.
*
* We allow mixed notation (some named and some not), but only with all
* the named parameters after all the unnamed ones. So the name list
* corresponds to the last N actual parameters and we don't need any extra
* bookkeeping to match things up.
*/
argnames = NIL;
foreach(l, fargs) {
node_n *arg;
arg = lfirst(l);
if (IS_A(arg, NamedArgExpr)) {
named_arg_xp *na = (named_arg_xp *) arg;
struct list_cell *lc;
/* Reject duplicate arg names */
foreach(lc, argnames) {
if (strcmp(na->name, (char *)lfirst(lc)) == 0)
ereport(ERROR, (
errcode(E_SYNTAX_ERROR),
errmsg("argument name \"%s\" used more than once", na->name),
parser_errpos(pstate, na->location)));
}
argnames = lappend(argnames, na->name);
} else {
if (argnames != NIL)
/*
* structure_allocate
*
* Expands a structure allocation.
*/
int
structure_allocate (expr_ctx_t ctx, name_t *struname,
strudef_t **strup, unsigned int *nunits,
scopectx_t *scopep, int is_ref)
{
parse_ctx_t pctx = expr_parse_ctx(ctx);
strudef_t *stru = name_extraspace(struname);
machinedef_t *mach = expr_machinedef(ctx);
lexctx_t lctx = expr_lexmemctx(ctx);
lexseq_t tmpseq;
scopectx_t myscope, retscope;
nameref_t *ref;
int nomoreactuals;
int nobrackets = 0;
int allowed_aus = 0;
static lextype_t aus[4] = { LEXTYPE_AU_BYTE, LEXTYPE_AU_WORD,
LEXTYPE_AU_LONG, LEXTYPE_AU_QUAD };
static lextype_t su[2] = { LEXTYPE_ATTR_UNSIGNED, LEXTYPE_ATTR_SIGNED };
if (!parser_expect(pctx, QL_NORMAL, LEXTYPE_DELIM_LBRACK, 0, 1)) {
nobrackets = 1;
}
// Set up for matching the allocation-unit names to byte counts,
// but only on byte-addressable machines
if (machine_unit_bits(mach) == 8) {
for (allowed_aus = 0; allowed_aus < 4 &&
machine_scalar_units(mach) >= (1<<allowed_aus); allowed_aus++);
}
myscope = parser_scope_begin(pctx);
if (scopep != 0) {
retscope = scope_begin(scope_namectx(myscope), 0);
}
// Now fill in the default values for the allocation formals, if they
// have defaults set.
for (ref = namereflist_head(&stru->alloformals); ref != 0; ref = ref->tq_next) {
if (ref->np != 0) {
strdesc_t *alloname = name_string(ref->np);
lexseq_t seq;
expr_node_t *exp;
lexseq_init(&seq);
lexseq_copy(lctx, &seq, macparam_lexseq(ref->np));
if (lexseq_length(&seq) > 0 && expr_parse_seq(ctx, &seq, &exp)) {
if (expr_type(exp) == EXPTYPE_PRIM_LIT)
litsym_special(myscope, alloname,
(unsigned int) expr_litval(exp));
expr_node_free(ctx, exp);
}
}
}
// Now parse the allocation actuals, if any have been specified.
// For an omitted actuals, fill in the default values, or zeros
// where there are no explicit defaults.
nomoreactuals = nobrackets;
for (ref = namereflist_head(&stru->alloformals); ref != 0; ref = ref->tq_next) {
if (ref->np != 0) {
name_t *np, *rnp;
strdesc_t *alloname = name_string(ref->np);
unsigned long val;
int i = -1;
np = 0;
// An actual could be one of the allocation-unit keywords
// or SIGNED/UNSIGNED, on certain machines, so check for
// those as well as for a normal compile-time constant
// expresion.
if (!nomoreactuals) {
if (allowed_aus > 0) {
i = parser_expect_oneof(pctx, QL_NORMAL, aus,
allowed_aus, 0, 1);
if (i >= 0) {
val = 1L << i;
}
}
if ((i < 0) && machine_signext_supported(mach)) {
i = parser_expect_oneof(pctx, QL_NORMAL, su, 2, 0, 1);
if (i >= 0) {
val = i;
}
}
if ((i < 0) && expr_parse_ctce(ctx, 0, (long *)&val)) {
np = litsym_special(myscope, alloname, val);
i = 0;
}
}
if (i < 0) {
np = litsym_search(myscope, alloname, &val);
if (np == 0) {
val = 0;
}
}
if (np == 0) {
np = litsym_special(myscope, alloname, val);
if (np == 0) {
expr_signal(ctx, STC__INTCMPERR, "structure_allocate[4]");
}
}
// Now copy the declaration into the scope we'll pass back
// to the caller for later use
if (scopep != 0) {
rnp = litsym_special(retscope, alloname, val);
if (rnp == 0) {
expr_signal(ctx, STC__INTCMPERR, "structure_allocate[5]");
}
}
}
if (!nomoreactuals &&
!parser_expect(pctx, QL_NORMAL, LEXTYPE_DELIM_COMMA, 0, 1)) {
nomoreactuals = 1;
}
} /* loop through all of the allocation parameters */
if (!nobrackets &&
!parser_expect(pctx, QL_NORMAL, LEXTYPE_DELIM_RBRACK, 0, 1)) {
expr_signal(ctx, STC__DELIMEXP, "]");
}
// A structure definition may not actually have an
// allocation part, but may only be used for accessing
// storage allocated in some other way.
if (lexseq_length(&stru->allobody) == 0) {
*nunits = 0;
} else {
long val;
lexseq_init(&tmpseq);
lexseq_copy(lctx, &tmpseq, &stru->allobody);
parser_insert_seq(pctx, &tmpseq);
if (!expr_parse_ctce(ctx, 0, &val)) {
expr_signal(ctx, STC__EXPCTCE);
return 0;
}
*nunits = (unsigned int) val;
}
if (scopep != 0) *scopep = retscope;
parser_scope_end(pctx);
if (strup != 0) *strup = stru;
return 1;
} /* structure_allocate */
/*
* structure_reference
*
* Expands a structure reference, for both the general case
* and the ordinary case.
*
* General structure reference
* structure-name [ expression {,access-actual...} {; alloc-actual...} ]
*
* Ordinary structure reference
* segment-name [ access-actual... ]
*
*/
expr_node_t *
structure_reference (expr_ctx_t ctx, name_t *struname, int ctce_accessors,
name_t *symname, lexeme_t *curlex)
{
parse_ctx_t pctx = expr_parse_ctx(ctx);
lexctx_t lctx = expr_lexmemctx(ctx);
lextype_t delim;
lexseq_t seq;
scopectx_t myscope, fldscope;
nameref_t *ref;
expr_node_t *exp, *resexp;
textpos_t pos = parser_curpos(pctx);
strudef_t *stru = name_extraspace(struname);
static lextype_t delims[3] = { LEXTYPE_DELIM_RBRACK, LEXTYPE_DELIM_COMMA,
LEXTYPE_DELIM_SEMI };
int ndelims;
fldscope = 0;
lexseq_init(&seq);
// If this is a general structure reference, get the
// address expression
if (symname == 0) {
// It might be more correct to use expr_parse_expr() here to get
// the address expression, rather than deferring that to the
// expansion step later, but just handling it lexically was
// simpler to implement. XXX
ndelims = 3;
if (!parse_lexeme_seq(pctx, 0, QL_NORMAL, delims, 3, &seq, &delim)) {
return 0;
}
myscope = scope_copy(stru->acctbl, 0);
} else {
// Here we have an ordinary structure reference, and can use
// the symbol name for the base address.
data_attr_t *attr = datasym_attr(symname);
if (attr == 0) {
expr_signal(ctx, STC__INTCMPERR, "structure_reference[1]");
return 0;
}
lexseq_instail(&seq,lexeme_copy(lctx, curlex));
// Semicolons (and allocation-formals) not allowed in this case
ndelims = 2;
delim = LEXTYPE_DELIM_COMMA;
myscope = ((attr->struscope == 0)
? scope_begin(expr_namectx(ctx), 0)
: scope_copy(attr->struscope, 0));
// Bring in the field names, so they can be used in the
// the structure expression
if (namereflist_length(&attr->fields) > 0) {
fldscope = scope_begin(scope_namectx(myscope), 0);
for (ref = namereflist_head(&attr->fields); ref != 0;
ref = ref->tq_next) {
if (ref->np != 0) {
strdesc_t *fname = name_string(ref->np);
macparam_special(fldscope, fname, field_lexseq(ref->np));
}
}
}
}
// In the expansion, the name of the structure represents the
// base address, so define that as a macro parameter.
macparam_special(myscope, name_string(struname), &seq);
lexseq_free(lctx, &seq);
// Now parse the access-actuals, bringing the field names into scope.
if (fldscope != 0) {
parser_scope_push(pctx, fldscope);
}
for (ref = namereflist_head(&stru->accformals); ref != 0; ref = ref->tq_next) {
if (ref->np != 0) {
strdesc_t *pname = name_string(ref->np);
lexseq_init(&seq);
if (delim == LEXTYPE_DELIM_COMMA) {
if (!parse_lexeme_seq(pctx, 0, QL_NORMAL, delims, ndelims,
&seq, &delim)) {
expr_signal(ctx, STC__SYNTAXERR);
break;
}
if (ctce_accessors) {
lexseq_t testseq;
lexseq_init(&testseq);
lexseq_copy(lctx, &testseq, &seq);
if (!expr_parse_seq(ctx, &testseq, &exp) ||
expr_type(exp) != EXPTYPE_PRIM_LIT) {
expr_signal(ctx, STC__EXPCTCE);
} else {
expr_node_free(ctx, exp);
}
lexseq_free(lctx, &testseq);
}
}
if (lexseq_length(&seq) == 0) {
macparam_lookup(lctx, stru->acctbl, pname, &seq);
}
// Parenthesize the parameter value if it's non-null, because we're
// doing lexical substitution and this could be used in an expression
// that is expecting it to be a single operand.
if (lexseq_length(&seq) > 0) {
lexseq_inshead(&seq, lexeme_create(lctx, LEXTYPE_DELIM_LPAR, &leftparen));
lexseq_instail(&seq, lexeme_create(lctx, LEXTYPE_DELIM_RPAR, &rightparen));
}
macparam_special(myscope, pname, &seq);
lexseq_free(lctx, &seq);
}
}
if (fldscope != 0) {
parser_scope_end(pctx);
}
// Allocation-actuals are only used in the general-reference case
if (symname == 0) {
for (ref = namereflist_head(&stru->alloformals); ref != 0;
ref = ref->tq_next) {
if (ref->np != 0) {
strdesc_t *pname = name_string(ref->np);
lexseq_init(&seq);
if (delim != LEXTYPE_DELIM_RBRACK) {
if (!parse_lexeme_seq(pctx, 0, QL_NORMAL, delims, 3,
&seq, &delim)) {
break;
}
}
if (lexseq_length(&seq) == 0) {
macparam_lookup(lctx, stru->allotbl, pname, &seq);
}
// Parenthesize the parameter value if it's non-null, because we're
// doing lexical substitution and this could be used in an expression
// that is expecting it to be a single operand.
if (lexseq_length(&seq) > 0) {
lexseq_inshead(&seq, lexeme_create(lctx, LEXTYPE_DELIM_LPAR, &leftparen));
lexseq_instail(&seq, lexeme_create(lctx, LEXTYPE_DELIM_RPAR, &rightparen));
}
macparam_special(myscope, pname, &seq);
}
}
}
if (delim != LEXTYPE_DELIM_RBRACK) {
expr_signal(ctx, STC__DELIMEXP, "]");
parser_skip_to_delim(pctx, LEXTYPE_DELIM_RBRACK);
}
// At this point, we have built the complete sequence
// of lexemes to convert into the structure reference
// expression.
lexseq_init(&seq);
lexseq_copy(lctx, &seq, &stru->accbody);
parser_scope_push(pctx, myscope);
if (!expr_parse_seq(ctx, &seq, &exp) || exp == 0) {
expr_signal(ctx, STC__SYNTAXERR);
lexseq_free(lctx, &seq);
parser_scope_end(pctx);
return 0;
}
parser_scope_end(pctx);
// Since STRUREF auto-parenthesizes the expression, we can
// simplify a resultant block expression if it only contains
// one expression and has no declarations, labels, or codecomments.
exp = expr_block_simplify(ctx, exp);
if (exp == 0) {
expr_signal(ctx, STC__INTCMPERR, "structure_reference[2]");
return 0;
}
resexp = expr_node_alloc(ctx, EXPTYPE_PRIM_STRUREF, pos);
expr_struref_accexpr_set(resexp, exp);
expr_struref_referer_set(resexp, symname);
expr_is_ctce_set(resexp, expr_is_ctce(exp));
expr_is_ltce_set(resexp, expr_is_ltce_only(exp));
expr_has_value_set(resexp, 1); // XXX *must* have value, right?
return resexp;
} /* structure_reference */
// --- parse :sym or (:sym, :lib) argument into address info ---
static native_sym_arg_t interpret_symbol_arg(jl_value_t *arg, jl_codectx_t *ctx, const char *fname)
{
jl_value_t *ptr = NULL;
Value *jl_ptr=NULL;
ptr = static_eval(arg, ctx, true);
if (ptr == NULL) {
jl_value_t *ptr_ty = expr_type(arg, ctx);
Value *arg1 = emit_unboxed(arg, ctx);
if (!jl_is_cpointer_type(ptr_ty)) {
emit_cpointercheck(arg1,
!strcmp(fname,"ccall") ?
"ccall: first argument not a pointer or valid constant expression" :
"cglobal: first argument not a pointer or valid constant expression",
ctx);
}
jl_ptr = emit_unbox(T_size, arg1, (jl_value_t*)jl_voidpointer_type);
}
void *fptr=NULL;
char *f_name=NULL, *f_lib=NULL;
if (ptr != NULL) {
if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
ptr = jl_tupleref(ptr,0);
}
if (jl_is_symbol(ptr))
f_name = ((jl_sym_t*)ptr)->name;
else if (jl_is_byte_string(ptr))
f_name = jl_string_data(ptr);
if (f_name != NULL) {
// just symbol, default to JuliaDLHandle
// will look in process symbol table
#ifdef _OS_WINDOWS_
f_lib = jl_dlfind_win32(f_name);
#endif
}
else if (jl_is_cpointer_type(jl_typeof(ptr))) {
fptr = *(void**)jl_data_ptr(ptr);
}
else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
jl_value_t *t0 = jl_tupleref(ptr,0);
jl_value_t *t1 = jl_tupleref(ptr,1);
if (jl_is_symbol(t0))
f_name = ((jl_sym_t*)t0)->name;
else if (jl_is_byte_string(t0))
f_name = jl_string_data(t0);
else
JL_TYPECHKS(fname, symbol, t0);
if (jl_is_symbol(t1))
f_lib = ((jl_sym_t*)t1)->name;
else if (jl_is_byte_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHKS(fname, symbol, t1);
}
else {
JL_TYPECHKS(fname, pointer, ptr);
}
}
native_sym_arg_t r;
r.jl_ptr = jl_ptr;
r.fptr = fptr;
r.f_name = f_name;
r.f_lib = f_lib;
return r;
}
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
JL_NARGSV(ccall, 3);
jl_value_t *rt=NULL, *at=NULL;
JL_GC_PUSH2(&rt, &at);
native_sym_arg_t symarg = interpret_symbol_arg(args[1], ctx, "ccall");
Value *jl_ptr=NULL;
void *fptr = NULL;
char *f_name = NULL, *f_lib = NULL;
jl_ptr = symarg.jl_ptr;
fptr = symarg.fptr;
f_name = symarg.f_name;
f_lib = symarg.f_lib;
if (f_name == NULL && fptr == NULL && jl_ptr == NULL) {
JL_GC_POP();
emit_error("ccall: null function pointer", ctx);
return literal_pointer_val(jl_nothing);
}
rt = jl_interpret_toplevel_expr_in(ctx->module, args[2],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
if (jl_is_tuple(rt)) {
std::string msg = "in " + ctx->funcName +
": ccall: missing return type";
jl_error(msg.c_str());
}
if (rt == (jl_value_t*)jl_pointer_type)
jl_error("ccall: return type Ptr should have an element type, Ptr{T}");
at = jl_interpret_toplevel_expr_in(ctx->module, args[3],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
JL_TYPECHK(ccall, type, rt);
JL_TYPECHK(ccall, tuple, at);
JL_TYPECHK(ccall, type, at);
jl_tuple_t *tt = (jl_tuple_t*)at;
std::vector<Type *> fargt(0);
std::vector<Type *> fargt_sig(0);
Type *lrt = julia_struct_to_llvm(rt);
if (lrt == NULL) {
JL_GC_POP();
emit_error("ccall: return type doesn't correspond to a C type", ctx);
return literal_pointer_val(jl_nothing);
}
size_t i;
bool isVa = false;
size_t nargt = jl_tuple_len(tt);
std::vector<AttributeWithIndex> attrs;
for(i=0; i < nargt; i++) {
jl_value_t *tti = jl_tupleref(tt,i);
if (tti == (jl_value_t*)jl_pointer_type)
jl_error("ccall: argument type Ptr should have an element type, Ptr{T}");
if (jl_is_vararg_type(tti)) {
isVa = true;
tti = jl_tparam0(tti);
}
if (jl_is_bitstype(tti)) {
// see pull req #978. need to annotate signext/zeroext for
// small integer arguments.
jl_datatype_t *bt = (jl_datatype_t*)tti;
if (bt->size < 4) {
if (jl_signed_type == NULL) {
jl_signed_type = jl_get_global(jl_core_module,jl_symbol("Signed"));
}
#ifdef LLVM32
Attributes::AttrVal av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attributes::SExt;
else
av = Attributes::ZExt;
attrs.push_back(AttributeWithIndex::get(getGlobalContext(), i+1,
ArrayRef<Attributes::AttrVal>(&av, 1)));
#else
Attribute::AttrConst av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attribute::SExt;
else
av = Attribute::ZExt;
attrs.push_back(AttributeWithIndex::get(i+1, av));
#endif
}
}
Type *t = julia_struct_to_llvm(tti);
if (t == NULL) {
JL_GC_POP();
std::stringstream msg;
msg << "ccall: the type of argument ";
msg << i+1;
msg << " doesn't correspond to a C type";
emit_error(msg.str(), ctx);
return literal_pointer_val(jl_nothing);
}
fargt.push_back(t);
if (!isVa)
fargt_sig.push_back(t);
}
// check for calling convention specifier
CallingConv::ID cc = CallingConv::C;
jl_value_t *last = args[nargs];
if (jl_is_expr(last)) {
jl_sym_t *lhd = ((jl_expr_t*)last)->head;
if (lhd == jl_symbol("stdcall")) {
cc = CallingConv::X86_StdCall;
nargs--;
}
else if (lhd == jl_symbol("cdecl")) {
cc = CallingConv::C;
nargs--;
}
else if (lhd == jl_symbol("fastcall")) {
cc = CallingConv::X86_FastCall;
nargs--;
}
else if (lhd == jl_symbol("thiscall")) {
cc = CallingConv::X86_ThisCall;
nargs--;
}
}
if ((!isVa && jl_tuple_len(tt) != (nargs-2)/2) ||
( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
jl_error("ccall: wrong number of arguments to C function");
// some special functions
if (fptr == &jl_array_ptr) {
assert(lrt->isPointerTy());
Value *ary = emit_expr(args[4], ctx);
JL_GC_POP();
return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
rt);
}
if (fptr == &jl_value_ptr) {
assert(lrt->isPointerTy());
jl_value_t *argi = args[4];
bool addressOf = false;
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
addressOf = true;
argi = jl_exprarg(argi,0);
}
Value *ary = boxed(emit_expr(argi, ctx));
JL_GC_POP();
return mark_julia_type(
builder.CreateBitCast(emit_nthptr_addr(ary, addressOf?1:0),lrt),
rt);
}
// make LLVM function object for the target
Value *llvmf;
FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
if (jl_ptr != NULL) {
null_pointer_check(jl_ptr,ctx);
Type *funcptype = PointerType::get(functype,0);
llvmf = builder.CreateIntToPtr(jl_ptr, funcptype);
}
else if (fptr != NULL) {
Type *funcptype = PointerType::get(functype,0);
llvmf = literal_pointer_val(fptr, funcptype);
}
else {
void *symaddr;
if (f_lib != NULL)
symaddr = add_library_sym(f_name, f_lib);
else
symaddr = sys::DynamicLibrary::SearchForAddressOfSymbol(f_name);
if (symaddr == NULL) {
JL_GC_POP();
std::stringstream msg;
msg << "ccall: could not find function ";
msg << f_name;
if (f_lib != NULL) {
msg << " in library ";
msg << f_lib;
}
emit_error(msg.str(), ctx);
return literal_pointer_val(jl_nothing);
}
llvmf = jl_Module->getOrInsertFunction(f_name, functype);
}
// save place before arguments, for possible insertion of temp arg
// area saving code.
Value *saveloc=NULL;
Value *stacksave=NULL;
BasicBlock::InstListType &instList = builder.GetInsertBlock()->getInstList();
Instruction *savespot;
if (instList.empty()) {
savespot = NULL;
}
else {
// hey C++, there's this thing called pointers...
Instruction &_savespot = builder.GetInsertBlock()->back();
savespot = &_savespot;
}
// emit arguments
Value *argvals[(nargs-3)/2];
int last_depth = ctx->argDepth;
int nargty = jl_tuple_len(tt);
bool needTempSpace = false;
for(i=4; i < nargs+1; i+=2) {
int ai = (i-4)/2;
jl_value_t *argi = args[i];
bool addressOf = false;
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
addressOf = true;
argi = jl_exprarg(argi,0);
}
Type *largty;
jl_value_t *jargty;
if (isVa && ai >= nargty-1) {
largty = fargt[nargty-1];
jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
}
else {
largty = fargt[ai];
jargty = jl_tupleref(tt,ai);
}
Value *arg;
if (largty == jl_pvalue_llvmt ||
largty->isStructTy()) {
arg = emit_expr(argi, ctx, true);
}
else {
arg = emit_unboxed(argi, ctx);
if (jl_is_bitstype(expr_type(argi, ctx))) {
if (addressOf)
arg = emit_unbox(largty->getContainedType(0), largty, arg);
else
arg = emit_unbox(largty, PointerType::get(largty,0), arg);
}
}
/*
#ifdef JL_GC_MARKSWEEP
// make sure args are rooted
if (largty->isPointerTy() &&
(largty == jl_pvalue_llvmt ||
!jl_is_bits_type(expr_type(args[i], ctx)))) {
make_gcroot(boxed(arg), ctx);
}
#endif
*/
bool mightNeed=false;
argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
ai+1, ctx, &mightNeed);
needTempSpace |= mightNeed;
}
if (needTempSpace) {
// save temp argument area stack pointer
// TODO: inline this
saveloc = CallInst::Create(save_arg_area_loc_func);
stacksave = CallInst::Create(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stacksave));
if (savespot)
instList.insertAfter(savespot, (Instruction*)saveloc);
else
instList.push_front((Instruction*)saveloc);
instList.insertAfter((Instruction*)saveloc, (Instruction*)stacksave);
}
// the actual call
Value *result = builder.CreateCall(llvmf,
ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
if (cc != CallingConv::C)
((CallInst*)result)->setCallingConv(cc);
#ifdef LLVM32
((CallInst*)result)->setAttributes(AttrListPtr::get(getGlobalContext(), ArrayRef<AttributeWithIndex>(attrs)));
#else
((CallInst*)result)->setAttributes(AttrListPtr::get(attrs.data(),attrs.size()));
#endif
if (needTempSpace) {
// restore temp argument area stack pointer
assert(saveloc != NULL);
builder.CreateCall(restore_arg_area_loc_func, saveloc);
assert(stacksave != NULL);
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stackrestore),
stacksave);
}
ctx->argDepth = last_depth;
if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
#ifdef LLVM32
ctx->f->addFnAttr(Attributes::StackProtectReq);
#else
ctx->f->addFnAttr(Attribute::StackProtectReq);
#endif
}
JL_GC_POP();
if (lrt == T_void)
return literal_pointer_val((jl_value_t*)jl_nothing);
if (lrt->isStructTy()) {
//fprintf(stderr, "ccall rt: %s -> %s\n", f_name, ((jl_tag_type_t*)rt)->name->name->name);
assert(jl_is_structtype(rt));
Value *strct =
builder.CreateCall(jlallocobj_func,
ConstantInt::get(T_size,
sizeof(void*)+((jl_datatype_t*)rt)->size));
builder.CreateStore(literal_pointer_val((jl_value_t*)rt),
emit_nthptr_addr(strct, (size_t)0));
builder.CreateStore(result,
builder.CreateBitCast(
emit_nthptr_addr(strct, (size_t)1),
PointerType::get(lrt,0)));
return mark_julia_type(strct, rt);
}
return mark_julia_type(result, rt);
}
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
JL_NARGSV(ccall, 3);
jl_value_t *ptr=NULL, *rt=NULL, *at=NULL;
JL_GC_PUSH(&ptr, &rt, &at);
ptr = jl_interpret_toplevel_expr_in(ctx->module, args[1],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
rt = jl_interpret_toplevel_expr_in(ctx->module, args[2],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
if (jl_is_tuple(rt)) {
std::string msg = "in " + ctx->funcName +
": ccall: missing return type";
jl_error(msg.c_str());
}
at = jl_interpret_toplevel_expr_in(ctx->module, args[3],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
void *fptr=NULL;
char *f_name=NULL, *f_lib=NULL;
if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
ptr = jl_tupleref(ptr,0);
}
if (jl_is_symbol(ptr))
f_name = ((jl_sym_t*)ptr)->name;
else if (jl_is_byte_string(ptr))
f_name = jl_string_data(ptr);
if (f_name != NULL) {
// just symbol, default to JuliaDLHandle
#ifdef __WIN32__
fptr = jl_dlsym_e(jl_dl_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_kernel32_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_ntdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_crtdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym(jl_winsock_handle, f_name);
}
}
}
}
else {
// available in process symbol table
fptr = NULL;
}
#else
// will look in process symbol table
#endif
}
else if (jl_is_cpointer_type(jl_typeof(ptr))) {
fptr = *(void**)jl_bits_data(ptr);
}
else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
jl_value_t *t0 = jl_tupleref(ptr,0);
jl_value_t *t1 = jl_tupleref(ptr,1);
if (jl_is_symbol(t0))
f_name = ((jl_sym_t*)t0)->name;
else if (jl_is_byte_string(t0))
f_name = jl_string_data(t0);
else
JL_TYPECHK(ccall, symbol, t0);
if (jl_is_symbol(t1))
f_lib = ((jl_sym_t*)t1)->name;
else if (jl_is_byte_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(ccall, symbol, t1);
}
else {
JL_TYPECHK(ccall, pointer, ptr);
}
if (f_name == NULL && fptr == NULL) {
JL_GC_POP();
emit_error("ccall: null function pointer", ctx);
return literal_pointer_val(jl_nothing);
}
JL_TYPECHK(ccall, type, rt);
JL_TYPECHK(ccall, tuple, at);
JL_TYPECHK(ccall, type, at);
jl_tuple_t *tt = (jl_tuple_t*)at;
std::vector<Type *> fargt(0);
std::vector<Type *> fargt_sig(0);
Type *lrt = julia_type_to_llvm(rt);
if (lrt == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
size_t i;
bool haspointers = false;
bool isVa = false;
for(i=0; i < jl_tuple_len(tt); i++) {
jl_value_t *tti = jl_tupleref(tt,i);
if (jl_is_seq_type(tti)) {
isVa = true;
tti = jl_tparam0(tti);
}
Type *t = julia_type_to_llvm(tti);
if (t == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
fargt.push_back(t);
if (!isVa)
fargt_sig.push_back(t);
}
// check for calling convention specifier
CallingConv::ID cc = CallingConv::C;
jl_value_t *last = args[nargs];
if (jl_is_expr(last)) {
jl_sym_t *lhd = ((jl_expr_t*)last)->head;
if (lhd == jl_symbol("stdcall")) {
cc = CallingConv::X86_StdCall;
nargs--;
}
else if (lhd == jl_symbol("cdecl")) {
cc = CallingConv::C;
nargs--;
}
else if (lhd == jl_symbol("fastcall")) {
cc = CallingConv::X86_FastCall;
nargs--;
}
}
if ((!isVa && jl_tuple_len(tt) != (nargs-2)/2) ||
( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
jl_error("ccall: wrong number of arguments to C function");
// some special functions
if (fptr == &jl_array_ptr) {
Value *ary = emit_expr(args[4], ctx);
JL_GC_POP();
return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
rt);
}
// see if there are & arguments
for(i=4; i < nargs+1; i+=2) {
jl_value_t *argi = args[i];
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
haspointers = true;
break;
}
}
// make LLVM function object for the target
Constant *llvmf;
FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
if (fptr != NULL) {
Type *funcptype = PointerType::get(functype,0);
llvmf = ConstantExpr::getIntToPtr(
ConstantInt::get(funcptype, (uint64_t)fptr),
funcptype);
}
else {
if (f_lib != NULL)
add_library_sym(f_name, f_lib);
llvmf = jl_Module->getOrInsertFunction(f_name, functype);
}
// save temp argument area stack pointer
Value *saveloc=NULL;
Value *stacksave=NULL;
if (haspointers) {
// TODO: inline this
saveloc = builder.CreateCall(save_arg_area_loc_func);
stacksave =
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stacksave));
}
// emit arguments
Value *argvals[(nargs-3)/2];
int last_depth = ctx->argDepth;
int nargty = jl_tuple_len(tt);
for(i=4; i < nargs+1; i+=2) {
int ai = (i-4)/2;
jl_value_t *argi = args[i];
bool addressOf = false;
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
addressOf = true;
argi = jl_exprarg(argi,0);
}
Type *largty;
jl_value_t *jargty;
if (isVa && ai >= nargty-1) {
largty = fargt[nargty-1];
jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
}
else {
largty = fargt[ai];
jargty = jl_tupleref(tt,ai);
}
Value *arg;
if (largty == jl_pvalue_llvmt) {
arg = emit_expr(argi, ctx, true);
}
else {
arg = emit_unboxed(argi, ctx);
if (jl_is_bits_type(expr_type(argi, ctx))) {
if (addressOf)
arg = emit_unbox(largty->getContainedType(0), largty, arg);
else
arg = emit_unbox(largty, PointerType::get(largty,0), arg);
}
}
/*
#ifdef JL_GC_MARKSWEEP
// make sure args are rooted
if (largty->isPointerTy() &&
(largty == jl_pvalue_llvmt ||
!jl_is_bits_type(expr_type(args[i], ctx)))) {
make_gcroot(boxed(arg), ctx);
}
#endif
*/
argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
ai+1, ctx);
}
// the actual call
Value *result = builder.CreateCall(llvmf,
ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
if (cc != CallingConv::C)
((CallInst*)result)->setCallingConv(cc);
// restore temp argument area stack pointer
if (haspointers) {
assert(saveloc != NULL);
builder.CreateCall(restore_arg_area_loc_func, saveloc);
assert(stacksave != NULL);
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stackrestore),
stacksave);
}
ctx->argDepth = last_depth;
if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
ctx->f->addFnAttr(Attribute::StackProtectReq);
}
JL_GC_POP();
if (lrt == T_void)
return literal_pointer_val((jl_value_t*)jl_nothing);
return mark_julia_type(result, rt);
}
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
JL_NARGSV(ccall, 3);
jl_value_t *ptr=NULL, *rt=NULL, *at=NULL;
Value *jl_ptr=NULL;
JL_GC_PUSH(&ptr, &rt, &at);
ptr = static_eval(args[1], ctx, true);
if (ptr == NULL) {
jl_value_t *ptr_ty = expr_type(args[1], ctx);
Value *arg1 = emit_unboxed(args[1], ctx);
if (!jl_is_cpointer_type(ptr_ty)) {
emit_typecheck(arg1, (jl_value_t*)jl_voidpointer_type,
"ccall: function argument not a pointer or valid constant", ctx);
}
jl_ptr = emit_unbox(T_size, T_psize, arg1);
}
rt = jl_interpret_toplevel_expr_in(ctx->module, args[2],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
if (jl_is_tuple(rt)) {
std::string msg = "in " + ctx->funcName +
": ccall: missing return type";
jl_error(msg.c_str());
}
at = jl_interpret_toplevel_expr_in(ctx->module, args[3],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
void *fptr=NULL;
char *f_name=NULL, *f_lib=NULL;
if (ptr != NULL) {
if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
ptr = jl_tupleref(ptr,0);
}
if (jl_is_symbol(ptr))
f_name = ((jl_sym_t*)ptr)->name;
else if (jl_is_byte_string(ptr))
f_name = jl_string_data(ptr);
if (f_name != NULL) {
// just symbol, default to JuliaDLHandle
#ifdef __WIN32__
fptr = jl_dlsym_e(jl_dl_handle, f_name);
if (!fptr) {
//TODO: when one of these succeeds, store the f_lib name (and clear fptr)
fptr = jl_dlsym_e(jl_kernel32_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_ntdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_crtdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym(jl_winsock_handle, f_name);
}
}
}
}
else {
// available in process symbol table
fptr = NULL;
}
#else
// will look in process symbol table
#endif
}
else if (jl_is_cpointer_type(jl_typeof(ptr))) {
fptr = *(void**)jl_bits_data(ptr);
}
else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
jl_value_t *t0 = jl_tupleref(ptr,0);
jl_value_t *t1 = jl_tupleref(ptr,1);
if (jl_is_symbol(t0))
f_name = ((jl_sym_t*)t0)->name;
else if (jl_is_byte_string(t0))
f_name = jl_string_data(t0);
else
JL_TYPECHK(ccall, symbol, t0);
if (jl_is_symbol(t1))
f_lib = ((jl_sym_t*)t1)->name;
else if (jl_is_byte_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(ccall, symbol, t1);
}
else {
JL_TYPECHK(ccall, pointer, ptr);
}
}
if (f_name == NULL && fptr == NULL && jl_ptr == NULL) {
JL_GC_POP();
emit_error("ccall: null function pointer", ctx);
return literal_pointer_val(jl_nothing);
}
JL_TYPECHK(ccall, type, rt);
JL_TYPECHK(ccall, tuple, at);
JL_TYPECHK(ccall, type, at);
jl_tuple_t *tt = (jl_tuple_t*)at;
std::vector<Type *> fargt(0);
std::vector<Type *> fargt_sig(0);
Type *lrt = julia_type_to_llvm(rt);
if (lrt == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
size_t i;
bool haspointers = false;
bool isVa = false;
size_t nargt = jl_tuple_len(tt);
std::vector<AttributeWithIndex> attrs;
for(i=0; i < nargt; i++) {
jl_value_t *tti = jl_tupleref(tt,i);
if (jl_is_seq_type(tti)) {
isVa = true;
tti = jl_tparam0(tti);
}
if (jl_is_bits_type(tti)) {
// see pull req #978. need to annotate signext/zeroext for
// small integer arguments.
jl_bits_type_t *bt = (jl_bits_type_t*)tti;
if (bt->nbits < 32) {
if (jl_signed_type == NULL) {
jl_signed_type = jl_get_global(jl_core_module,jl_symbol("Signed"));
}
#ifdef LLVM32
Attributes::AttrVal av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attributes::SExt;
else
av = Attributes::ZExt;
attrs.push_back(AttributeWithIndex::get(getGlobalContext(), i+1,
ArrayRef<Attributes::AttrVal>(&av, 1)));
#else
Attribute::AttrConst av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attribute::SExt;
else
av = Attribute::ZExt;
attrs.push_back(AttributeWithIndex::get(i+1, av));
#endif
}
}
Type *t = julia_type_to_llvm(tti);
if (t == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
fargt.push_back(t);
if (!isVa)
fargt_sig.push_back(t);
}
// check for calling convention specifier
CallingConv::ID cc = CallingConv::C;
jl_value_t *last = args[nargs];
if (jl_is_expr(last)) {
jl_sym_t *lhd = ((jl_expr_t*)last)->head;
if (lhd == jl_symbol("stdcall")) {
cc = CallingConv::X86_StdCall;
nargs--;
}
else if (lhd == jl_symbol("cdecl")) {
cc = CallingConv::C;
nargs--;
}
else if (lhd == jl_symbol("fastcall")) {
cc = CallingConv::X86_FastCall;
nargs--;
}
else if (lhd == jl_symbol("thiscall")) {
cc = CallingConv::X86_ThisCall;
nargs--;
}
}
if ((!isVa && jl_tuple_len(tt) != (nargs-2)/2) ||
( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
jl_error("ccall: wrong number of arguments to C function");
// some special functions
if (fptr == &jl_array_ptr) {
Value *ary = emit_expr(args[4], ctx);
JL_GC_POP();
return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
rt);
}
// see if there are & arguments
for(i=4; i < nargs+1; i+=2) {
jl_value_t *argi = args[i];
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
haspointers = true;
break;
}
}
// make LLVM function object for the target
Value *llvmf;
FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
if (jl_ptr != NULL) {
null_pointer_check(jl_ptr,ctx);
Type *funcptype = PointerType::get(functype,0);
llvmf = builder.CreateIntToPtr(jl_ptr, funcptype);
} else if (fptr != NULL) {
Type *funcptype = PointerType::get(functype,0);
llvmf = literal_pointer_val(fptr, funcptype);
}
else {
void *symaddr;
if (f_lib != NULL)
symaddr = add_library_sym(f_name, f_lib);
else
symaddr = sys::DynamicLibrary::SearchForAddressOfSymbol(f_name);
if (symaddr == NULL) {
JL_GC_POP();
std::stringstream msg;
msg << "ccall: could not find function ";
msg << f_name;
if (f_lib != NULL) {
msg << " in library ";
msg << f_lib;
}
emit_error(msg.str(), ctx);
return literal_pointer_val(jl_nothing);
}
llvmf = jl_Module->getOrInsertFunction(f_name, functype);
}
// save temp argument area stack pointer
Value *saveloc=NULL;
Value *stacksave=NULL;
if (haspointers) {
// TODO: inline this
saveloc = builder.CreateCall(save_arg_area_loc_func);
stacksave =
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stacksave));
}
// emit arguments
Value *argvals[(nargs-3)/2];
int last_depth = ctx->argDepth;
int nargty = jl_tuple_len(tt);
for(i=4; i < nargs+1; i+=2) {
int ai = (i-4)/2;
jl_value_t *argi = args[i];
bool addressOf = false;
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
addressOf = true;
argi = jl_exprarg(argi,0);
}
Type *largty;
jl_value_t *jargty;
if (isVa && ai >= nargty-1) {
largty = fargt[nargty-1];
jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
}
else {
largty = fargt[ai];
jargty = jl_tupleref(tt,ai);
}
Value *arg;
if (largty == jl_pvalue_llvmt) {
arg = emit_expr(argi, ctx, true);
}
else {
arg = emit_unboxed(argi, ctx);
if (jl_is_bits_type(expr_type(argi, ctx))) {
if (addressOf)
arg = emit_unbox(largty->getContainedType(0), largty, arg);
else
arg = emit_unbox(largty, PointerType::get(largty,0), arg);
}
}
/*
#ifdef JL_GC_MARKSWEEP
// make sure args are rooted
if (largty->isPointerTy() &&
(largty == jl_pvalue_llvmt ||
!jl_is_bits_type(expr_type(args[i], ctx)))) {
make_gcroot(boxed(arg), ctx);
}
#endif
*/
argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
ai+1, ctx);
}
// the actual call
Value *result = builder.CreateCall(llvmf,
ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
if (cc != CallingConv::C)
((CallInst*)result)->setCallingConv(cc);
#ifdef LLVM32
((CallInst*)result)->setAttributes(AttrListPtr::get(getGlobalContext(), ArrayRef<AttributeWithIndex>(attrs)));
#else
((CallInst*)result)->setAttributes(AttrListPtr::get(attrs.data(),attrs.size()));
#endif
// restore temp argument area stack pointer
if (haspointers) {
assert(saveloc != NULL);
builder.CreateCall(restore_arg_area_loc_func, saveloc);
assert(stacksave != NULL);
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stackrestore),
stacksave);
}
ctx->argDepth = last_depth;
if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
#ifdef LLVM32
ctx->f->addFnAttr(Attributes::StackProtectReq);
#else
ctx->f->addFnAttr(Attribute::StackProtectReq);
#endif
}
JL_GC_POP();
if (lrt == T_void)
return literal_pointer_val((jl_value_t*)jl_nothing);
return mark_julia_type(result, rt);
}
/**
* Returns true if given expression does not have any potential side
* effects and hence one instance of this expression can be safely
* connected to many nodes in the tree.
*/
int expr_is_pure(struct expression *expr)
{
int i;
switch (expr_type(expr)) {
/*
* These expressions may or may not have side effects
* depending on their actual children expressions. In
* general these expressions should not be connected
* to more than one node.
*/
case EXPR_ARGS_LIST:
case EXPR_UNARY_OP:
case EXPR_CONVERSION:
case EXPR_CONVERSION_TO_FLOAT:
case EXPR_CONVERSION_FROM_FLOAT:
case EXPR_ARG:
case EXPR_ARRAYLENGTH:
case EXPR_INSTANCEOF:
case EXPR_ARRAY_SIZE_CHECK:
case EXPR_MULTIARRAY_SIZE_CHECK:
case EXPR_NULL_CHECK:
/* These expression types should be always assumed to
have side-effects. */
case EXPR_INVOKE:
case EXPR_INVOKEVIRTUAL:
case EXPR_FINVOKE:
case EXPR_FINVOKEVIRTUAL:
case EXPR_NEWARRAY:
case EXPR_ANEWARRAY:
case EXPR_MULTIANEWARRAY:
case EXPR_NEW:
case EXPR_BINOP:
return false;
/* These expression types do not have any side-effects */
case EXPR_VALUE:
case EXPR_FVALUE:
case EXPR_LOCAL:
case EXPR_TEMPORARY:
case EXPR_CLASS_FIELD:
case EXPR_NO_ARGS:
case EXPR_EXCEPTION_REF:
case EXPR_INSTANCE_FIELD:
case EXPR_MIMIC_STACK_SLOT:
return true;
/* EXPR_ARRAY_DEREF can have side effects in general
but it can not be copied so it's considered pure
when all it's children are pure. */
case EXPR_ARRAY_DEREF:
for (i = 0; i < expr_nr_kids(expr); i++)
if (!expr_is_pure(to_expr(expr->node.kids[i])))
return false;
return true;
default:
assert(!"Invalid expression type");
}
}