X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fmachdep.c;h=b5d9217440e329c08c52c9a3899896b39dfe72b4;hb=9b87106fe0cea58e7ffb5f7e2b01c63307f8e4f6;hp=19db38301907ee0f762677e5a8dccf7592f43d32;hpb=2358748547277698d9e36e290ff4de8f93e37892;p=ghc-hetmet.git diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index 19db383..b5d9217 100644 --- a/ghc/interpreter/machdep.c +++ b/ghc/interpreter/machdep.c @@ -13,8 +13,8 @@ * included in the distribution. * * $RCSfile: machdep.c,v $ - * $Revision: 1.25 $ - * $Date: 2000/04/03 17:27:10 $ + * $Revision: 1.32 $ + * $Date: 2000/05/26 10:14:33 $ * ------------------------------------------------------------------------*/ #ifdef HAVE_SIGNAL_H @@ -27,9 +27,13 @@ # include # endif #endif + +#if 0 #if HAVE_SYS_PARAM_H # include #endif +#endif + #ifdef HAVE_SYS_STAT_H # include #else @@ -95,31 +99,6 @@ int allow_break_count = 0; #endif /* -------------------------------------------------------------------------- - * Prototypes for registry reading - * ------------------------------------------------------------------------*/ - -#if USE_REGISTRY - -/* where have we hidden things in the registry? */ -#if HSCRIPT -#define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\") -#endif - -#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\") -#define ProjectRoot ("SOFTWARE\\Haskell\\Projects\\") - -static Bool local createKey ( HKEY, String, PHKEY, REGSAM ); -static Bool local queryValue ( HKEY, String, String, LPDWORD, LPBYTE, DWORD ); -static Bool local setValue ( HKEY, String, String, DWORD, LPBYTE, DWORD ); -static String local readRegString ( HKEY, String, String, String ); -static Int local readRegInt ( String,Int ); -static Bool local writeRegString ( String,String ); -static Bool local writeRegInt ( String,Int ); - -static String local readRegChildStrings ( HKEY, String, String, Char, String ); -#endif /* USE_REGISTRY */ - -/* -------------------------------------------------------------------------- * Find information about a file: * ------------------------------------------------------------------------*/ @@ -232,11 +211,12 @@ static Void local searchStr ( String ); static Bool local tryEndings ( String ); #if (DOS_FILENAMES || __CYGWIN32__) -# define SLASH '\\' +# define SLASH '/' +# define SLASH_STR "/" # define isSLASH(c) ((c)=='\\' || (c)=='/') # define PATHSEP ';' # define PATHSEP_STR ";" -# define DLL_ENDING ".dll" +# define DLL_ENDING ".u_o" #elif MAC_FILENAMES # define SLASH ':' # define isSLASH(c) ((c)==SLASH) @@ -246,6 +226,7 @@ static Bool local tryEndings ( String ); # define DLL_ENDING ".pef" #else # define SLASH '/' +# define SLASH_STR "/" # define isSLASH(c) ((c)==SLASH) # define PATHSEP ':' # define PATHSEP_STR ":" @@ -304,49 +285,6 @@ static String local hscriptDir() { /* Directory containing hscript.dll */ } #endif -#if 0 /* apparently unused */ -static String local RealPath(s) /* Find absolute pathname of file */ -String s; { -#if HAVE__FULLPATH /* eg DOS */ - static char path[FILENAME_MAX+1]; - _fullpath(path,s,FILENAME_MAX+1); -#elif HAVE_REALPATH /* eg Unix */ - static char path[MAXPATHLEN+1]; - realpath(s,path); -#else - static char path[FILENAME_MAX+1]; - strcpy(path,s); -#endif - return path; -} -#endif - - -static int local pathCmp(p1,p2) /* Compare paths after normalisation */ -String p1; -String p2; { -#if HAVE__FULLPATH /* eg DOS */ - static char path1[FILENAME_MAX+1]; - static char path2[FILENAME_MAX+1]; - _fullpath(path1,p1,FILENAME_MAX+1); - _fullpath(path2,p2,FILENAME_MAX+1); -#elif HAVE_REALPATH /* eg Unix */ - static char path1[MAXPATHLEN+1]; - static char path2[MAXPATHLEN+1]; - realpath(p1,path1); - realpath(p2,path2); -#else - static char path1[FILENAME_MAX+1]; - static char path2[FILENAME_MAX+1]; - strcpy(path1,p1); - strcpy(path2,p2); -#endif -#if CASE_INSENSITIVE_FILENAMES - strlwr(path1); - strlwr(path2); -#endif - return filenamecmp(path1,path2); -} static String local normPath(s) /* Try, as much as possible, to normalize */ String s; { /* a pathname in some appropriate manner. */ @@ -500,14 +438,6 @@ String along; /* Return NULL if file does not exist */ String nm; { /* AC, 1/21/99: modified to search hugsPath first, then projectPath */ String s = findMPathname(along,nm,hugsPath); -#if USE_REGISTRY -#if 0 - ToDo: - if (s==NULL) { - s = findMPathname(along,nm,projectPath); - } -#endif /* 0 */ -#endif /* USE_REGISTRY */ return s ? s : normPath(searchBuf); } @@ -624,9 +554,8 @@ Bool findFilesForModule ( String modName, String* path, String* sExt, - Bool* sAvail, Time* sTime, Long* sSize, - Bool* iAvail, Time* iTime, Long* iSize, - Bool* oAvail, Time* oTime, Long* oSize + Bool* sAvail, Time* sTime, Long* sSize, + Bool* oiAvail, Time* oiTime, Long* oSize, Long* iSize ) { /* Let the module name given be M. @@ -638,31 +567,36 @@ Bool findFilesForModule ( 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/GhcPrel:installDir/lib */ + String augdPath; /* .:hugsPath:installDir/../lib/std:installDir/lib */ + Time oTime, iTime; + Bool oAvail, iAvail; *path = *sExt = NULL; - *sAvail = *iAvail = *oAvail = FALSE; - *sSize = *iSize = *oSize = 0; + *sAvail = *oiAvail = oAvail = iAvail = FALSE; + *sSize = *oSize = *iSize = 0; augdPath = malloc( 2*(10+3+strlen(installDir)) - +strlen(hugsPath) +10/*paranoia*/); + +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, "GhcPrel"); + strcat(augdPath, ".."); + strcat(augdPath, SLASH_STR); + strcat(augdPath, "lib"); + strcat(augdPath, SLASH_STR); + strcat(augdPath, "std"); strcat(augdPath, PATHSEP_STR); } @@ -670,7 +604,14 @@ Bool findFilesForModule ( strcat(augdPath, "lib"); strcat(augdPath, PATHSEP_STR); - /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */ + /* these two were previously before the above `if' */ + strcat(augdPath, "."); + strcat(augdPath, PATHSEP_STR); + + strcat(augdPath, hugsPath); + strcat(augdPath, PATHSEP_STR); + + /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */ peEnd = augdPath-1; while (1) { @@ -701,21 +642,25 @@ Bool findFilesForModule ( nPath += strlen(modName); /* searchBuf now holds 'P/M'. Try out the various endings. */ - *path = *sExt = NULL; - *sAvail = *iAvail = *oAvail = FALSE; - *sSize = *iSize = *oSize = 0; + *path = *sExt = NULL; + *sAvail = *oiAvail = oAvail = iAvail = FALSE; + *sSize = *oSize = *iSize = 0; - strcpy(searchBuf+nPath, DLL_ENDING); - if (readable(searchBuf)) { - *oAvail = TRUE; - getFileInfo(searchBuf, oTime, oSize); - } - - strcpy(searchBuf+nPath, ".u_hi"); - if (readable(searchBuf)) { - *iAvail = TRUE; - *sExt = ".u_hi"; - getFileInfo(searchBuf, iTime, iSize); + 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"); @@ -735,7 +680,7 @@ Bool findFilesForModule ( } /* Success? */ - if (*sAvail || (*oAvail && *iAvail)) { + if (*sAvail || *oiAvail) { nPath -= strlen(modName); *path = malloc(nPath+1); if (!(*path)) @@ -927,7 +872,7 @@ Void gcCStack() { /* Garbage collect elements off */ fatal("gcCStack"); #endif -#define Blargh markWithoutMove(*ptr); +#define Blargh mark(*ptr); #if 0 markWithoutMove((*ptr)/sizeof(Cell)); \ markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \ @@ -958,212 +903,6 @@ Void gcCStack() { /* Garbage collect elements off */ #endif /* -------------------------------------------------------------------------- - * Terminal dependent stuff: - * ------------------------------------------------------------------------*/ - -#if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H) - -/* grab the varargs prototype for ioctl */ -#if HAVE_SYS_IOCTL_H -# include -#endif - -/* The order of these three tests is very important because - * some systems have more than one of the requisite header file - * but only one of them seems to work. - * Anyone changing the order of the tests should try enabling each of the - * three branches in turn and write down which ones work as well as which - * OS/compiler they're using. - * - * OS Compiler sgtty termio termios notes - * Linux 2.0.18 gcc 2.7.2 absent works works 1 - * - * Notes: - * 1) On Linux, termio.h just #includes termios.h and sgtty.h is - * implemented using termios.h. - * sgtty.h is in /usr/include/bsd which is not on my standard include - * path. Adding it does no harm but you might as well use termios. - * -- - * reid-alastair@cs.yale.edu - */ -#if HAVE_TERMIOS_H - -#include -typedef struct termios TermParams; -#define getTerminal(tp) tcgetattr(fileno(stdin), &tp) -#define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp) -#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \ - tp.c_cc[VMIN] = 1; \ - tp.c_cc[VTIME] = 0; - -#elif HAVE_SGTTY_H - -#include -typedef struct sgttyb TermParams; -#define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp) -#define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp) -#if HPUX -#define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO); -#else -#define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO); -#endif - -#elif HAVE_TERMIO_H - -#include -typedef struct termio TermParams; -#define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp) -#define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp) -#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \ - tp.c_cc[VMIN] = 1; \ - tp.c_cc[VTIME] = 0; - -#endif - -static Bool messedWithTerminal = FALSE; -static TermParams originalSettings; - -Void normalTerminal() { /* restore terminal initial state */ - if (messedWithTerminal) - setTerminal(originalSettings); -} - -Void noechoTerminal() { /* set terminal into noecho mode */ - TermParams settings; - - if (!messedWithTerminal) { - getTerminal(originalSettings); - messedWithTerminal = TRUE; - } - getTerminal(settings); - noEcho(settings); - setTerminal(settings); -} - -Int getTerminalWidth() { /* determine width of terminal */ -#ifdef TIOCGWINSZ -#ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/ -#include /* Required by sys/ptem.h */ -#include /* Required to declare winsize */ -#endif - static struct winsize terminalSize; - ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize); - return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col; -#else - return 80; -#endif -} - -Int readTerminalChar() { /* read character from terminal */ - return getchar(); /* without echo, assuming that */ -} /* noechoTerminal() is active... */ - -#elif SYMANTEC_C - -Int readTerminalChar() { /* read character from terminal */ - return getchar(); /* without echo, assuming that */ -} /* noechoTerminal() is active... */ - -Int getTerminalWidth() { - return console_options.ncols; -} - -Void normalTerminal() { - csetmode(C_ECHO, stdin); -} - -Void noechoTerminal() { - csetmode(C_NOECHO, stdin); -} - -#else /* no terminal driver - eg DOS, RISCOS */ - -static Bool terminalEchoReqd = TRUE; - -Int getTerminalWidth() { -#if RISCOS - int dummy, width; - (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width); - return width+1; -#else - return 80; -#endif -} - -Void normalTerminal() { /* restore terminal initial state */ - terminalEchoReqd = TRUE; -} - -Void noechoTerminal() { /* turn terminal echo on/off */ - terminalEchoReqd = FALSE; -} - -Int readTerminalChar() { /* read character from terminal */ - if (terminalEchoReqd) { - return getchar(); - } else { -#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 */ - } -} - -#endif /* no terminal driver */ - -/* -------------------------------------------------------------------------- * Interrupt handling: * ------------------------------------------------------------------------*/ @@ -1325,157 +1064,6 @@ int chdir(const char *s) { #endif -/*--------------------------------------------------------------------------- - * Printf-related operations: - *-------------------------------------------------------------------------*/ - -#if !defined(HAVE_VSNPRINTF) -int vsnprintf(buffer, count, fmt, ap) -char* buffer; -int count; -const char* fmt; -va_list ap; { -#if defined(HAVE__VSNPRINTF) - return _vsnprintf(buffer, count, fmt, ap); -#else - return 0; -#endif -} -#endif /* HAVE_VSNPRINTF */ - -#if !defined(HAVE_SNPRINTF) -int snprintf(char* buffer, int count, const char* fmt, ...) { -#if defined(HAVE__VSNPRINTF) - int r; - va_list ap; /* pointer into argument list */ - va_start(ap, fmt); /* make ap point to first arg after fmt */ - r = vsnprintf(buffer, count, fmt, ap); - va_end(ap); /* clean up */ - return r; -#else - return 0; -#endif -} -#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 - * ------------------------------------------------------------------------*/ - -#if USE_REGISTRY - -#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\") - -static Bool local createKey ( HKEY, PHKEY, REGSAM ); -static Bool local queryValue ( HKEY, String, LPDWORD, LPBYTE, DWORD ); -static Bool local setValue ( 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, regPath, var, type, buf, bufSize) -HKEY hKey; -String regPath; -String var; -LPDWORD type; -LPBYTE buf; -DWORD bufSize; { - HKEY hRootKey; - - if (!createKey(hKey, regPath, &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, regPath, var, type, buf, bufSize) -HKEY hKey; -String regPath; -String var; -DWORD type; -LPBYTE buf; -DWORD bufSize; { - HKEY hRootKey; - - if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) { - return FALSE; - } else { - LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize); - RegCloseKey(hRootKey); - return (res == ERROR_SUCCESS); - } -} - -static String local readRegString(key,regPath,var,def) /* read String from registry */ -HKEY key; -String regPath; -String var; -String def; { - static char buf[300]; - DWORD type; - if (queryValue(key, regPath,var, &type, buf, sizeof(buf)) - && type == REG_SZ) { - return (String)buf; - } else { - return def; - } -} - -static Int local readRegInt(var, def) /* read Int from registry */ -String var; -Int def; { - DWORD buf; - DWORD type; - - if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type, - (LPBYTE)&buf, sizeof(buf)) - && type == REG_DWORD) { - return (Int)buf; - } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type, - (LPBYTE)&buf, sizeof(buf)) - && type == REG_DWORD) { - return (Int)buf; - } else { - return def; - } -} - -static Bool local writeRegString(var,val) /* write String to registry */ -String var; -String val; { - if (NULL == val) { - val = ""; - } - return setValue(HKEY_CURRENT_USER, HugsRoot, var, - REG_SZ, (LPBYTE)val, lstrlen(val)+1); -} - -static Bool local writeRegInt(var,val) /* write String to registry */ -String var; -Int val; { - return setValue(HKEY_CURRENT_USER, HugsRoot, var, - REG_DWORD, (LPBYTE)&val, sizeof(val)); -} - -#endif /* USE_REGISTRY */ - /* -------------------------------------------------------------------------- * Things to do with the argv/argc and the env * ------------------------------------------------------------------------*/ @@ -1503,7 +1091,7 @@ Int what; { /* initialisation etc.. */ break; case RESET : case BREAK : - case EXIT : normalTerminal(); + case EXIT : break; } }