diff options
| author | sewardj <unknown> | 2000-02-15 13:16:20 +0000 |
|---|---|---|
| committer | sewardj <unknown> | 2000-02-15 13:16:20 +0000 |
| commit | 7c1668b46ada13fbb5a8de2276b2878ed1c6e210 (patch) | |
| tree | d554087d9f08ebf16d6f25af2040b0d95655a02c /ghc/interpreter | |
| parent | f460a89b3e089dcf47c67ed747687b91dd80d5fd (diff) | |
| download | haskell-7c1668b46ada13fbb5a8de2276b2878ed1c6e210.tar.gz | |
[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.
Diffstat (limited to 'ghc/interpreter')
| -rw-r--r-- | ghc/interpreter/hugs.c | 6 | ||||
| -rw-r--r-- | ghc/interpreter/stg.c | 36 | ||||
| -rw-r--r-- | ghc/interpreter/storage.c | 9 | ||||
| -rw-r--r-- | ghc/interpreter/storage.h | 6 |
4 files changed, 33 insertions, 24 deletions
diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index cd1eff5f47..75956fe4ff 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -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: * ------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/stg.c b/ghc/interpreter/stg.c index ac620f7a6a..78c60bd17b 100644 --- a/ghc/interpreter/stg.c +++ b/ghc/interpreter/stg.c @@ -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; } /* -------------------------------------------------------------------------- diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 39558ff379..d6db5f37da 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -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 */ diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h index df74320481..8806d29aac 100644 --- a/ghc/interpreter/storage.h +++ b/ghc/interpreter/storage.h @@ -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: * ------------------------------------------------------------------------*/ |