Commit 7c1668b4 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-02-15 13:16:19 by sewardj]

Backend interop fixes:
-- Make Hugs use the same constructor tag numbering as GHC, viz, starting
   at zero.
-- Evaluator.c: when unwinding the stack on entering a constructor,
   return to the scheduler if a RET_{VEC_}{SMALL|BIG} is found on the
   stack.
parent f460a89b
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.38 $
* $Date: 2000/02/08 15:32:29 $
* $Revision: 1.39 $
* $Date: 2000/02/15 13:16:19 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -40,8 +40,6 @@ Bool showInstRes = FALSE;
Bool multiInstRes = FALSE;
#endif
#define N_PRELUDE_SCRIPTS (combined ? 30 : 1)
/* --------------------------------------------------------------------------
* Local function prototypes:
* ------------------------------------------------------------------------*/
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: stg.c,v $
* $Revision: 1.10 $
* $Date: 1999/12/07 11:14:56 $
* $Revision: 1.11 $
* $Date: 2000/02/15 13:16:20 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -25,32 +25,40 @@
* Utility functions
* ------------------------------------------------------------------------*/
void* stgConInfo( StgDiscr d )
/* Make an info table for a constructor or tuple. */
void* stgConInfo ( StgDiscr d )
{
int tag;
switch (whatIs(d)) {
case NAME:
case NAME: {
tag = cfunOf(d);
if (tag > 0) tag--;
if (!name(d).itbl)
name(d).itbl = asmMkInfo(cfunOf(d),name(d).arity);
name(d).itbl = asmMkInfo(tag,name(d).arity);
return name(d).itbl;
case TUPLE:
}
case TUPLE: {
tag = 0;
if (!tycon(d).itbl)
tycon(d).itbl = asmMkInfo(0,tupleOf(d));
tycon(d).itbl = asmMkInfo(tag,tupleOf(d));
return tycon(d).itbl;
}
default:
internal("stgConInfo");
}
}
int stgDiscrTag( StgDiscr d )
/* Return the tag for a constructor or tuple, starting at zero. */
int stgDiscrTag ( StgDiscr d )
{
int tag;
switch (whatIs(d)) {
case NAME:
return cfunOf(d);
case TUPLE:
return 0;
default:
internal("stgDiscrTag");
case NAME: tag = cfunOf(d); break;
case TUPLE: tag = 0;
default: internal("stgDiscrTag");
}
if (tag > 0) tag--;
return tag;
}
/* --------------------------------------------------------------------------
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
* $Revision: 1.42 $
* $Date: 2000/02/08 17:50:46 $
* $Revision: 1.43 $
* $Date: 2000/02/15 13:16:20 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -1643,12 +1643,13 @@ String f; { /* of status for later restoration */
}
Bool isPreludeScript() { /* Test whether this is the Prelude*/
return (scriptHw==0);
return (scriptHw < N_PRELUDE_SCRIPTS /*==0*/ );
}
Bool moduleThisScript(m) /* Test if given module is defined */
Module m; { /* in current script file */
return scriptHw<1 || m>=scripts[scriptHw-1].moduleHw;
return scriptHw < 1
|| m>=scripts[scriptHw-1].moduleHw;
}
Module lastModule() { /* Return module in current script file */
......
......@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: storage.h,v $
* $Revision: 1.25 $
* $Date: 2000/01/11 15:40:57 $
* $Revision: 1.26 $
* $Date: 2000/02/15 13:16:20 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -545,6 +545,8 @@ extern void* lookupOExtraTabName ( char* sym );
#define isPrelude(m) (m==modulePrelude)
#define N_PRELUDE_SCRIPTS (combined ? 30 : 1)
/* --------------------------------------------------------------------------
* Type constructor names:
* ------------------------------------------------------------------------*/
......
......@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
* $Revision: 1.32 $
* $Date: 2000/02/14 11:04:58 $
* $Revision: 1.33 $
* $Date: 2000/02/15 13:16:20 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
......@@ -851,7 +851,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
{
int tag = BCO_INSTR_8;
StgWord offset = BCO_INSTR_16;
if (constrTag(stgCast(StgClosure*,xStackPtr(0))) != tag) {
if (constrTag( (StgClosure*)xStackPtr(0) ) != tag) {
bciPtr += offset;
}
Continue;
......@@ -1448,7 +1448,9 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
case RET_VEC_SMALL:
case RET_BIG:
case RET_VEC_BIG:
// barf("todo: RET_[VEC_]{BIG,SMALL}");
cap->rCurrentTSO->whatNext = ThreadEnterGHC;
xPushCPtr(obj);
RETURN(ThreadYielding);
default:
belch("entered CONSTR with invalid continuation on stack");
IF_DEBUG(evaluator,
......
/* -----------------------------------------------------------------------------
* $Id: StgCRun.c,v 1.10 2000/02/14 11:01:27 sewardj Exp $
* $Id: StgCRun.c,v 1.11 2000/02/15 13:16:20 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -38,7 +38,7 @@
static jmp_buf jmp_environment;
#if 1
#if 0
extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
{
......
Markdown is supported
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