projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Improve runghc's argument handling
[ghc-hetmet.git]
/
rts
/
PrimOps.cmm
diff --git
a/rts/PrimOps.cmm
b/rts/PrimOps.cmm
index
ad761ab
..
4cce586
100644
(file)
--- a/
rts/PrimOps.cmm
+++ b/
rts/PrimOps.cmm
@@
-27,6
+27,28
@@
#include "Cmm.h"
#include "Cmm.h"
+#ifdef __PIC__
+import __gmpz_init;
+import __gmpz_add;
+import __gmpz_sub;
+import __gmpz_mul;
+import __gmpz_gcd;
+import __gmpn_gcd_1;
+import __gmpn_cmp;
+import __gmpz_tdiv_q;
+import __gmpz_tdiv_r;
+import __gmpz_tdiv_qr;
+import __gmpz_fdiv_qr;
+import __gmpz_divexact;
+import __gmpz_and;
+import __gmpz_xor;
+import __gmpz_ior;
+import __gmpz_com;
+import base_GHCziIOBase_NestedAtomically_closure;
+import pthread_mutex_lock;
+import pthread_mutex_unlock;
+#endif
+
/*-----------------------------------------------------------------------------
Array Primitives
/*-----------------------------------------------------------------------------
Array Primitives
@@
-1869,7
+1891,7
@@
unpackClosurezh_fast
// TODO: Consider the absence of ptrs or nonptrs as a special case ?
W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
// TODO: Consider the absence of ptrs or nonptrs as a special case ?
W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
- info = %GET_STD_INFO(R1);
+ info = %GET_STD_INFO(UNTAG(R1));
// Some closures have non-standard layout, so we omit those here.
W_ type;
// Some closures have non-standard layout, so we omit those here.
W_ type;
@@
-1899,6
+1921,9
@@
out:
ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, unpackClosurezh_fast);
ALLOC_PRIM (ptrs_arr_sz + nptrs_arr_sz, R1_PTR, unpackClosurezh_fast);
+ W_ clos;
+ clos = UNTAG(R1);
+
ptrs_arr = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1);
nptrs_arr = Hp - nptrs_arr_sz + WDS(1);
ptrs_arr = Hp - nptrs_arr_sz - ptrs_arr_sz + WDS(1);
nptrs_arr = Hp - nptrs_arr_sz + WDS(1);
@@
-1907,7
+1932,7
@@
out:
p = 0;
for:
if(p < ptrs) {
p = 0;
for:
if(p < ptrs) {
- W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
+ W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(clos,p);
p = p + 1;
goto for;
}
p = p + 1;
goto for;
}
@@
-1917,7
+1942,7
@@
for:
p = 0;
for2:
if(p < nptrs) {
p = 0;
for2:
if(p < nptrs) {
- W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(R1, p+ptrs);
+ W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(clos, p+ptrs);
p = p + 1;
goto for2;
}
p = p + 1;
goto for2;
}
@@
-1998,7
+2023,7
@@
delayzh_fast
/* could probably allocate this on the heap instead */
("ptr" ares) = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
stg_delayzh_malloc_str);
/* could probably allocate this on the heap instead */
("ptr" ares) = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
stg_delayzh_malloc_str);
- reqID = foreign "C" addDelayRequest(R1);
+ (reqID) = foreign "C" addDelayRequest(R1);
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;
@@
-2060,10
+2085,10
@@
asyncReadzh_fast
StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
/* could probably allocate this on the heap instead */
StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
/* could probably allocate this on the heap instead */
- "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
+ ("ptr" ares) = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
stg_asyncReadzh_malloc_str)
[R1,R2,R3,R4];
stg_asyncReadzh_malloc_str)
[R1,R2,R3,R4];
- reqID = foreign "C" addIORequest(R1, 0/*FALSE*/,R2,R3,R4 "ptr") [];
+ (reqID) = foreign "C" addIORequest(R1, 0/*FALSE*/,R2,R3,R4 "ptr") [];
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;
@@
-2087,10
+2112,10
@@
asyncWritezh_fast
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
- "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
+ ("ptr" ares) = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
stg_asyncWritezh_malloc_str)
[R1,R2,R3,R4];
stg_asyncWritezh_malloc_str)
[R1,R2,R3,R4];
- reqID = foreign "C" addIORequest(R1, 1/*TRUE*/,R2,R3,R4 "ptr") [];
+ (reqID) = foreign "C" addIORequest(R1, 1/*TRUE*/,R2,R3,R4 "ptr") [];
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
@@
-2116,10
+2141,10
@@
asyncDoProczh_fast
StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
/* could probably allocate this on the heap instead */
StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
/* could probably allocate this on the heap instead */
- "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
+ ("ptr" ares) = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
stg_asyncDoProczh_malloc_str)
[R1,R2];
stg_asyncDoProczh_malloc_str)
[R1,R2];
- reqID = foreign "C" addDoProcRequest(R1 "ptr",R2 "ptr") [];
+ (reqID) = foreign "C" addDoProcRequest(R1 "ptr",R2 "ptr") [];
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;
StgAsyncIOResult_reqID(ares) = reqID;
StgAsyncIOResult_len(ares) = 0;
StgAsyncIOResult_errCode(ares) = 0;