Commit 511ec6dd authored by andy's avatar andy
Browse files

[project @ 1999-10-19 23:51:57 by andy]

Adding a generic version of universal call that
only works for specific argument patterns.

It allows ports to work on the Hugs Prelude immeduately,
even if univeral_call_c_<os/specific> is not ported.

Also, commented out (longstanding?) bug with incorrect call
to setCurrModule.
parent 7da34d34
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.13 $
* $Date: 1999/10/15 22:35:04 $
* $Revision: 1.14 $
* $Date: 1999/10/19 23:51:57 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -1198,7 +1198,13 @@ if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
{ Int m = namesUpto-1;
Text mtext = findText(scriptInfo[m].modName);
setCurrModule(mtext);
/* Commented out till we understand what
* this is trying to do.
* Problem, you cant find a module till later.
*/
#if 0
setCurrModule(findModule(mtext));
#endif
evalModule = mtext;
}
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
* $Revision: 1.11 $
* $Date: 1999/10/16 02:17:32 $
* $Revision: 1.12 $
* $Date: 1999/10/19 23:51:58 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -319,10 +319,13 @@ Tycon tc; {
static Void local hashTycon(tc) /* Insert Tycon into hash table */
Tycon tc; {
Text t = tycon(tc).text;
Int h = tHash(t);
tycon(tc).nextTyconHash = tyconHash[h];
tyconHash[h] = tc;
assert(isTycon(tc));
if (1) {
Text t = tycon(tc).text;
Int h = tHash(t);
tycon(tc).nextTyconHash = tyconHash[h];
tyconHash[h] = tc;
}
}
Tycon findQualTycon(id) /*locate (possibly qualified) Tycon in tycon table */
......@@ -975,6 +978,7 @@ printf ( "findQualifier %s\n", textToStr(t));
Void setCurrModule(m) /* set lookup tables for current module */
Module m; {
Int i;
assert(isModule(m));
if (m!=currentModule) {
currentModule = m; /* This is the only assignment to currentModule */
for (i=0; i<TYCONHSZ; ++i)
......
......@@ -2,7 +2,7 @@
* Version number
* ------------------------------------------------------------------------*/
/* Define this as a 13 character string uniquely identifying the current
/* Define this as a 14 character string uniquely identifying the current
* version.
* Major releases from Nottingham/Yale are of the form "<month><year>"
* Minor releases from Nottingham/Yale are of the form "[Beta YYMMDD]"
......@@ -11,8 +11,8 @@
#define MAJOR_RELEASE 0
#if MAJOR_RELEASE
#define HUGS_VERSION "January 1998 "
#define HUGS_VERSION "October 1999 "
#else
#define HUGS_VERSION "STG 27 Apr 99"
#define HUGS_VERSION "991015 (STG) "
#endif
/* -----------------------------------------------------------------------------
* $Id: ForeignCall.c,v 1.6 1999/10/19 11:01:26 sewardj Exp $
* $Id: ForeignCall.c,v 1.7 1999/10/19 23:52:02 andy Exp $
*
* (c) The GHC Team 1994-1999.
*
......@@ -112,6 +112,55 @@ extern void PushPtr ( StgPtr );
extern StgPtr PopPtr ( void );
/* --------------------------------------------------------------------------
* This is a generic version of universal call that
* only works for specific argument patterns.
*
* It allows ports to work on the Hugs Prelude immeduately,
* even if univeral_call_c_<os/specific> is not ported.
* ------------------------------------------------------------------------*/
void universal_call_c_x86_generic
( int n_args,
void* args,
char* argstr,
void* fun )
{
unsigned int *p = (unsigned int*) args;
#define ARG(n) (p[n*2])
#define CMP(str) ((n_args + 1 == strlen(str)) && \
(!strncmp(str,argstr,n_args + 1)))
#define CALL(retType,callTypes,callVals) \
((retType(*)callTypes)(fun))callVals
if (CMP("i")) {
int res = CALL(int,(void),());
ARG(0) = res;
} else if (CMP("ii")) {
int arg1 = (int) ARG(1);
int res = CALL(int,(int),(arg1));
ARG(0) = res;
} else if (CMP("iii")) {
int arg1 = (int) ARG(1);
int arg2 = (int) ARG(2);
int res = CALL(int,(int,int),(arg1,arg2));
ARG(0) = res;
} else {
/* Do not have the generic call for this argument list. */
int i;
printf("Can not call external function at address %d\n",(int)fun);
printf("Argument string = '");
for(i=0;i<n_args;i++) {
printf("%c",(char)argstr[i]);
}
printf("' [%d arg(s)]\n",n_args);
assert(0);
}
#undef CMP
}
/* --------------------------------------------------------------------------
* Move args/results between STG stack and the above API's arg block
* Returns 0 on success
......@@ -204,8 +253,13 @@ int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco )
//fprintf(stderr, " argc=%d arg_vec=%p argd_vec=%p `%s' fun=%p\n",
// d->num_args, arg_vec, argd_vec, argd_vec, fun );
#if 1
universal_call_c_x86_linux (
d->num_args, (void*)arg_vec, argd_vec, fun );
#else
universal_call_c_x86_generic (
d->num_args, (void*)arg_vec, argd_vec, fun );
#endif
LoadThreadState();
*bco=(StgBCO*)PopPtr();
......@@ -252,4 +306,5 @@ CFunDescriptor* mkDescriptor( char* as, char* rs )
return d;
}
#endif /* INTERPRETER */
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment