[pure-lang-svn] SF.net SVN: pure-lang: [134] pure/trunk
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
[pure-lang-svn] SF.net SVN: pure-lang: [134] pure/trunk
|
From: <ag...@us...> - 2008-05-25 15:56:18
|
Revision: 134
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=134&view=rev
Author: agraef
Date: 2008-05-25 08:56:23 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Add marshalling between 64 bit ints and Pure bigints to the C interface.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/ChangeLog 2008-05-25 15:56:23 UTC (rev 134)
@@ -1,5 +1,14 @@
2008-05-25 Albert Graef <Dr....@t-...>
+ * interpreter.cc, runtime.cc: Add marshalling between long (64
+ bit) ints and Pure bigints in the C interface. This means that
+ both Pure ints and bigints can now be passed for 'long' arguments
+ of externals (with sign extension/truncation as necessary), and
+ 'long' values are promoted to Pure bigints on return. Hence C
+ functions taking 64 bit integers as arguments and returning them
+ as results can now be called from Pure without loosing bits due to
+ truncation.
+
* lib/prelude.pure: Make 'all' and 'any' tail-recursive.
* interpreter.cc: Make toplevel if-then-else properly
@@ -74,9 +83,7 @@
Please note that the typename 'long' *always* denotes signed 64
bit integers in Pure's extern declarations, even if the C 'long'
type is actually 32 bit (as it usually is even on most 64 bit
- systems). Also note that at present 'long' is still converted
- to/from Pure (32 bit) ints only, marshalling from/to Pure bigints
- is not supported yet.
+ systems).
2008-05-16 Albert Graef <Dr....@t-...>
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/interpreter.cc 2008-05-25 15:56:23 UTC (rev 134)
@@ -199,6 +199,8 @@
"pure_const", "expr*", 1, "int");
declare_extern((void*)pure_int,
"pure_int", "expr*", 1, "int");
+ declare_extern((void*)pure_long,
+ "pure_long", "expr*", 1, "long");
declare_extern((void*)pure_bigint,
"pure_bigint", "expr*", 2, "int",
sizeof(mp_limb_t)==8?"long*":"int*");
@@ -224,6 +226,8 @@
"pure_free_cstrings", "void", 0);
declare_extern((void*)pure_get_bigint,
"pure_get_bigint", "void*", 1, "expr*");
+ declare_extern((void*)pure_get_long,
+ "pure_get_long", "long", 1, "expr*");
declare_extern((void*)pure_catch,
"pure_catch", "expr*", 2, "expr*", "expr*");
@@ -2224,8 +2228,8 @@
}
// External C function visible in the Pure program. No varargs are allowed
// here for now. Also, we have to translate some of the parameter types
- // (expr** becomes void*, int32_t gets promoted in64_t if the default int
- // type of the target platform has 64 bit).
+ // (expr** becomes void*, int32_t gets promoted to int64_t if the default
+ // int type of the target platform has 64 bit).
assert(!varargs);
if (type == ExprPtrPtrTy)
type = VoidPtrTy;
@@ -2388,17 +2392,33 @@
Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
unboxed[i] = iv;
} else if (argt[i] == Type::Int64Ty) {
+ BasicBlock *intbb = new BasicBlock("int");
+ BasicBlock *mpzbb = new BasicBlock("mpz");
BasicBlock *okbb = new BasicBlock("ok");
Value *idx[2] = { Zero, Zero };
Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
- b.CreateCondBr
- (b.CreateICmpEQ(tagv, SInt(EXPR::INT), "cmp"), okbb, failedbb);
- f->getBasicBlockList().push_back(okbb);
- b.SetInsertPoint(okbb);
+ SwitchInst *sw = b.CreateSwitch(tagv, failedbb, 2);
+ /* We allow either ints or bigints to be passed for a long value. */
+ sw->addCase(SInt(EXPR::INT), intbb);
+ sw->addCase(SInt(EXPR::BIGINT), mpzbb);
+ f->getBasicBlockList().push_back(intbb);
+ b.SetInsertPoint(intbb);
Value *pv = b.CreateBitCast(x, IntExprPtrTy, "intexpr");
idx[1] = ValFldIndex;
Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
- unboxed[i] = b.CreateSExt(iv, Type::Int64Ty);
+ Value *intv = b.CreateSExt(iv, Type::Int64Ty);
+ b.CreateBr(okbb);
+ f->getBasicBlockList().push_back(mpzbb);
+ b.SetInsertPoint(mpzbb);
+ // Handle the case of a bigint (mpz_t -> long).
+ Value *mpzv = b.CreateCall(module->getFunction("pure_get_long"), x);
+ b.CreateBr(okbb);
+ f->getBasicBlockList().push_back(okbb);
+ b.SetInsertPoint(okbb);
+ PHINode *phi = b.CreatePHI(Type::Int64Ty);
+ phi->addIncoming(intv, intbb);
+ phi->addIncoming(mpzv, mpzbb);
+ unboxed[i] = phi;
} else if (argt[i] == Type::DoubleTy) {
BasicBlock *okbb = new BasicBlock("ok");
Value *idx[2] = { Zero, Zero };
@@ -2478,8 +2498,7 @@
// An external builtin already has this parameter declared as char*.
// We allow void* to be passed anyway, so just cast it to char* to
// make the LLVM typechecker happy.
- unboxed[i] = b.CreateBitCast
- (unboxed[i], CharPtrTy);
+ unboxed[i] = b.CreateBitCast(unboxed[i], CharPtrTy);
} else
assert(0 && "invalid C type");
}
@@ -2504,8 +2523,7 @@
else if (type == Type::Int32Ty)
u = b.CreateCall(module->getFunction("pure_int"), u);
else if (type == Type::Int64Ty)
- u = b.CreateCall(module->getFunction("pure_int"),
- b.CreateTrunc(u, Type::Int32Ty));
+ u = b.CreateCall(module->getFunction("pure_long"), u);
else if (type == Type::DoubleTy)
u = b.CreateCall(module->getFunction("pure_double"), u);
else if (type == CharPtrTy)
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/runtime.cc 2008-05-25 15:56:23 UTC (rev 134)
@@ -340,6 +340,22 @@
return x;
}
+extern "C"
+pure_expr *pure_long(int64_t l)
+{
+ int sgn = (l>0)?1:(l<0)?-1:0;
+ uint64_t v = (uint64_t)(l>=0?l:-l);
+ if (sizeof(mp_limb_t) == 8) {
+ // 8 byte limbs, value fits in a single limb.
+ limb_t u[1] = { v };
+ return pure_bigint(sgn, u);
+ } else {
+ // 4 byte limbs, put least significant word in the first limb.
+ limb_t u[2] = { (uint32_t)v, (uint32_t)(v>>32) };
+ return pure_bigint(sgn+sgn, u);
+ }
+}
+
static void make_bigint(mpz_t z, int32_t size, limb_t *limbs)
{
// FIXME: For efficiency, we poke directly into the mpz struct here, this
@@ -466,6 +482,7 @@
return s;
}
+extern "C"
void pure_free_cstrings()
{
for (list<char*>::iterator t = temps.begin(); t != temps.end(); t++)
@@ -473,6 +490,18 @@
temps.clear();
}
+extern "C"
+int64_t pure_get_long(pure_expr *x)
+{
+ uint64_t v =
+ (sizeof(mp_limb_t) == 8) ? (uint64_t)mpz_getlimbn(x->data.z, 0) :
+ (mpz_getlimbn(x->data.z, 0) +
+ (((uint64_t)mpz_getlimbn(x->data.z, 1))<<32));
+ cerr << "v = " << v << endl;
+ return (mpz_sgn(x->data.z) < 0) ? -(int64_t)v : (int64_t)v;
+}
+
+extern "C"
void *pure_get_bigint(pure_expr *x)
{
assert(x && x->tag == EXPR::BIGINT);
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/runtime.h 2008-05-25 15:56:23 UTC (rev 134)
@@ -63,6 +63,7 @@
void *f, void *e, uint32_t m, /* m x pure_expr* */ ...);
pure_expr *pure_const(int32_t tag);
pure_expr *pure_int(int32_t i);
+pure_expr *pure_long(int64_t l);
pure_expr *pure_bigint(int32_t size, limb_t *limbs);
pure_expr *pure_mpz(mpz_t z);
pure_expr *pure_double(double d);
@@ -95,11 +96,11 @@
char *pure_get_cstring(pure_expr *x);
void pure_free_cstrings();
-/* Get a pointer to the mpz_t value of a bigint expression which can be passed
- to the GMP routines. This is used to unbox bigint arguments and map them to
- void* in the C interface. */
+/* Convert a bigint expression to a pointer (mpz_t) or a long (64 bit)
+ integer. This is used to marshall bigint arguments in the C interface. */
void *pure_get_bigint(pure_expr *x);
+int64_t pure_get_long(pure_expr *x);
/* Execute a closure. If the given expression x (or x y in the case of
pure_apply) is a parameterless closure (or a saturated application of a
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
