X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fmachdep.c;h=0ceff72e23e44e80f87db8a7df4f4aa30fd4bb9c;hb=7e150969472ef9a48af9a7a2cc23a84952e90078;hp=25cef1f28db1ff2bdfa41d65b2a061be4ce713bc;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index 25cef1f..0ceff72 100644 --- a/ghc/interpreter/machdep.c +++ b/ghc/interpreter/machdep.c @@ -1,28 +1,22 @@ -/* -*- mode: hugs-c; -*- */ + /* -------------------------------------------------------------------------- * Machine dependent code * RISCOS specific code provided by Bryan Scatergood, JBS * Macintosh specific code provided by Hans Aberg (haberg@matematik.su.se) + * HaskellScript code and recursive directory search provided by + * Daan Leijen (leijen@fwi.uva.nl) * - * Copyright (c) The University of Nottingham and Yale University, 1994-1997. - * All rights reserved. See NOTICE for details and conditions of use etc... - * Hugs version 1.4, December 1997 + * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the + * Yale Haskell Group, and the Oregon Graduate Institute of Science and + * Technology, 1994-1999, All rights reserved. It is distributed as + * free software under the license in the file "License", which is + * included in the distribution. * * $RCSfile: machdep.c,v $ - * $Revision: 1.2 $ - * $Date: 1998/12/02 13:22:20 $ + * $Revision: 1.30 $ + * $Date: 2000/04/12 09:43:10 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" -#include "storage.h" -#include "connect.h" -#include "hugs.h" /* for fromEnv */ -#include "errors.h" -#include "version.h" - -#include "machdep.h" - -#include #ifdef HAVE_SIGNAL_H # include #endif @@ -51,7 +45,7 @@ #ifdef HAVE_DOS_H # include #endif -#if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS +#if defined HAVE_CONIO_H # include #endif #ifdef HAVE_IO_H @@ -64,16 +58,6 @@ # include #endif -#if HUGS_FOR_WINDOWS -#include -#include - -extern HCURSOR HandCursor; /* Forward references to cursors */ -extern HCURSOR GarbageCursor; -extern HCURSOR SaveCursor; -static void local DrawStatusLine Args((HWND)); -#endif - #if DOS #include extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */ @@ -106,24 +90,30 @@ extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */ #ifdef HAVE_UNIX_H #include #endif +#if SYMANTEC_C +int allow_break_count = 0; +#endif /* -------------------------------------------------------------------------- * Find information about a file: * ------------------------------------------------------------------------*/ -static Bool local readable Args((String)); +#include "machdep_time.h" + +static Bool local readable ( String ); +static Void local getFileInfo ( String, Time *, Long * ); -Void getFileInfo(f,tm,sz) /* find time stamp and size of file*/ +static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/ String f; Time *tm; Long *sz; { #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H struct stat scbuf; if (!stat(f,&scbuf)) { - *tm = scbuf.st_mtime; + if (tm) *tm = scbuf.st_mtime; *sz = (Long)(scbuf.st_size); } else { - *tm = 0; + if (tm) *tm = 0; *sz = 0; } #else /* normally just use stat() */ @@ -132,15 +122,20 @@ Long *sz; { r.r[1] = (int)s; os_swi(OS_File, &r); if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) { - tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */ - tm->lo = r.r[3]; /* Execution address (low 4 bytes) */ + if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */ + if (tm) tm->lo = r.r[3]; /* Execution address (low 4 bytes) */ } else { /* Not found, or not time-stamped */ - tm->hi = tm->lo = 0; + if (tm) tm->hi = tm->lo = 0; } *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0); #endif } +Void getFileSize ( String f, Long* sz ) +{ + getFileInfo ( f, NULL, sz ); +} + #if defined HAVE_GETFINFO /* Mac971031 */ /* -------------------------------------------------------------------------- * Define a MacOS version of access(): @@ -181,6 +176,7 @@ String f; { return (0 == access(f,4)); #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H struct stat scbuf; + /* fprintf(stderr, "readable: %s\n", f ); */ return ( !stat(f,&scbuf) && (scbuf.st_mode & S_IREAD) /* readable */ && (scbuf.st_mode & S_IFREG) /* regular file */ @@ -200,33 +196,52 @@ String f; { * Search for script files on the HUGS path: * ------------------------------------------------------------------------*/ -static String local hugsdir Args((Void)); -static String local RealPath Args((String)); -static String local normPath Args((String)); -static Void local searchChr Args((Int)); -static Void local searchStr Args((String)); -static Bool local tryEndings Args((String)); +static String local hugsdir ( Void ); +#if HSCRIPT +static String local hscriptDir ( Void ); +#endif +static int local pathCmp ( String, String ); +static String local normPath ( String ); +static Void local searchChr ( Int ); +static Void local searchStr ( String ); +static Bool local tryEndings ( String ); -#if DOS_FILENAMES -# define SLASH '\\' +#if (DOS_FILENAMES || __CYGWIN32__) +# define SLASH '/' +# define SLASH_STR "/" # define isSLASH(c) ((c)=='\\' || (c)=='/') # define PATHSEP ';' -# define DLL_ENDING ".dll" +# define PATHSEP_STR ";" +# define DLL_ENDING ".u_o" #elif MAC_FILENAMES # define SLASH ':' # define isSLASH(c) ((c)==SLASH) # define PATHSEP ';' +# define PATHSEP_STR ";" /* Mac PEF (Preferred Executable Format) file */ # define DLL_ENDING ".pef" #else # define SLASH '/' +# define SLASH_STR "/" # define isSLASH(c) ((c)==SLASH) # define PATHSEP ':' -# define DLL_ENDING ".so" +# define PATHSEP_STR ":" +# define DLL_ENDING ".u_o" #endif static String local hugsdir() { /* directory containing lib/Prelude.hs */ -#if HAVE_GETMODULEFILENAME && !DOS +#if HSCRIPT + /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */ + static char dir[FILENAME_MAX+1] = ""; + if (dir[0] == '\0') { /* not initialised yet */ + String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir", + HUGSDIR); + if (s) { + strcpy(dir,s); + } + } + return dir; +#elif HAVE_GETMODULEFILENAME && !DOS && !__CYGWIN32__ /* On Windows, we can find the binary we're running and it's * conventional to put the libraries in the same place. */ @@ -237,7 +252,8 @@ static String local hugsdir() { /* directory containing lib/Prelude.hs */ if (dir[0] == '\0') { /* GetModuleFileName must have failed */ return HUGSDIR; } - if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */ + slash = strrchr(dir,SLASH); + if (slash) { /* truncate after directory name */ *slash = '\0'; } } @@ -251,7 +267,21 @@ static String local hugsdir() { /* directory containing lib/Prelude.hs */ return HUGSDIR; #endif } - + +#if HSCRIPT +static String local hscriptDir() { /* Directory containing hscript.dll */ + static char dir[FILENAME_MAX+1] = ""; + if (dir[0] == '\0') { /* not initialised yet */ + String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir",""); + if (s) { + strcpy(dir,s); + } + } + return dir; +} +#endif + +#if 0 /* apparently unused */ static String local RealPath(s) /* Find absolute pathname of file */ String s; { #if HAVE__FULLPATH /* eg DOS */ @@ -266,8 +296,10 @@ String s; { #endif return path; } +#endif -int pathCmp(p1,p2) /* Compare paths after normalisation */ + +static int local pathCmp(p1,p2) /* Compare paths after normalisation */ String p1; String p2; { #if HAVE__FULLPATH /* eg DOS */ @@ -306,7 +338,11 @@ String s; { /* a pathname in some appropriate manner. */ #endif /* ! PATH_CANONICALIZATION */ } -static String endings[] = { "", ".myhi", ".hs", ".lhs", 0 }; +#if HSCRIPT +static String endings[] = { "", ".u_hi", ".hs", ".lhs", ".hsx", ".hash", 0 }; +#else +static String endings[] = { "", ".u_hi", ".hs", ".lhs", 0 }; +#endif static char searchBuf[FILENAME_MAX+1]; static Int searchPos; @@ -315,7 +351,7 @@ static Int searchPos; static Void local searchChr(c) /* Add single character to search buffer */ Int c; { if (searchPos + +static char baseFile[FILENAME_MAX+1]; +static char basePath[FILENAME_MAX+1]; +static int basePathLen; + +static int scanitem( const char* path, + const struct stat* statinfo, + int info ) +{ + if (info == FTW_D) { /* is it a directory */ + searchReset(0); + searchStr(path); + searchChr(SLASH); + if (tryEndings(baseFile)) { + return 1; + } + } + return 0; +} + +static Bool scanSubDirs(s) +String s; +{ + int r; + strcpy(baseFile,s); + strcpy(basePath,searchBuf); + basePathLen = strlen(basePath); + + /* is it in the current directory ? */ + if (tryEndings(s)) return TRUE; + + /* otherwise scan the subdirectories */ + r = ftw( basePath, scanitem, 2 ); + errno = 0; + return (r > 0); +} + +#endif /* HAVE_WINDOWS_H || HAVE_FTW_H */ +#endif /* SEARCH_DIR */ + String findPathname(along,nm) /* Look for a file along specified path */ String along; /* Return NULL if file does not exist */ String nm; { - String s = findMPathname(along,nm); + /* AC, 1/21/99: modified to search hugsPath first, then projectPath */ + String s = findMPathname(along,nm,hugsPath); return s ? s : normPath(searchBuf); } -String findMPathname(along,nm) /* Look for a file along specified path */ +/* AC, 1/21/99: modified to pass in path to search explicitly */ +String findMPathname(along,nm,path)/* Look for a file along specified path */ String along; /* If nonzero, a path prefix from along is */ -String nm; { /* used as the first prefix in the search. */ - String pathpt = hugsPath; +String nm; /* used as the first prefix in the search. */ +String path; { + String pathpt = path; searchReset(0); if (along) { /* Was a path for an existing file given? */ @@ -370,6 +504,7 @@ String nm; { /* used as the first prefix in the search. */ if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */ Bool more = TRUE; do { + Bool recurse = FALSE; /* DL: shall we recurse ? */ searchReset(0); if (*pathpt) { if (*pathpt!=PATHSEP) { @@ -378,20 +513,37 @@ String nm; { /* used as the first prefix in the search. */ searchStr(hugsdir()); pathpt += 6; } - do +#if HSCRIPT + /* And another - we ought to generalise this stuff */ + else if (strncmp(pathpt,"{HScript}",9)==0) { + searchStr(hscriptDir()); + pathpt += 9; + } +#endif + do { searchChr(*pathpt++); - while (*pathpt && *pathpt!=PATHSEP); - searchChr(SLASH); + } while (*pathpt && *pathpt!=PATHSEP); + recurse = (pathpt[-1] == SLASH); + if (!recurse) { + searchChr(SLASH); + } } if (*pathpt==PATHSEP) pathpt++; else more = FALSE; - } - else + } else { more = FALSE; - if (tryEndings(nm)) + } +#if SEARCH_DIR + if (recurse ? scanSubDirs(nm) : tryEndings(nm)) { return normPath(searchBuf); + } +#else + if (tryEndings(nm)) { + return normPath(searchBuf); + } +#endif } while (more); } @@ -400,11 +552,232 @@ String nm; { /* used as the first prefix in the search. */ } /* -------------------------------------------------------------------------- + * New path handling stuff for the Combined System (tm) + * ------------------------------------------------------------------------*/ + +char installDir[N_INSTALLDIR]; + +/* Sets installDir to $STGHUGSDIR, and ensures there is a trailing + slash at the end. +*/ +void setInstallDir ( String argv_0 ) +{ + int i; + char* r = getenv("STGHUGSDIR"); + if (!r) { + fprintf(stderr, + "%s: installation error: environment variable STGHUGSDIR is not set.\n", + argv_0 ); + fprintf(stderr, + "%s: pls set it to be the directory where STGHugs98 is installed.\n\n", + argv_0 ); + exit(2); + + } + + if (strlen(r) > N_INSTALLDIR-30 ) { + fprintf(stderr, + "%s: environment variable STGHUGSDIR is suspiciously long; pls remedy\n\n", + argv_0 ); + exit(2); + } + + strcpy ( installDir, r ); + i = strlen(installDir); + if (installDir[i-1] != SLASH) installDir[i++] = SLASH; + installDir[i] = 0; +} + + +Bool findFilesForModule ( + String modName, + String* path, + String* sExt, + Bool* sAvail, Time* sTime, Long* sSize, + Bool* oiAvail, Time* oiTime, Long* oSize, Long* iSize + ) +{ + /* Let the module name given be M. + For each path entry P, + a s(rc) file will be P/M.hs or P/M.lhs + an i(nterface) file will be P/M.hi + an o(bject) file will be P/M.o + If there is a s file or (both i and o files) + use P to fill in the path names. + Otherwise, move on to the next path entry. + If all path entries are exhausted, return False. + + If in standalone, only look for (and succeed for) source modules. + Caller free()s path. sExt is statically allocated. + srcExt is only set if a valid source file is found. + */ + Int nPath; + Bool literate; + String peStart, peEnd; + String augdPath; /* .:hugsPath:installDir/../lib/std:installDir/lib */ + Time oTime, iTime; + Bool oAvail, iAvail; + + *path = *sExt = NULL; + *sAvail = *oiAvail = oAvail = iAvail = FALSE; + *sSize = *oSize = *iSize = 0; + + augdPath = malloc( 2*(10+3+strlen(installDir)) + +strlen(hugsPath) +50/*paranoia*/); + if (!augdPath) + internal("moduleNameToFileNames: malloc failed(2)"); + + augdPath[0] = 0; + strcat(augdPath, "."); + strcat(augdPath, PATHSEP_STR); + + strcat(augdPath, hugsPath); + strcat(augdPath, PATHSEP_STR); + + if (combined) { + strcat(augdPath, installDir); + strcat(augdPath, ".."); + strcat(augdPath, SLASH_STR); + strcat(augdPath, "lib"); + strcat(augdPath, SLASH_STR); + strcat(augdPath, "std"); + strcat(augdPath, PATHSEP_STR); + } + + strcat(augdPath, installDir); + strcat(augdPath, "lib"); + strcat(augdPath, PATHSEP_STR); + + /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */ + + peEnd = augdPath-1; + while (1) { + /* Advance peStart and peEnd very paranoically, giving up at + the first sign of mutancy in the path string. + */ + if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; } + peStart = peEnd+1; + peEnd = peStart; + while (*peEnd && *peEnd != PATHSEP) peEnd++; + + /* Now peStart .. peEnd-1 bracket the next path element. */ + nPath = peEnd-peStart; + if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) { + ERRMSG(0) "Hugs path \"%s\" contains excessively long component", + hugsPath + EEND; + free(augdPath); + return FALSE; + } + + strncpy(searchBuf, peStart, nPath); + searchBuf[nPath] = 0; + if (nPath > 0 && !isSLASH(searchBuf[nPath-1])) + searchBuf[nPath++] = SLASH; + + strcpy(searchBuf+nPath, modName); + nPath += strlen(modName); + + /* searchBuf now holds 'P/M'. Try out the various endings. */ + *path = *sExt = NULL; + *sAvail = *oiAvail = oAvail = iAvail = FALSE; + *sSize = *oSize = *iSize = 0; + + if (combined) { + strcpy(searchBuf+nPath, DLL_ENDING); + if (readable(searchBuf)) { + oAvail = TRUE; + getFileInfo(searchBuf, &oTime, oSize); + } + strcpy(searchBuf+nPath, HI_ENDING); + if (readable(searchBuf)) { + iAvail = TRUE; + getFileInfo(searchBuf, &iTime, iSize); + } + if (oAvail && iAvail) { + *oiAvail = TRUE; + *oiTime = whicheverIsLater ( oTime, iTime ); + } + } + + strcpy(searchBuf+nPath, ".hs"); + if (readable(searchBuf)) { + *sAvail = TRUE; + literate = FALSE; + getFileInfo(searchBuf, sTime, sSize); + *sExt = ".hs"; + } else { + strcpy(searchBuf+nPath, ".lhs"); + if (readable(searchBuf)) { + *sAvail = TRUE; + literate = TRUE; + getFileInfo(searchBuf, sTime, sSize); + *sExt = ".lhs"; + } + } + + /* Success? */ + if (*sAvail || *oiAvail) { + nPath -= strlen(modName); + *path = malloc(nPath+1); + if (!(*path)) + internal("moduleNameToFileNames: malloc failed(1)"); + strncpy(*path, searchBuf, nPath); + (*path)[nPath] = 0; + free(augdPath); + return TRUE; + } + + } + +} + + +/* If the primaryObjectName is (eg) + /foo/bar/PrelSwamp.o + and the extraFileName is (eg) + swampy_cbits + and DLL_ENDING is set to .o + return + /foo/bar/swampy_cbits.o + and set *extraFileSize to its size, or -1 if not avail +*/ +String getExtraObjectInfo ( String primaryObjectName, + String extraFileName, + Int* extraFileSize ) +{ + Time xTime; + Long xSize; + String xtra; + + Int i = strlen(primaryObjectName)-1; + while (i >= 0 && primaryObjectName[i] != SLASH) i--; + if (i == -1) return extraFileName; + i++; + xtra = malloc ( i+3+strlen(extraFileName)+strlen(DLL_ENDING) ); + if (!xtra) internal("deriveExtraObjectName: malloc failed"); + strncpy ( xtra, primaryObjectName, i ); + xtra[i] = 0; + strcat ( xtra, extraFileName ); + strcat ( xtra, DLL_ENDING ); + + *extraFileSize = -1; + if (readable(xtra)) { + getFileInfo ( xtra, &xTime, &xSize ); + *extraFileSize = xSize; + } + return xtra; +} + + +/* -------------------------------------------------------------------------- * Substitute old value of path into empty entries in new path * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e" * ------------------------------------------------------------------------*/ -String substPath(new,sub) /* substitute sub path into new path*/ +static String local substPath ( String,String ); + +static String local substPath(new,sub) /* substitute sub path into new path*/ String new; String sub; { Bool substituted = FALSE; /* only allow one replacement */ @@ -439,32 +812,26 @@ String sub; { Bool gcMessages = FALSE; /* TRUE => print GC messages */ -Void gcStarted() { /* notify garbage collector start */ -#if HUGS_FOR_WINDOWS - SaveCursor = SetCursor(GarbageCursor); -#endif +Void gcStarted() { /* Notify garbage collector start */ if (gcMessages) { - printf("{{Gc"); + Printf("{{Gc"); FlushStdout(); } } -Void gcScanning() { /* notify garbage collector scans */ +Void gcScanning() { /* Notify garbage collector scans */ if (gcMessages) { Putchar(':'); FlushStdout(); } } -Void gcRecovered(recovered) /* notify garbage collection done */ +Void gcRecovered(recovered) /* Notify garbage collection done */ Int recovered; { if (gcMessages) { - printf("%d}}",recovered); - fflush(stdout); + Printf("%d}}",recovered); + FlushStdout(); } -#if HUGS_FOR_WINDOWS - SetCursor(SaveCursor); -#endif } Cell *CStackBase; /* Retain start of C control stack */ @@ -531,7 +898,7 @@ void gcCStack() { Void gcCStack() { /* Garbage collect elements off */ Cell stackTop = NIL; /* C stack */ Cell *ptr = &stackTop; -#if SIZEOF_INTP == 2 +#if SIZEOF_VOID_P == 2 if (((long)(ptr) - (long)(CStackBase))&1) fatal("gcCStack"); #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */ @@ -542,9 +909,16 @@ Void gcCStack() { /* Garbage collect elements off */ fatal("gcCStack"); #endif -#define StackGrowsDown while (ptr<=CStackBase) markWithoutMove(*ptr++) -#define StackGrowsUp while (ptr>=CStackBase) markWithoutMove(*ptr--) -#define GuessDirection if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown +#define Blargh mark(*ptr); +#if 0 + markWithoutMove((*ptr)/sizeof(Cell)); \ + markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \ + markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell)) +#endif + +#define StackGrowsDown { while (ptr<=CStackBase) { Blargh; ptr++; }; } +#define StackGrowsUp { while (ptr>=CStackBase) { Blargh; ptr--; }; } +#define GuessDirection if (ptr>CStackBase) StackGrowsUp else StackGrowsDown #if STACK_DIRECTION > 0 StackGrowsUp; @@ -554,7 +928,7 @@ Void gcCStack() { /* Garbage collect elements off */ GuessDirection; #endif -#if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */ +#if SIZEOF_VOID_P==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */ ptr = (Cell *)((long)(&stackTop) + 2); StackGrowsDown; #endif @@ -571,7 +945,7 @@ Void gcCStack() { /* Garbage collect elements off */ #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H) -/* This is believed to be redundant! ADR */ +/* grab the varargs prototype for ioctl */ #if HAVE_SYS_IOCTL_H # include #endif @@ -710,7 +1084,61 @@ Int readTerminalChar() { /* read character from terminal */ if (terminalEchoReqd) { return getchar(); } else { - Int c = getch(); +#if IS_WIN32 && !__BORLANDC__ + /* When reading a character from the console/terminal, we want + * to operate in 'raw' mode (to use old UNIX tty parlance) and have + * it return when a character is available and _not_ wait until + * the next time the user hits carriage return. On Windows platforms, + * this _can_ be done by reading directly from the console, using + * getch(). However, this doesn't sit well with programming + * environments such as Emacs which allow you to create sub-processes + * running Hugs, and then communicate with the running interpreter + * through its standard input and output handles. If you use getch() + * in that setting, you end up trying to read the (unused) console + * of the editor itself, through which not a lot of characters is + * bound to come out, since the editor communicates input to Hugs + * via the standard input handle. + * + * To avoid this rather unfortunate situation, we use the Win32 + * console API and re-jig the input properties of the standard + * input handle before trying to read a character using stdio's + * getchar(). + * + * The 'cost' of this solution is that it is Win32 specific and + * won't work with Windows 3.1 + it is kind of ugly and verbose + * to have to futz around with the console properties on a + * per-char basis. Both of these disadvantages aren't in my + * opinion fatal. + * + * -- sof 5/99 + */ + Int c; + DWORD mo; + HANDLE hIn; + + /* I don't quite understand why, but if the FILE*'s underlying file + descriptor is in text mode, we seem to lose the first carriage + return. + */ + setmode(fileno(stdin), _O_BINARY); + hIn = GetStdHandle(STD_INPUT_HANDLE); + GetConsoleMode(hIn, &mo); + SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT)); + /* + * On Win9x, the first time you change the mode (as above) a + * raw '\n' is inserted. Since enter maps to a raw '\r', and we + * map this (below) to '\n', we can just ignore all *raw* '\n's. + */ + do { + c = getc(stdin); + } while (c == '\n'); + + /* Same as it ever was - revert back state of stdin. */ + SetConsoleMode(hIn, mo); + setmode(fileno(stdin), _O_TEXT); +#else + Int c = getch(); +#endif return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */ } } @@ -721,47 +1149,11 @@ Int readTerminalChar() { /* read character from terminal */ * Interrupt handling: * ------------------------------------------------------------------------*/ -Bool broken = FALSE; -static Bool breakReqd = FALSE; -static sigProto(ignoreBreak); -static Void local installHandlers Args((Void)); - -Bool breakOn(reqd) /* set break trapping on if reqd, */ -Bool reqd; { /* or off otherwise, returning old */ - Bool old = breakReqd; - - breakReqd = reqd; - if (reqd) { - if (broken) { /* repond to break signal received */ - broken = FALSE; /* whilst break trap disabled */ - sigRaise(breakHandler); - } - ctrlbrk(ignoreBreak); - } else { - ctrlbrk(ignoreBreak); - } - return old; -} - -static sigHandler(ignoreBreak) { /* record but don't respond to break*/ - ctrlbrk(ignoreBreak); - broken = TRUE; - interruptStgRts(); - sigResume; -} - -#if !DONT_PANIC -static sigProto(panic); -static sigHandler(panic) { /* exit in a panic, on receipt of */ - everybody(EXIT); /* an unexpected signal */ - fprintf(stderr,"\nUnexpected signal\n"); - exit(1); - sigResume;/*NOTREACHED*/ -} -#endif /* !DONT_PANIC */ - -static Void local installHandlers() { /* Install handlers for all fatal */ +static Void installHandlers ( void ) { /* Install handlers for all fatal */ /* signals except SIGINT and SIGBREAK*/ +#if IS_WIN32 + /* SetConsoleCtrlHandler(consoleHandler,TRUE); */ +#endif #if !DONT_PANIC && !DOS # ifdef SIGABRT signal(SIGABRT,panic); @@ -794,7 +1186,7 @@ static Void local installHandlers() { /* Install handlers for all fatal */ * Shell escapes: * ------------------------------------------------------------------------*/ -Bool startEdit(line,nm) /* Start editor on file name at */ +static Bool local startEdit(line,nm) /* Start editor on file name at */ Int line; /* given line. Both name and line */ String nm; { /* or just line may be zero */ static char editorCmd[FILENAME_MAX+1]; @@ -812,7 +1204,7 @@ String nm; { /* or just line may be zero */ String ec = editorCmd; String rd = NULL; /* Set to nonnull to redo ... */ - for (; n>0 && *he && *he!=' '; n--) + for (; n>0 && *he && *he!=' ' && *he!='%'; n--) *ec++ = *he++; /* Copy editor name to buffer */ /* assuming filename ends at space */ @@ -949,123 +1341,19 @@ int snprintf(char* buffer, int count, const char* fmt, ...) { #endif /* HAVE_SNPRINTF */ /* -------------------------------------------------------------------------- - * Read/write values from/to the registry - * - * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or - * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if - * user entry doesn't exist). - * - * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key + * Things to do with the argv/argc and the env * ------------------------------------------------------------------------*/ -#if USE_REGISTRY - -#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\") - -static Bool local createKey Args((HKEY, PHKEY, REGSAM)); -static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD)); -static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD)); - -static Bool local createKey(hKey, phRootKey, samDesired) -HKEY hKey; -PHKEY phRootKey; -REGSAM samDesired; { - DWORD dwDisp; - return RegCreateKeyEx(hKey, HugsRoot, - 0, "", REG_OPTION_NON_VOLATILE, - samDesired, NULL, phRootKey, &dwDisp) - == ERROR_SUCCESS; -} - -static Bool local queryValue(hKey, var, type, buf, bufSize) -HKEY hKey; -String var; -LPDWORD type; -LPBYTE buf; -DWORD bufSize; { - HKEY hRootKey; - - if (!createKey(hKey, &hRootKey, KEY_READ)) { - return FALSE; - } else { - LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize); - RegCloseKey(hRootKey); - return (res == ERROR_SUCCESS); - } -} - -static Bool local setValue(hKey, var, type, buf, bufSize) -HKEY hKey; -String var; -DWORD type; -LPBYTE buf; -DWORD bufSize; { - HKEY hRootKey; - - if (!createKey(hKey, &hRootKey, KEY_WRITE)) { - return FALSE; - } else { - LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize); - RegCloseKey(hRootKey); - return (res == ERROR_SUCCESS); - } +int nh_argc ( void ) +{ + return prog_argc; } -String readRegString(var,def) /* read String from registry */ -String var; -String def; { - static char buf[300]; - DWORD type; - - if (queryValue(HKEY_CURRENT_USER, var, &type, buf, sizeof(buf)) - && type == REG_SZ) { - return (String)buf; - } else if (queryValue(HKEY_LOCAL_MACHINE, var, &type, buf, sizeof(buf)) - && type == REG_SZ) { - return (String)buf; - } else { - return NULL; - } -} - -Int readRegInt(var, def) /* read Int from registry */ -String var; -Int def; { - DWORD buf; - DWORD type; - - if (queryValue(HKEY_CURRENT_USER, var, &type, - (LPBYTE)&buf, sizeof(buf)) - && type == REG_DWORD) { - return (Int)buf; - } else if (queryValue(HKEY_LOCAL_MACHINE, var, &type, - (LPBYTE)&buf, sizeof(buf)) - && type == REG_DWORD) { - return (Int)buf; - } else { - return def; - } -} - -Bool writeRegString(var,val) /* write String to registry */ -String var; -String val; { - if (NULL == val) { - val = ""; - } - return setValue(HKEY_CURRENT_USER, var, - REG_SZ, (LPBYTE)val, lstrlen(val)+1); +int nh_argvb ( int argno, int offset ) +{ + return (int)(prog_argv[argno][offset]); } -Bool writeRegInt(var,val) /* write String to registry */ -String var; -Int val; { - return setValue(HKEY_CURRENT_USER, var, - REG_DWORD, (LPBYTE)&val, sizeof(val)); -} - -#endif /* USE_REGISTRY */ - /* -------------------------------------------------------------------------- * Machine dependent control: * ------------------------------------------------------------------------*/ @@ -1074,17 +1362,12 @@ Void machdep(what) /* Handle machine specific */ Int what; { /* initialisation etc.. */ switch (what) { case MARK : break; - case INSTALL : installHandlers(); + case POSTPREL: break; + case PREPREL : installHandlers(); break; case RESET : case BREAK : case EXIT : normalTerminal(); -#if HUGS_FOR_WINDOWS - if (what==EXIT) - DestroyWindow(hWndMain); - else - SetCursor(LoadCursor(NULL,IDC_ARROW)); -#endif break; } }