From 366f1a080ac763aa8241817ea52e2bcd254f2280 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 5 Apr 2000 14:13:58 +0000 Subject: [PATCH] [project @ 2000-04-05 14:13:58 by sewardj] Restore +Q and -Q operation, so we can run nofib again. --- ghc/interpreter/hugs.c | 109 +++++++++++++++++++++++++++++++++++--- ghc/interpreter/hugsbasictypes.h | 33 +++++++----- 2 files changed, 124 insertions(+), 18 deletions(-) diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 340fc2d..b772f0b 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.58 $ - * $Date: 2000/04/05 10:25:08 $ + * $Revision: 1.59 $ + * $Date: 2000/04/05 14:13:58 $ * ------------------------------------------------------------------------*/ #include @@ -117,6 +117,7 @@ static String lastEdit = 0; /* Name of script to edit (if any) */ static Int lastEdLine = 0; /* Editor line number (if possible)*/ static String prompt = 0; /* Prompt string */ static Int hpSize = DEFAULTHEAP; /* Desired heap size */ +static Bool disableOutput = FALSE; /* TRUE => quiet */ String hugsEdit = 0; /* String for editor command */ String hugsPath = 0; /* String for file search path */ @@ -835,13 +836,13 @@ static void ppMG ( void ) u = hd(t); switch (whatIs(u)) { case GRP_NONREC: - fprintf ( stderr, " %s\n", textToStr(textOf(snd(u)))); + FPrintf ( stderr, " %s\n", textToStr(textOf(snd(u)))); break; case GRP_REC: - fprintf ( stderr, " {" ); + FPrintf ( stderr, " {" ); for (v = snd(u); nonNull(v); v=tl(v)) - fprintf ( stderr, "%s ", textToStr(textOf(hd(v))) ); - fprintf ( stderr, "}\n" ); + FPrintf ( stderr, "%s ", textToStr(textOf(hd(v))) ); + FPrintf ( stderr, "}\n" ); break; default: internal("ppMG"); @@ -2684,12 +2685,103 @@ String s; { return NULL; } + /* -------------------------------------------------------------------------- * Compiler output * We can redirect compiler output (prompts, error messages, etc) by * tweaking these functions. * ------------------------------------------------------------------------*/ +#ifdef HAVE_STDARG_H +#include +#else +#include +#endif + +Void hugsEnableOutput(f) +Bool f; { + disableOutput = !f; +} + +#ifdef HAVE_STDARG_H +Void hugsPrintf(const char *fmt, ...) { + va_list ap; /* pointer into argument list */ + va_start(ap, fmt); /* make ap point to first arg after fmt */ + if (!disableOutput) { + vprintf(fmt, ap); + } else { + } + va_end(ap); /* clean up */ +} +#else +Void hugsPrintf(fmt, va_alist) +const char *fmt; +va_dcl { + va_list ap; /* pointer into argument list */ + va_start(ap); /* make ap point to first arg after fmt */ + if (!disableOutput) { + vprintf(fmt, ap); + } else { + } + va_end(ap); /* clean up */ +} +#endif + +Void hugsPutchar(c) +int c; { + if (!disableOutput) { + putchar(c); + } else { + } +} + +Void hugsFlushStdout() { + if (!disableOutput) { + fflush(stdout); + } +} + +Void hugsFFlush(fp) +FILE* fp; { + if (!disableOutput) { + fflush(fp); + } +} + +#ifdef HAVE_STDARG_H +Void hugsFPrintf(FILE *fp, const char* fmt, ...) { + va_list ap; + va_start(ap, fmt); + if (!disableOutput) { + vfprintf(fp, fmt, ap); + } else { + } + va_end(ap); +} +#else +Void hugsFPrintf(FILE *fp, const char* fmt, va_list) +FILE* fp; +const char* fmt; +va_dcl { + va_list ap; + va_start(ap); + if (!disableOutput) { + vfprintf(fp, fmt, ap); + } else { + } + va_end(ap); +} +#endif + +Void hugsPutc(c, fp) +int c; +FILE* fp; { + if (!disableOutput) { + putc(c,fp); + } else { + } +} + /* -------------------------------------------------------------------------- * Send message to each component of system: * ------------------------------------------------------------------------*/ @@ -2710,6 +2802,11 @@ Int what; { /* system to respond as appropriate ... */ typeChecker(what); compiler(what); codegen(what); + + mark(moduleGraph); + mark(prelModules); + mark(targetModules); + mark(daSccs); } /*-------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/hugsbasictypes.h b/ghc/interpreter/hugsbasictypes.h index a521fea..497c7e4 100644 --- a/ghc/interpreter/hugsbasictypes.h +++ b/ghc/interpreter/hugsbasictypes.h @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: hugsbasictypes.h,v $ - * $Revision: 1.2 $ - * $Date: 2000/03/24 14:32:03 $ + * $Revision: 1.3 $ + * $Date: 2000/04/05 14:13:58 $ * ------------------------------------------------------------------------*/ #define NON_POSIX_SOURCE @@ -243,15 +243,24 @@ extern int vsnprintf ( char*, int, const char*, va_list ); * Tweaking this lets us redirect prompts, error messages, etc - but has no * effect on output of Haskell programs (which should use hPutStr and friends). *-------------------------------------------------------------------------*/ + +extern Void hugsPrintf (const char *, ...); +extern Void hugsPutchar (int); +extern Void hugsFlushStdout (Void); +extern Void hugsEnableOutput (Bool); + +extern Void hugsFFlush (FILE*); +extern Void hugsFPrintf (FILE*, const char*, ...); +extern Void hugsPutc (int, FILE*); + +#define Printf hugsPrintf +#define Putchar hugsPutchar +#define FlushStdout hugsFlushStdout +#define EnableOutput hugsEnableOutput +#define ClearOutputBuffer hugsClearOutputBuffer + +#define FFlush hugsFFlush +#define FPrintf hugsFPrintf +#define Putc hugsPutc -#define Printf printf -#define Putchar putchar -#define FlushStdout() fflush(stdout) -#define EnableOutput(f) doNothing() -#define ClearOutputBuffer() 0 - -#define FFlush fflush -#define FPrintf fprintf -#define Putc putc - /*-------------------------------------------------------------------------*/ -- 1.7.10.4