Commit f9d55444 authored by sewardj's avatar sewardj

[project @ 2000-03-10 20:03:36 by sewardj]

Update .c files to reflect reorganisation of .h files in this directory.
parent 0d2aee5f
......@@ -9,18 +9,16 @@
* included in the distribution.
*
* $RCSfile: codegen.c,v $
* $Revision: 1.17 $
* $Date: 2000/03/07 16:18:25 $
* $Revision: 1.18 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "Assembler.h"
#include "link.h"
#include "Assembler.h"
#include "Rts.h" /* IF_DEBUG */
#include "RtsFlags.h"
......@@ -163,7 +161,7 @@ print(e,10);printf("\n");
pushVar(bco,name(e).stgVar);
} else {
Cell /*CPtr*/ addr = cptrFromName(e);
# ifdef DEBUG_CODEGEN
# if DEBUG_CODEGEN
fprintf ( stderr, "nativeAtom: name %s\n",
nameFromOPtr(cptrOf(addr)) );
# endif
......@@ -553,7 +551,7 @@ static Void build( AsmBCO bco, StgVar v )
if (isCPtr(fun)) {
assert(isName(fun0));
itsaPAP = name(fun0).arity > length(args);
# ifdef DEBUG_CODEGEN
# if DEBUG_CODEGEN
fprintf ( stderr, "nativeCall: name %s, arity %d, args %d\n",
nameFromOPtr(cptrOf(fun)), name(fun0).arity,
length(args) );
......
......@@ -11,28 +11,19 @@
* included in the distribution.
*
* $RCSfile: compiler.c,v $
* $Revision: 1.20 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.21 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "Rts.h" /* for rts_eval and related stuff */
#include "RtsAPI.h" /* for rts_eval and related stuff */
#include "SchedAPI.h" /* for RevertCAFs */
#include "Schedule.h"
#include "link.h"
Addr inputCode; /* Addr of compiled code for expr */
static Name currentName; /* Top level name being processed */
#if DEBUG_CODE
Bool debugCode = FALSE; /* TRUE => print G-code to screen */
#endif
/* --------------------------------------------------------------------------
* Local function prototypes:
......@@ -85,6 +76,7 @@ static Void local compileGenFunction Args((Name));
static Name local compileSelFunction Args((Pair));
static List local addStgVar Args((List,Pair));
static Name currentName; /* Top level name being processed */
/* --------------------------------------------------------------------------
* Translation: Convert input expressions into a less complex language
......
......@@ -9,17 +9,15 @@
* included in the distribution.
*
* $RCSfile: derive.c,v $
* $Revision: 1.11 $
* $Date: 1999/12/10 15:59:43 $
* $Revision: 1.12 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "Assembler.h"
#include "link.h"
List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
......
......@@ -9,14 +9,13 @@
* included in the distribution.
*
* $RCSfile: dynamic.c,v $
* $Revision: 1.13 $
* $Date: 1999/11/25 10:19:15 $
* $Revision: 1.14 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "errors.h"
#include "dynamic.h"
#include "connect.h"
#if HAVE_WINDOWS_H && !defined(__MSDOS__)
......
......@@ -9,13 +9,12 @@
* included in the distribution.
*
* $RCSfile: free.c,v $
* $Revision: 1.8 $
* $Date: 2000/02/03 13:55:21 $
* $Revision: 1.9 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.40 $
* $Date: 2000/03/09 21:35:38 $
* $Revision: 1.41 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -19,12 +19,9 @@
#include "prelude.h"
#include "storage.h"
#include "command.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "version.h"
#include "link.h"
#include "Rts.h"
#include "RtsAPI.h"
......@@ -789,21 +786,13 @@ struct options toggle[] = { /* List of command line toggles */
{'w', 1, "Always show which modules are loaded", &listScripts},
{'k', 1, "Show kind errors in full", &kindExpert},
{'o', 0, "Allow overlapping instances", &allowOverlap},
#if DEBUG_CODE
{'D', 1, "Debug: show generated code", &debugCode},
#endif
{'S', 1, "Debug: show generated SC code", &debugSC},
#if EXPLAIN_INSTANCE_RESOLUTION
{'x', 1, "Explain instance resolution", &showInstRes},
#endif
#if MULTI_INST
{'m', 0, "Use multi instance resolution", &multiInstRes},
#endif
#if DEBUG_CODE
{'D', 1, "Debug: show generated G code", &debugCode},
#endif
{'S', 1, "Debug: show generated SC code", &debugSC},
{0, 0, 0, 0}
};
......
......@@ -9,17 +9,15 @@
* included in the distribution.
*
* $RCSfile: input.c,v $
* $Revision: 1.19 $
* $Date: 2000/03/09 02:47:13 $
* $Revision: 1.20 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "command.h"
#include "errors.h"
#include "link.h"
#include <ctype.h>
#if HAVE_GETDELIM_H
#include "getdelim.h"
......
......@@ -7,19 +7,18 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
* $Revision: 1.36 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.37 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "link.h"
#include "Assembler.h" /* for wrapping GHC objects */
#include "object.h"
#include "Assembler.h" /* for wrapping GHC objects */
/*#define DEBUG_IFACE*/
#define VERBOSE FALSE
......
......@@ -12,13 +12,12 @@
* included in the distribution.
*
* $RCSfile: lift.c,v $
* $Revision: 1.10 $
* $Date: 1999/12/10 15:59:47 $
* $Revision: 1.11 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
......
......@@ -9,18 +9,16 @@
* included in the distribution.
*
* $RCSfile: link.c,v $
* $Revision: 1.48 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.49 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "Assembler.h" /* for asmPrimOps and AsmReps */
#include "link.h"
Type typeArrow; /* Function spaces */
......@@ -334,11 +332,7 @@ Void linkPreludeTC(void) { /* Hook to tycons and classes in */
stdDefaults = NIL;
stdDefaults = cons(typeDouble,stdDefaults);
# if DEFAULT_BIGNUM
stdDefaults = cons(typeInteger,stdDefaults);
# else
stdDefaults = cons(typeInt,stdDefaults);
# endif
predNum = ap(classNum,aVar);
predFractional = ap(classFractional,aVar);
......
......@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: output.c,v $
* $Revision: 1.14 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.15 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -215,7 +215,7 @@ Cell e; {
break;
case LETREC : OPEN(d>WHERE_PREC);
#if DEBUG_CODE
#if 0
putStr("let {");
put(NEVER,fst(snd(e)));
putStr("} in ");
......@@ -271,7 +271,7 @@ Cell e; {
case CASE : putStr("case ");
put(NEVER,fst(snd(e)));
#if DEBUG_CODE
#if 0
putStr(" of {");
put(NEVER,snd(snd(e)));
putChr('}');
......@@ -357,7 +357,7 @@ Cell q; {
static Bool local isDictVal(e) /* Look for dictionary value */
Cell e; {
#if !DEBUG_CODE
#if 0 /* was !DEBUG_CODE -- is it necessary? */
Cell h = getHead(e);
switch (whatIs(h)) {
case DICTVAR : return TRUE;
......
......@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: prelude.h,v $
* $Revision: 1.7 $
* $Date: 2000/03/10 17:30:36 $
* $Revision: 1.8 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#define NON_POSIX_SOURCE
......@@ -338,3 +338,5 @@ extern Void hugsPutc Args((int, FILE*));
#define Putc putc
#endif
/*-------------------------------------------------------------------------*/
......@@ -9,17 +9,14 @@
* included in the distribution.
*
* $RCSfile: static.c,v $
* $Revision: 1.28 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.29 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "link.h"
#include "errors.h"
#include "subst.h"
/* --------------------------------------------------------------------------
* local function prototypes:
......
......@@ -9,16 +9,15 @@
* included in the distribution.
*
* $RCSfile: stg.c,v $
* $Revision: 1.12 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.13 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "link.h" /* for nameTrue/False */
#include "Assembler.h" /* for AsmRep and primops */
/* --------------------------------------------------------------------------
......
......@@ -9,13 +9,12 @@
* included in the distribution.
*
* $RCSfile: stgSubst.c,v $
* $Revision: 1.6 $
* $Date: 1999/11/12 17:32:46 $
* $Revision: 1.7 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
......
......@@ -9,13 +9,12 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
* $Revision: 1.49 $
* $Date: 2000/03/10 17:30:36 $
* $Revision: 1.50 $
* $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "object.h"
......@@ -3081,87 +3080,6 @@ void dumpInst ( Int i )
}
/* --------------------------------------------------------------------------
* plugin support
* ------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------
* GreenCard entry points
*
* GreenCard generated code accesses Hugs data structures and functions
* (only) via these functions (which are stored in the virtual function
* table hugsAPI1.
*-------------------------------------------------------------------------*/
#if GREENCARD
static Cell makeTuple Args((Int));
static Cell makeInt Args((Int));
static Cell makeChar Args((Char));
static Char CharOf Args((Cell));
static Cell makeFloat Args((FloatPro));
static Void* derefMallocPtr Args((Cell));
static Cell* Fst Args((Cell));
static Cell* Snd Args((Cell));
static Cell makeTuple(n) Int n; { return mkTuple(n); }
static Cell makeInt(n) Int n; { return mkInt(n); }
static Cell makeChar(n) Char n; { return mkChar(n); }
static Char CharOf(n) Cell n; { return charOf(n); }
static Cell makeFloat(n) FloatPro n; { return mkFloat(n); }
static Void* derefMallocPtr(n) Cell n; { return derefMP(n); }
static Cell* Fst(n) Cell n; { return (Cell*)&fst(n); }
static Cell* Snd(n) Cell n; { return (Cell*)&snd(n); }
HugsAPI1* hugsAPI1() {
static HugsAPI1 api;
static Bool initialised = FALSE;
if (!initialised) {
api.nameTrue = nameTrue;
api.nameFalse = nameFalse;
api.nameNil = nameNil;
api.nameCons = nameCons;
api.nameJust = nameJust;
api.nameNothing = nameNothing;
api.nameLeft = nameLeft;
api.nameRight = nameRight;
api.nameUnit = nameUnit;
api.nameIORun = nameIORun;
api.makeInt = makeInt;
api.makeChar = makeChar;
api.CharOf = CharOf;
api.makeFloat = makeFloat;
api.makeTuple = makeTuple;
api.pair = pair;
api.mkMallocPtr = mkMallocPtr;
api.derefMallocPtr = derefMallocPtr;
api.mkStablePtr = mkStablePtr;
api.derefStablePtr = derefStablePtr;
api.freeStablePtr = freeStablePtr;
api.eval = eval;
api.evalWithNoError = evalWithNoError;
api.evalFails = evalFails;
api.whnfArgs = &whnfArgs;
api.whnfHead = &whnfHead;
api.whnfInt = &whnfInt;
api.whnfFloat = &whnfFloat;
api.garbageCollect = garbageCollect;
api.stackOverflow = hugsStackOverflow;
api.internal = internal;
api.registerPrims = registerPrims;
api.addPrimCfun = addPrimCfun;
api.inventText = inventText;
api.Fst = Fst;
api.Snd = Snd;
api.cellStack = cellStack;
api.sp = &sp;
}
return &api;
}
#endif /* GREENCARD */
/* --------------------------------------------------------------------------
* storage control:
* ------------------------------------------------------------------------*/
......
......@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: storage.h,v $
* $Revision: 1.32 $
* $Date: 2000/03/10 14:53:00 $
* $Revision: 1.33 $
* $Date: 2000/03/10 20:03:37 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -949,110 +949,6 @@ extern String fileOfModule Args((Module));
extern Void dropScriptsFrom Args((Script));
/* --------------------------------------------------------------------------
* Plugins
* ------------------------------------------------------------------------*/
#if PLUGINS
/* This is an exact copy of the declaration found in GreenCard.h */
typedef int HugsStackPtr;
typedef int HugsStablePtr;
typedef Pointer HugsForeign;
typedef struct {
/* evaluate next argument */
int (*getInt ) Args(());
unsigned int (*getWord ) Args(());
void* (*getAddr ) Args(());
float (*getFloat ) Args(());
double (*getDouble) Args(());
char (*getChar ) Args(());
HugsForeign (*getForeign) Args(());
HugsStablePtr (*getStablePtr) Args(());
/* push part of result */
void (*putInt ) Args((int));
void (*putWord ) Args((unsigned int));
void (*putAddr ) Args((void*));
void (*putFloat ) Args((double));
void (*putDouble) Args((double));
void (*putChar ) Args((char));
void (*putForeign) Args((HugsForeign, void (*)(HugsForeign)));
void (*putStablePtr) Args((HugsStablePtr));
/* return n values in IO monad or Id monad */
void (*returnIO) Args((HugsStackPtr, int));
void (*returnId) Args((HugsStackPtr, int));
int (*runIO) Args((int));
/* free a stable pointer */
void (*freeStablePtr) Args((HugsStablePtr));
/* register the prim table */
void (*registerPrims) Args((struct primInfo*));
/* garbage collect */
void (*garbageCollect) Args(());
} HugsAPI2;
extern HugsAPI2* hugsAPI2 Args((Void));
typedef Void (*InitModuleFun2) Args((HugsAPI2*));
typedef struct {
Name nameTrue, nameFalse;
Name nameNil, nameCons;
Name nameJust, nameNothing;
Name nameLeft, nameRight;
Name nameUnit;
Name nameIORun;
Cell (*makeInt) Args((Int));
Cell (*makeChar) Args((Char));
Char (*CharOf) Args((Cell));
Cell (*makeFloat) Args((FloatPro));
Cell (*makeTuple) Args((Int));
Pair (*pair) Args((Cell,Cell));
Cell (*mkMallocPtr) Args((Void *, Void (*)(Void *)));
Void *(*derefMallocPtr) Args((Cell));
Int (*mkStablePtr) Args((Cell));
Cell (*derefStablePtr) Args((Int));
Void (*freeStablePtr) Args((Int));
Void (*eval) Args((Cell));
Cell (*evalWithNoError) Args((Cell));
Void (*evalFails) Args((StackPtr));
Int *whnfArgs;
Cell *whnfHead;
Int *whnfInt;
Float *whnfFloat;
Void (*garbageCollect) Args(());
Void (*stackOverflow) Args(());
Void (*internal) Args((String)) HUGS_noreturn;
Void (*registerPrims) Args((struct primInfo*));
Name (*addPrimCfun) Args((Text,Int,Int,Cell));
Text (*inventText) Args(());
Cell *(*Fst) Args((Cell));
Cell *(*Snd) Args((Cell));
Cell *cellStack;
StackPtr *sp;
} HugsAPI1;
extern HugsAPI1* hugsAPI1 Args((Void));
typedef Void (*InitModuleFun1) Args((HugsAPI1*));
#endif /* PLUGINS */
/* --------------------------------------------------------------------------
* Misc:
* ------------------------------------------------------------------------*/
......@@ -1072,12 +968,4 @@ extern void dumpClass ( Int c );
extern void dumpInst ( Int i );
extern void locateSymbolByName ( Text t );
#if LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE(sss) _##sss
#define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
#else
#define MAYBE_LEADING_UNDERSCORE(sss) sss
#define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
#endif
/*-------------------------------------------------------------------------*/