From: sewardj Date: Fri, 22 Oct 1999 09:59:34 +0000 (+0000) Subject: [project @ 1999-10-22 09:59:28 by sewardj] X-Git-Tag: Approximately_9120_patches~5674 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=81d1ac85f5aca11c7c7118dc48f58b7a0eed21a1;p=ghc-hetmet.git [project @ 1999-10-22 09:59:28 by sewardj] Cleanup of the foreign import code. Also allow StablePtrs to be passed back and forth. --- diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index b72ec98..dc5ecfd 100644 --- a/ghc/rts/Evaluator.c +++ b/ghc/rts/Evaluator.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-1998. * * $RCSfile: Evaluator.c,v $ - * $Revision: 1.19 $ - * $Date: 1999/10/19 11:01:26 $ + * $Revision: 1.20 $ + * $Date: 1999/10/22 09:59:28 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -1547,7 +1547,7 @@ static inline void PushTaggedRealWorld( void ) { PushTag(REALWORLD_TAG); } inline void PushTaggedInt ( StgInt x ) { Sp -= sizeofW(StgInt); *Sp = x; PushTag(INT_TAG); } -static inline void PushTaggedWord ( StgWord x ) + inline void PushTaggedWord ( StgWord x ) { Sp -= sizeofW(StgWord); *Sp = x; PushTag(WORD_TAG); } inline void PushTaggedAddr ( StgAddr x ) { Sp -= sizeofW(StgAddr); *Sp = (W_)x; PushTag(ADDR_TAG); } @@ -1557,7 +1557,7 @@ static inline void PushTaggedWord ( StgWord x ) { Sp -= sizeofW(StgFloat); ASSIGN_FLT(Sp,x); PushTag(FLOAT_TAG); } inline void PushTaggedDouble ( StgDouble x ) { Sp -= sizeofW(StgDouble); ASSIGN_DBL(Sp,x); PushTag(DOUBLE_TAG); } -static inline void PushTaggedStablePtr ( StgStablePtr x ) + inline void PushTaggedStablePtr ( StgStablePtr x ) { Sp -= sizeofW(StgStablePtr); *Sp = x; PushTag(STABLE_TAG); } static inline void PushTaggedBool ( int x ) { PushTaggedInt(x); } @@ -1569,7 +1569,7 @@ static inline void PopTaggedRealWorld ( void ) inline StgInt PopTaggedInt ( void ) { StgInt r; PopTag(INT_TAG); r = *stgCast(StgInt*, Sp); Sp += sizeofW(StgInt); return r;} -static inline StgWord PopTaggedWord ( void ) + inline StgWord PopTaggedWord ( void ) { StgWord r; PopTag(WORD_TAG); r = *stgCast(StgWord*, Sp); Sp += sizeofW(StgWord); return r;} inline StgAddr PopTaggedAddr ( void ) @@ -1584,7 +1584,7 @@ static inline StgWord PopTaggedWord ( void ) inline StgDouble PopTaggedDouble ( void ) { StgDouble r; PopTag(DOUBLE_TAG); r = PK_DBL(Sp); Sp += sizeofW(StgDouble); return r;} -static inline StgStablePtr PopTaggedStablePtr ( void ) + inline StgStablePtr PopTaggedStablePtr ( void ) { StgInt r; PopTag(STABLE_TAG); r = *stgCast(StgStablePtr*, Sp); Sp += sizeofW(StgStablePtr); return r;} diff --git a/ghc/rts/ForeignCall.c b/ghc/rts/ForeignCall.c index 4d881d9..637cd1b 100644 --- a/ghc/rts/ForeignCall.c +++ b/ghc/rts/ForeignCall.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: ForeignCall.c,v 1.7 1999/10/19 23:52:02 andy Exp $ + * $Id: ForeignCall.c,v 1.8 1999/10/22 09:59:34 sewardj Exp $ * * (c) The GHC Team 1994-1999. * @@ -96,22 +96,29 @@ */ /* ToDo: move these to the Right Place */ -extern StgInt PopTaggedInt ( void ) ; -extern StgDouble PopTaggedDouble ( void ) ; -extern StgFloat PopTaggedFloat ( void ) ; -extern StgChar PopTaggedChar ( void ) ; -extern StgAddr PopTaggedAddr ( void ) ; - -extern void PushTaggedInt ( StgInt ); -extern void PushTaggedDouble ( StgDouble ); -extern void PushTaggedFloat ( StgFloat ); -extern void PushTaggedChar ( StgChar ); -extern void PushTaggedAddr ( StgAddr ); +extern StgInt PopTaggedInt ( void ) ; +extern StgWord PopTaggedWord ( void ) ; +extern StgAddr PopTaggedAddr ( void ) ; +extern StgStablePtr PopTaggedStablePtr ( void ) ; +extern StgChar PopTaggedChar ( void ) ; +extern StgFloat PopTaggedFloat ( void ) ; +extern StgDouble PopTaggedDouble ( void ) ; + +extern void PushTaggedInt ( StgInt ); +extern void PushTaggedWord ( StgWord ); +extern void PushTaggedAddr ( StgAddr ); +extern void PushTaggedStablePtr ( StgStablePtr ); +extern void PushTaggedChar ( StgChar ); +extern void PushTaggedFloat ( StgFloat ); +extern void PushTaggedDouble ( StgDouble ); extern void PushPtr ( StgPtr ); extern StgPtr PopPtr ( void ); +extern void universal_call_c_x86_linux ( int, void*, char*, void* ); + void universal_call_c_generic ( int, void*, char*, void* ); + /* -------------------------------------------------------------------------- * This is a generic version of universal call that * only works for specific argument patterns. @@ -120,13 +127,13 @@ extern StgPtr PopPtr ( void ); * even if univeral_call_c_ is not ported. * ------------------------------------------------------------------------*/ -void universal_call_c_x86_generic +void universal_call_c_generic ( int n_args, void* args, char* argstr, void* fun ) { - unsigned int *p = (unsigned int*) args; + unsigned int *p = (unsigned int*) args; #define ARG(n) (p[n*2]) #define CMP(str) ((n_args + 1 == strlen(str)) && \ @@ -167,6 +174,9 @@ void universal_call_c_x86_generic * 1 if too many args/results or non-handled type * 2 if config error on this platform * Tries to automatically handle 32-vs-64 bit differences. + * Assumes an LP64 programming model for 64 bit: + * sizeof(long)==sizeof(void*)==64 on a 64 bit platform + * sizeof(int)==32 on a 64 bit platform * ------------------------------------------------------------------------*/ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) @@ -175,9 +185,11 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) char argd_vec[31]; unsigned int* p; int i; + unsigned long ul; if (sizeof(int) != 4 || sizeof(double) != 8 || sizeof(float) != 4 - || (sizeof(void*) != 4 && sizeof(void*) != 8)) + || (sizeof(void*) != 4 && sizeof(void*) != 8) + || (sizeof(unsigned long) != sizeof(void*))) return 2; if (d->num_args > 30 || d->num_results > 1) @@ -189,29 +201,34 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) p = (unsigned int*) &arg_vec[1]; for (i = 0; i < d->num_args; i++) { switch (d->arg_tys[i]) { - case CHAR_REP: { - int j = (int)PopTaggedChar(); - *p++ = j; *p++ = 0; - argd_vec[i+1] = 'i'; - break; - } - case INT_REP: { - int j = PopTaggedInt(); - *p++ = j; *p++ = 0; - argd_vec[i+1] = 'i'; - break; - } - case ADDR_REP: { - void* a = PopTaggedAddr(); + + case INT_REP: + ul = (unsigned long)PopTaggedInt(); + goto common_int32_or_64; + case WORD_REP: + ul = (unsigned long)PopTaggedWord(); + goto common_int32_or_64; + case ADDR_REP: + ul = (unsigned long)(PopTaggedAddr()); + goto common_int32_or_64; + case STABLE_REP: + ul = (unsigned long)PopTaggedStablePtr(); + common_int32_or_64: if (sizeof(void*) == 4) { - *(void**)p = a; p++; *p++ = 0; + *(unsigned long *)p = ul; p++; *p++ = 0; argd_vec[i+1] = 'i'; } else { - *(void**)p = a; + *(unsigned long *)p = ul; p += 2; argd_vec[i+1] = 'I'; } break; + + case CHAR_REP: { + int j = (int)PopTaggedChar(); + *p++ = j; *p++ = 0; + argd_vec[i+1] = 'i'; + break; } case FLOAT_REP: { float f = PopTaggedFloat(); @@ -234,10 +251,10 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) argd_vec[0] = 'i'; } else { switch (d->result_tys[0]) { - case CHAR_REP: case INT_REP: - argd_vec[0] = 'i'; break; - case ADDR_REP: + case INT_REP: case WORD_REP: case ADDR_REP: case STABLE_REP: argd_vec[0] = (sizeof(void*)==4) ? 'i' : 'I'; break; + case CHAR_REP: + argd_vec[0] = 'i'; break; case FLOAT_REP: argd_vec[0] = 'f'; break; case DOUBLE_REP: @@ -257,26 +274,34 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) universal_call_c_x86_linux ( d->num_args, (void*)arg_vec, argd_vec, fun ); #else - universal_call_c_x86_generic ( + universal_call_c_generic ( d->num_args, (void*)arg_vec, argd_vec, fun ); #endif LoadThreadState(); *bco=(StgBCO*)PopPtr(); + /* INT, WORD, ADDR, STABLE don't need to do a word-size check + since the result is in the bytes starting at p regardless. */ + if (d->num_results > 0) { p = (unsigned int*) &arg_vec[0]; switch (d->result_tys[0]) { - case CHAR_REP: - PushTaggedChar ( (StgChar) p[0]); - break; + case INT_REP: PushTaggedInt ( ((StgInt*)p) [0] ); break; + case WORD_REP: + PushTaggedWord ( ((StgWord*)p) [0] ); + break; case ADDR_REP: - if (sizeof(void*) == 4) - PushTaggedAddr ( ((StgAddr*)p) [0] ); - else - PushTaggedAddr ( ((StgAddr*)p) [0] ); + PushTaggedAddr ( ((StgAddr*)p) [0] ); + break; + case STABLE_REP: + PushTaggedStablePtr ( ((StgStablePtr*)p) [0] ); + break; + + case CHAR_REP: + PushTaggedChar ( (StgChar) p[0]); break; case FLOAT_REP: PushTaggedFloat ( ((StgFloat*)p) [0] ); @@ -284,6 +309,7 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco ) case DOUBLE_REP: PushTaggedDouble ( ((StgDouble*)p) [0] ); break; + default: return 1; }