X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fmachdep.c;h=c24076e8bad912247718d491651797d6a7cb7c3e;hb=0826d0137d24268cdfb3375eb1ddc3f7035b7a41;hp=2ca510208edf15580807f3960caa1d09c6899d88;hpb=528a7d2cf1c90408d60028bb1fec85124d539476;p=ghc-hetmet.git diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index 2ca5102..c24076e 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.23 $ - * $Date: 2000/03/24 14:32:03 $ + * $Revision: 1.29 $ + * $Date: 2000/04/10 15:39:09 $ * ------------------------------------------------------------------------*/ #ifdef HAVE_SIGNAL_H @@ -95,31 +95,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: * ------------------------------------------------------------------------*/ @@ -233,6 +208,7 @@ static Bool local tryEndings ( String ); #if (DOS_FILENAMES || __CYGWIN32__) # define SLASH '\\' +# define SLASH_STR "\\" # define isSLASH(c) ((c)=='\\' || (c)=='/') # define PATHSEP ';' # define PATHSEP_STR ";" @@ -246,6 +222,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 ":" @@ -500,14 +477,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 +593,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,18 +606,24 @@ 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)"); @@ -662,7 +636,11 @@ Bool findFilesForModule ( 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 +648,7 @@ Bool findFilesForModule ( strcat(augdPath, "lib"); strcat(augdPath, PATHSEP_STR); - /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */ + /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */ peEnd = augdPath-1; while (1) { @@ -701,20 +679,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; - 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"); @@ -734,7 +717,7 @@ Bool findFilesForModule ( } /* Success? */ - if (*sAvail || (*oAvail && *iAvail)) { + if (*sAvail || *oiAvail) { nPath -= strlen(modName); *path = malloc(nPath+1); if (!(*path)) @@ -926,7 +909,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)); \ @@ -1169,7 +1152,7 @@ Int readTerminalChar() { /* read character from terminal */ static Void installHandlers ( void ) { /* Install handlers for all fatal */ /* signals except SIGINT and SIGBREAK*/ #if IS_WIN32 - SetConsoleCtrlHandler(consoleHandler,TRUE); + /* SetConsoleCtrlHandler(consoleHandler,TRUE); */ #endif #if !DONT_PANIC && !DOS # ifdef SIGABRT @@ -1358,124 +1341,6 @@ 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 - * ------------------------------------------------------------------------*/ - -#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 * ------------------------------------------------------------------------*/