static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
CAMLlocal1(CamlMessage);
-
+
CamlMessage = copy_string(Message);
LLVMDisposeMessage(Message);
-
+
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
return LLVMGetOperand(V, Int_val(I));
}
+/* llvalue -> int -> lluse */
+CAMLprim LLVMUseRef llvm_operand_use(LLVMValueRef V, value I) {
+ return LLVMGetOperandUse(V, Int_val(I));
+}
+
/* llvalue -> int -> llvalue -> unit */
CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
LLVMSetOperand(U, Int_val(I), V);
return LLVMConstReal(RealTy, Double_val(N));
}
+
+/* llvalue -> float */
+CAMLprim value llvm_float_of_const(LLVMValueRef Const)
+{
+ if (LLVMIsAConstantFP(Const)) {
+ LLVMBool LosesInfo;
+ double res = LLVMConstRealGetDouble(Const, &LosesInfo);
+ if (LosesInfo)
+ return Val_int(0);
+ value Option = alloc(1, 0);
+ Field(Option, 0) = caml_copy_double(res);
+ return Option;
+ }
+ return Val_int(0);
+}
+
/* lltype -> string -> llvalue */
CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
Wosize_val(ElementVals));
}
+/* llvalue -> string option */
+CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
+ const char *S;
+ size_t Len;
+ CAMLparam0();
+ CAMLlocal2(Option, Str);
+
+ if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) {
+ S = LLVMGetAsString(Const, &Len);
+ Str = caml_alloc_string(Len);
+ memcpy(String_val(Str), S, Len);
+
+ Option = alloc(1, 0);
+ Field(Option, 0) = Str;
+ CAMLreturn(Option);
+ } else {
+ CAMLreturn(Val_int(0));
+ }
+}
+
+/* llvalue -> int -> llvalue */
+CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) {
+ return LLVMGetElementAsConstant(Const, Int_val(N));
+}
+
/*--... Constant expressions ...............................................--*/
/* Icmp.t -> llvalue -> llvalue -> llvalue */
const char *GC;
CAMLparam0();
CAMLlocal2(Name, Option);
-
+
if ((GC = LLVMGetGC(Fn))) {
Name = copy_string(GC);
-
+
Option = alloc(1, 0);
Field(Option, 0) = Name;
CAMLreturn(Option);
CAMLreturn(Val_int(0));
}
+/* llvalue -> FCmp.t option */
+CAMLprim value llvm_instr_fcmp_predicate(LLVMValueRef Val) {
+ CAMLparam0();
+ int x = LLVMGetFCmpPredicate(Val);
+ if (x) {
+ value Option = alloc(1, 0);
+ Field(Option, 0) = Val_int(x - LLVMRealPredicateFalse);
+ CAMLreturn(Option);
+ }
+ CAMLreturn(Val_int(0));
+}
+
+/* llvalue -> llvalue */
+CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) {
+ if (!LLVMIsAInstruction(Inst))
+ failwith("Not an instruction");
+ return LLVMInstructionClone(Inst);
+}
+
/*--... Operations on call sites ...........................................--*/
unsigned I;
CAMLparam0();
CAMLlocal3(Hd, Tl, Tmp);
-
+
/* Build a tuple list of them. */
Tl = Val_int(0);
for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
Hd = alloc(2, 0);
Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
-
+
Tmp = alloc(2, 0);
Store_field(Tmp, 0, Hd);
Store_field(Tmp, 1, Tl);
Tl = Tmp;
}
-
+
CAMLreturn(Tl);
}
CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
value Hd, Tl;
LLVMValueRef FirstValue, PhiNode;
-
+
assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
-
+
Hd = Field(Incoming, 0);
FirstValue = (LLVMValueRef) Field(Hd, 0);
PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
(LLVMBasicBlockRef*) &Field(Hd, 1), 1);
}
-
+
return PhiNode;
}
LLVMValueRef Element,
LLVMValueRef Idx,
value Name, value B) {
- return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
+ return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx,
String_val(Name));
}
CAMLparam1(Path);
char *Message;
LLVMMemoryBufferRef MemBuf;
-
+
if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
&MemBuf, &Message))
llvm_raise(llvm_ioerror_exn, Message);
-
+
CAMLreturn((value) MemBuf);
}
CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
char *Message;
LLVMMemoryBufferRef MemBuf;
-
+
if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
llvm_raise(llvm_ioerror_exn, Message);
-
+
return MemBuf;
}