Exemple #1
0
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++;
	}
Exemple #2
0
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));
}
Exemple #3
0
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);
}
Exemple #4
0
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);
}
Exemple #5
0
	/*
	 * 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);
	}
Exemple #6
0
/*
 * 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 */
Exemple #7
0
/* 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");
	}
}
Exemple #8
0
/*
 * 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;
}
Exemple #9
0
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);
Exemple #11
0
/*
 * 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;
}
Exemple #12
0
/* ----------------------------------------------------------------
 *		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);
			}
		}
Exemple #13
0
/*
 *	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)
Exemple #14
0
/*
 * 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 */
Exemple #15
0
/*
 * 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 */
Exemple #16
0
// --- 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;
}
Exemple #17
0
// 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);
}
Exemple #18
0
// 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);
}
Exemple #19
0
// 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);
}
Exemple #20
0
/**
 * 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");
	}
}