ghc/interpreter/machdep.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Machine dependent code
   4  * RISCOS specific code provided by Bryan Scatergood, JBS
   5  * Macintosh specific code provided by Hans Aberg (haberg@matematik.su.se)
   6  * HaskellScript code and recursive directory search provided by
   7  *  Daan Leijen (leijen@fwi.uva.nl)
   8  *
   9  * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
  10  * Haskell Group 1994-99, and is distributed as Open Source software
  11  * under the Artistic License; see the file "Artistic" that is included
  12  * in the distribution for details.
  13  *
  14  * $RCSfile: machdep.c,v $
  15  * $Revision: 1.6 $
  16  * $Date: 1999/06/07 17:22:37 $
  17  * ------------------------------------------------------------------------*/
  18
  19 #ifdef HAVE_SIGNAL_H
  20 # include <signal.h>
  21 #endif
  22 #ifdef HAVE_SYS_TYPES_H
  23 # include <sys/types.h>
  24 #else
  25 # ifdef HAVE_TYPES_H
  26 #  include <types.h>
  27 # endif
  28 #endif
  29 #if HAVE_SYS_PARAM_H
  30 # include <sys/param.h>
  31 #endif
  32 #ifdef HAVE_SYS_STAT_H
  33 # include <sys/stat.h>
  34 #else
  35 # ifdef HAVE_STAT_H
  36 #  include <stat.h>
  37 # endif
  38 #endif
  39 #ifdef HAVE_TIME_H
  40 # include <time.h>
  41 #endif
  42
  43 /* Windows/DOS include files */
  44 #ifdef HAVE_DOS_H
  45 # include <dos.h>
  46 #endif
  47 #if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS
  48 # include <conio.h>
  49 #endif
  50 #ifdef HAVE_IO_H
  51 # include <io.h>
  52 #endif
  53 #ifdef HAVE_STD_H
  54 # include <std.h>
  55 #endif
  56 #ifdef HAVE_WINDOWS_H
  57 # include <windows.h>
  58 #endif
  59
  60 #if HUGS_FOR_WINDOWS
  61 #include <dir.h>
  62 #include <mem.h>
  63
  64 extern HCURSOR HandCursor;            /* Forward references to cursors   */
  65 extern HCURSOR GarbageCursor;
  66 extern HCURSOR SaveCursor;
  67 static void    local DrawStatusLine     Args((HWND));
  68 #endif
  69
  70 #if DOS
  71 #include <mem.h>
  72 extern unsigned _stklen = 8000;         /* Allocate an 8k stack segment    */
  73 #endif
  74
  75 #if RISCOS
  76 #include "swis.h"
  77 #include "os.h"
  78 #endif
  79
  80 /* Macintosh include files */
  81 #ifdef HAVE_CONSOLE_H
  82 # include <console.h>
  83 #endif
  84 #ifdef HAVE_PASCAL_H
  85 # include <pascal.h>
  86 #endif
  87 #ifdef HAVE_FILES_H
  88 # include <Files.h>
  89 #endif
  90 #ifdef HAVE_FCNTL_H
  91 # include <fcntl.h>
  92 #endif
  93 #ifdef HAVE_ERRNO_H
  94 # include <errno.h>
  95 #endif
  96 #ifdef HAVE_STDLIB_H
  97 # include <stdlib.h>
  98 #endif
  99 #ifdef HAVE_UNIX_H
 100 #include <unix.h>
 101 #endif
 102
 103 /* --------------------------------------------------------------------------
 104  * Prototypes for registry reading
 105  * ------------------------------------------------------------------------*/
 106
 107 #if USE_REGISTRY
 108
 109 /* where have we hidden things in the registry? */
 110 #if HSCRIPT
 111 #define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\")
 112 #endif
 113
 114 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
 115 #define ProjectRoot ("SOFTWARE\\Haskell\\Hugs\\Projects\\")
 116
 117 static Bool   local createKey      Args((HKEY, String, PHKEY, REGSAM));
 118 static Bool   local queryValue     Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD));
 119 static Bool   local setValue       Args((HKEY, String, String, DWORD, LPBYTE, DWORD));
 120 static String local readRegString  Args((HKEY, String, String, String));
 121 static Int    local readRegInt     Args((String,Int));
 122 static Bool   local writeRegString Args((String,String));
 123 static Bool   local writeRegInt    Args((String,Int));
 124
 125 static String local readRegChildStrings Args((HKEY, String, String, Char, String));
 126 #endif /* USE_REGISTRY */
 127
 128 /* --------------------------------------------------------------------------
 129  * Find information about a file:
 130  * ------------------------------------------------------------------------*/
 131
 132 #if RISCOS
 133 typedef struct { unsigned hi, lo; } Time;
 134 #define timeChanged(now,thn)    (now.hi!=thn.hi || now.lo!=thn.lo)
 135 #define timeSet(var,tm)         var.hi = tm.hi; var.lo = tm.lo
 136 error  timeEarlier not defined
 137 #else
 138 typedef time_t Time;
 139 #define timeChanged(now,thn)      (now!=thn)
 140 #define timeSet(var,tm)           var = tm
 141 #define timeEarlier(earlier,now)  (earlier < now)
 142 #endif
 143
 144 static Bool local readable      Args((String));
 145 static Void local getFileInfo   Args((String, Time *, Long *));
 146
 147 static Void local getFileInfo(f,tm,sz)  /* find time stamp and size of file*/
 148 String f;
 149 Time   *tm;
 150 Long   *sz; {
 151 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
 152     struct stat scbuf;
 153     if (!stat(f,&scbuf)) {
 154         if (tm) *tm = scbuf.st_mtime;
 155         *sz = (Long)(scbuf.st_size);
 156     } else {
 157         if (tm) *tm = 0;
 158         *sz = 0;
 159     }
 160 #else                                   /* normally just use stat()        */
 161     os_regset r;                        /* RISCOS PRM p.850 and p.837      */
 162     r.r[0] = 17;                        /* Read catalogue, no path         */
 163     r.r[1] = (int)s;
 164     os_swi(OS_File, &r);
 165     if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
 166         if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte)        */
 167         if (tm) tm->lo = r.r[3];        /* Execution address (low 4 bytes) */
 168     } else {                            /* Not found, or not time-stamped  */
 169         if (tm) tm->hi = tm->lo = 0;
 170     }
 171     *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
 172 #endif
 173 }
 174
 175 Void getFileSize ( String f, Long* sz )
 176 {
 177    getFileInfo ( f, NULL, sz );
 178 }
 179
 180 #if defined HAVE_GETFINFO               /* Mac971031 */
 181 /* --------------------------------------------------------------------------
 182  * Define a MacOS version of access():
 183  *   If the file is not accessible, -1 is returned and errno is set to
 184  * the reason for the failure.
 185  *   If the file is accessible and the dummy is 0 (existence), 2 (write),
 186  * or 4 (read), the return is 0.
 187  *   If the file is accessible, and the dummy is 1 (executable), then if
 188  * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
 189  *   Warnings: Use with caution. UNIX access do no translate to Macs.
 190  * Check of write access is not implemented (same as read).
 191  * ------------------------------------------------------------------------*/
 192
 193 int access(char *fileName, int dummy) {
 194         FInfo   fi;
 195         short   rc;
 196
 197         errno = getfinfo(fileName, 0, &fi);
 198         if (errno != 0)  return -1;             /* Check file accessible. */
 199
 200         /* Cases dummy = existence, read, write. */
 201         if (dummy == 0 || dummy & 0x6)  return 0;
 202
 203         /* Case dummy = executable. */
 204         if (dummy == 1) {
 205                 if (fi.fdType == 'APPL')  return 0;
 206                 errno = fi.fdType;
 207                 return -1;
 208         }
 209
 210         return 0;
 211 }
 212 #endif
 213
 214 static Bool local readable(f)           /* is f a regular, readable file   */
 215 String f; {
 216 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
 217     return (0 == access(f,4));
 218 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
 219     struct stat scbuf;
 220     //fprintf(stderr, "readable: %s\n", f );
 221     return (  !stat(f,&scbuf)
 222            && (scbuf.st_mode & S_IREAD) /* readable     */
 223            && (scbuf.st_mode & S_IFREG) /* regular file */
 224            );
 225 #elif defined HAVE_OS_SWI /* RISCOS specific */
 226     os_regset r;                        /* RISCOS PRM p.850     -- JBS     */
 227     assert(dummy == 0);
 228     r.r[0] = 17; /* Read catalogue, no path */
 229     r.r[1] = (int)f;
 230     os_swi(OS_File, &r);
 231     return r.r[0] != 1; /* Does this check it's a regular file? ADR */
 232 #endif
 233 }
 234
 235
 236 /* --------------------------------------------------------------------------
 237  * Search for script files on the HUGS path:
 238  * ------------------------------------------------------------------------*/
 239
 240 static String local hugsdir       Args((Void));
 241 #if HSCRIPT
 242 static String local hscriptDir    Args((Void));
 243 #endif
 244 //static String local RealPath      Args((String));
 245 static int    local pathCmp       Args((String, String));
 246 static String local normPath      Args((String));
 247 static Void   local searchChr     Args((Int));
 248 static Void   local searchStr     Args((String));
 249 static Bool   local tryEndings    Args((String));
 250
 251 #if DOS_FILENAMES
 252 # define SLASH                   '\\'
 253 # define isSLASH(c)              ((c)=='\\' || (c)=='/')
 254 # define PATHSEP                 ';'
 255 # define DLL_ENDING              ".dll"
 256 #elif MAC_FILENAMES
 257 # define SLASH                   ':'
 258 # define isSLASH(c)              ((c)==SLASH)
 259 # define PATHSEP                 ';'
 260 /* Mac PEF (Preferred Executable Format) file */
 261 # define DLL_ENDING              ".pef"
 262 #else
 263 # define SLASH                   '/'
 264 # define isSLASH(c)              ((c)==SLASH)
 265 # define PATHSEP                 ':'
 266 # define DLL_ENDING              ".o"
 267 #endif
 268
 269 static String local hugsdir() {     /* directory containing lib/Prelude.hs */
 270 #if HSCRIPT
 271     /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
 272     static char dir[FILENAME_MAX+1] = "";
 273     if (dir[0] == '\0') { /* not initialised yet */
 274         String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
 275                                  HUGSDIR);
 276         if (s) {
 277             strcpy(dir,s);
 278         }
 279     }
 280     return dir;
 281 #elif HAVE_GETMODULEFILENAME && !DOS
 282     /* On Windows, we can find the binary we're running and it's
 283      * conventional to put the libraries in the same place.
 284      */
 285     static char dir[FILENAME_MAX+1] = "";
 286     if (dir[0] == '\0') { /* not initialised yet */
 287         String slash = 0;
 288         GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
 289         if (dir[0] == '\0') { /* GetModuleFileName must have failed */
 290             return HUGSDIR;
 291         }
 292         if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */
 293             *slash = '\0';
 294         }
 295     }
 296     return dir;
 297 #else
 298     /* On Unix systems, we can't find the binary we're running and
 299      * the libraries may not be installed near the binary anyway.
 300      * This forces us to use a hardwired path which is set at
 301      * configuration time (--datadir=...).
 302      */
 303     return HUGSDIR;
 304 #endif
 305 }
 306
 307 #if HSCRIPT
 308 static String local hscriptDir() {  /* directory containing ?? what Daan?  */
 309     static char dir[FILENAME_MAX+1] = "";
 310     if (dir[0] == '\0') { /* not initialised yet */
 311         String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
 312         if (s) {
 313             strcpy(dir,s);
 314         }
 315     }
 316     return dir;
 317 }
 318 #endif
 319
 320 #if 0  /* apparently unused */
 321 static String local RealPath(s)         /* Find absolute pathname of file  */
 322 String s; {
 323 #if HAVE__FULLPATH  /* eg DOS */
 324     static char path[FILENAME_MAX+1];
 325     _fullpath(path,s,FILENAME_MAX+1);
 326 #elif HAVE_REALPATH /* eg Unix */
 327     static char path[MAXPATHLEN+1];
 328     realpath(s,path);
 329 #else
 330     static char path[FILENAME_MAX+1];
 331     strcpy(path,s);
 332 #endif
 333     return path;
 334 }
 335 #endif
 336
 337
 338 static int local pathCmp(p1,p2)       /* Compare paths after normalisation */
 339 String p1;
 340 String p2; {
 341 #if HAVE__FULLPATH  /* eg DOS */
 342     static char path1[FILENAME_MAX+1];
 343     static char path2[FILENAME_MAX+1];
 344     _fullpath(path1,p1,FILENAME_MAX+1);
 345     _fullpath(path2,p2,FILENAME_MAX+1);
 346 #elif HAVE_REALPATH /* eg Unix */
 347     static char path1[MAXPATHLEN+1];
 348     static char path2[MAXPATHLEN+1];
 349     realpath(p1,path1);
 350     realpath(p2,path2);
 351 #else
 352     static char path1[FILENAME_MAX+1];
 353     static char path2[FILENAME_MAX+1];
 354     strcpy(path1,p1);
 355     strcpy(path2,p2);
 356 #endif
 357 #if CASE_INSENSITIVE_FILENAMES
 358     strlwr(path1);
 359     strlwr(path2);
 360 #endif
 361     return filenamecmp(path1,path2);
 362 }
 363
 364 static String local normPath(s) /* Try, as much as possible, to normalize  */
 365 String s; {                     /* a pathname in some appropriate manner.  */
 366 #if PATH_CANONICALIZATION
 367     String path = RealPath(s);
 368 #if CASE_INSENSITIVE_FILENAMES
 369     strlwr(path);                       /* and convert to lowercase        */
 370 #endif
 371     return path;
 372 #else /* ! PATH_CANONICALIZATION */
 373     return s;
 374 #endif /* ! PATH_CANONICALIZATION */
 375 }
 376
 377 #if HSCRIPT
 378 static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
 379 #else
 380 static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
 381 #endif
 382 static char   searchBuf[FILENAME_MAX+1];
 383 static Int    searchPos;
 384
 385 #define searchReset(n)          searchBuf[searchPos=(n)]='\0'
 386
 387 static Void local searchChr(c)  /* Add single character to search buffer   */
 388 Int c; {
 389     if (searchPos<FILENAME_MAX) {
 390         searchBuf[searchPos++] = (char)c;
 391         searchBuf[searchPos]   = '\0';
 392     }
 393 }
 394
 395 static Void local searchStr(s)  /* Add string to search buffer             */
 396 String s; {
 397     while (*s && searchPos<FILENAME_MAX)
 398         searchBuf[searchPos++] = *s++;
 399     searchBuf[searchPos] = '\0';
 400 }
 401
 402 static Bool local tryEndings(s) /* Try each of the listed endings          */
 403 String s; {
 404     Int i = 0;
 405     searchStr(s);
 406     for (; endings[i]; ++i) {
 407         Int save = searchPos;
 408         searchStr(endings[i]);
 409         if (readable(searchBuf))
 410             return TRUE;
 411         searchReset(save);
 412     }
 413     return FALSE;
 414 }
 415
 416
 417
 418 #if SEARCH_DIR
 419
 420 /* scandir, June 98 Daan Leijen
 421    searches the base directory and its direct subdirectories for a file
 422
 423    input: searchbuf contains SLASH terminated base directory
 424           argument s contains the (base) filename
 425    output: TRUE: searchBuf contains the full filename
 426            FALSE: searchBuf is garbage, file not found
 427 */
 428
 429
 430 #ifdef HAVE_WINDOWS_H
 431
 432 static Bool scanSubDirs(s)
 433 String s;
 434 {
 435     struct _finddata_t findInfo;
 436     long handle;
 437     int  save;
 438
 439     save = searchPos;
 440     /* is it in the current directory ? */
 441     if (tryEndings(s)) return TRUE;
 442
 443     searchReset(save);
 444     searchStr("*");
 445
 446     /* initiate the search */
 447     handle = _findfirst( searchBuf, &findInfo );
 448     if (handle==-1) { errno = 0; return FALSE; }
 449
 450     /* search all subdirectories */
 451     do {
 452         /* if we have a valid sub directory */
 453         if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
 454             (findInfo.name[0] != '.')) {
 455             searchReset(save);
 456             searchStr(findInfo.name);
 457             searchChr(SLASH);
 458             if (tryEndings(s)) {
 459                 return TRUE;
 460             }
 461         }
 462     } while (_findnext( handle, &findInfo ) == 0);
 463
 464     _findclose( handle );
 465     return FALSE;
 466 }
 467
 468 #elif defined(HAVE_FTW_H)
 469
 470 #include <ftw.h>
 471
 472 static char baseFile[FILENAME_MAX+1];
 473 static char basePath[FILENAME_MAX+1];
 474 static int  basePathLen;
 475
 476 static int scanitem( const char* path,
 477                      const struct stat* statinfo,
 478                      int info )
 479 {
 480     if (info == FTW_D) { /* is it a directory */
 481         searchReset(0);
 482         searchStr(path);
 483         searchChr(SLASH);
 484         if (tryEndings(baseFile)) {
 485             return 1;
 486         }
 487     }
 488     return 0;
 489 }
 490
 491 static Bool scanSubDirs(s)
 492 String s;
 493 {
 494     int r;
 495     strcpy(baseFile,s);
 496     strcpy(basePath,searchBuf);
 497     basePathLen = strlen(basePath);
 498
 499     /* is it in the current directory ? */
 500     if (tryEndings(s)) return TRUE;
 501
 502     /* otherwise scan the subdirectories */
 503     r = ftw( basePath, scanitem, 2 );
 504     errno = 0;
 505     return (r > 0);
 506 }
 507
 508 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
 509 #endif /* SEARCH_DIR */
 510
 511 String findPathname(along,nm)   /* Look for a file along specified path    */
 512 String along;                   /* Return NULL if file does not exist      */
 513 String nm; {
 514     /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
 515     String s = findMPathname(along,nm,hugsPath);
 516 #if USE_REGISTRY
 517 #if 0
 518  ToDo:
 519     if (s==NULL) {
 520         s = findMPathname(along,nm,projectPath);
 521     }
 522 #endif /* 0 */
 523 #endif /* USE_REGISTRY */
 524     return s ? s : normPath(searchBuf);
 525 }
 526
 527 /* AC, 1/21/99: modified to pass in path to search explicitly */
 528 String findMPathname(along,nm,path)/* Look for a file along specified path   */
 529 String along;                   /* If nonzero, a path prefix from along is */
 530 String nm;                      /* used as the first prefix in the search. */
 531 String path; {
 532     String pathpt = path;
 533
 534     searchReset(0);
 535     if (along) {                /* Was a path for an existing file given?  */
 536         Int last = (-1);
 537         Int i    = 0;
 538         for (; along[i]; i++) {
 539             searchChr(along[i]);
 540             if (isSLASH(along[i]))
 541                 last = i;
 542         }
 543         searchReset(last+1);
 544     }
 545     if (tryEndings(nm))
 546         return normPath(searchBuf);
 547
 548     if (pathpt && *pathpt) {    /* Otherwise, we look along the HUGSPATH   */
 549         Bool more = TRUE;
 550         do {
 551             Bool recurse = FALSE;   /* DL: shall we recurse ? */
 552             searchReset(0);
 553             if (*pathpt) {
 554                 if (*pathpt!=PATHSEP) {
 555                     /* Pre-define one MPW-style "shell-variable" */
 556                     if (strncmp(pathpt,"{Hugs}",6)==0) {
 557                         searchStr(hugsdir());
 558                         pathpt += 6;
 559                     }
 560 #if HSCRIPT
 561                     /* And another - we ought to generalise this stuff */
 562                     else if (strncmp(pathpt,"{HScript}",9)==0) {
 563                         searchStr(hscriptDir());
 564                         pathpt += 9;
 565                     }
 566 #endif
 567                     do {
 568                         searchChr(*pathpt++);
 569                     } while (*pathpt && *pathpt!=PATHSEP);
 570                     recurse = (pathpt[-1] == SLASH);
 571                     if (!recurse) {
 572                         searchChr(SLASH);
 573                     }
 574                 }
 575                 if (*pathpt==PATHSEP)
 576                     pathpt++;
 577                 else
 578                     more = FALSE;
 579             } else {
 580                 more = FALSE;
 581             }
 582 #if SEARCH_DIR
 583             if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
 584                 return normPath(searchBuf);
 585             }
 586 #else
 587             if (tryEndings(nm)) {
 588                 return normPath(searchBuf);
 589             }
 590 #endif
 591         } while (more);
 592     }
 593
 594     searchReset(0);  /* As a last resort, look for file in the current dir */
 595     return (tryEndings(nm) ? normPath(searchBuf) : 0);
 596 }
 597
 598 /* --------------------------------------------------------------------------
 599  * New path handling stuff for the Combined System (tm)
 600  * ------------------------------------------------------------------------*/
 601
 602 Bool findFilesForModule (
 603         String  modName,
 604         String* path,
 605         String* sExt,
 606         Bool* sAvail, Time* sTime, Long* sSize,
 607         Bool* iAvail, Time* iTime, Long* iSize,
 608         Bool* oAvail, Time* oTime, Long* oSize
 609      )
 610 {
 611    /* Let the module name given be M.
 612       For each path entry P,
 613         a  s(rc)       file will be P/M.hs or P/M.lhs
 614         an i(nterface) file will be P/M.hi
 615         an o(bject)    file will be P/M.o
 616       If there is a s file or (both i and o files)
 617         use P to fill in the path names.
 618       Otherwise, move on to the next path entry.
 619       If all path entries are exhausted, return False.
 620    */
 621    Int    nPath;
 622    Bool   literate;
 623    String peStart, peEnd;
 624    String augdPath;       /* . and then hugsPath */
 625
 626    *path = *sExt = NULL;
 627    *sAvail = *iAvail = *oAvail = FALSE;
 628    *sSize  = *iSize  = *oSize  = 0;
 629
 630    augdPath = malloc(3+strlen(hugsPath));
 631    if (!augdPath)
 632       internal("moduleNameToFileNames: malloc failed(2)");
 633    augdPath[0] = '.';
 634    augdPath[1] = PATHSEP;
 635    augdPath[2] = 0;
 636    strcat(augdPath,hugsPath);
 637
 638    peEnd = augdPath-1;
 639    while (1) {
 640       /* Advance peStart and peEnd very paranoically, giving up at
 641          the first sign of mutancy in the path string.
 642       */
 643       if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
 644       peStart = peEnd+1;
 645       peEnd = peStart;
 646       while (*peEnd && *peEnd != PATHSEP) peEnd++;
 647
 648       /* Now peStart .. peEnd-1 bracket the next path element. */
 649       nPath = peEnd-peStart;
 650       if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
 651          ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
 652                    hugsPath
 653          EEND;
 654          free(augdPath);
 655          return FALSE;
 656       }
 657
 658       strncpy(searchBuf, peStart, nPath);
 659       searchBuf[nPath] = 0;
 660       if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
 661          searchBuf[nPath++] = SLASH;
 662
 663       strcpy(searchBuf+nPath, modName);
 664       nPath += strlen(modName);
 665
 666       /* searchBuf now holds 'P/M'.  Try out the various endings. */
 667       *path = *sExt = NULL;
 668       *sAvail = *iAvail = *oAvail = FALSE;
 669       *sSize  = *iSize  = *oSize  = 0;
 670
 671       strcpy(searchBuf+nPath, DLL_ENDING);
 672       if (readable(searchBuf)) {
 673          *oAvail = TRUE;
 674          getFileInfo(searchBuf, oTime, oSize);
 675       }
 676
 677       strcpy(searchBuf+nPath, ".hi");
 678       if (readable(searchBuf)) {
 679          *iAvail = TRUE;
 680          getFileInfo(searchBuf, iTime, iSize);
 681       }
 682
 683       strcpy(searchBuf+nPath, ".hs");
 684       if (readable(searchBuf)) {
 685          *sAvail = TRUE;
 686          literate = FALSE;
 687          getFileInfo(searchBuf, sTime, sSize);
 688          *sExt = ".hs";
 689       } else {
 690          strcpy(searchBuf+nPath, ".lhs");
 691          if (readable(searchBuf)) {
 692             *sAvail = TRUE;
 693             literate = TRUE;
 694             getFileInfo(searchBuf, sTime, sSize);
 695             *sExt = ".lhs";
 696          }
 697       }
 698
 699       /* Success? */
 700       if (*sAvail || (*oAvail && *iAvail)) {
 701          nPath -= strlen(modName);
 702          *path = malloc(nPath+1);
 703          if (!(*path))
 704             internal("moduleNameToFileNames: malloc failed(1)");
 705          strncpy(*path, searchBuf, nPath);
 706          (*path)[nPath] = 0;
 707          free(augdPath);
 708          return TRUE;
 709       }
 710
 711    }
 712
 713 }
 714
 715
 716 /* --------------------------------------------------------------------------
 717  * Substitute old value of path into empty entries in new path
 718  * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
 719  * ------------------------------------------------------------------------*/
 720
 721 static String local substPath Args((String,String));
 722
 723 static String local substPath(new,sub) /* substitute sub path into new path*/
 724 String new;
 725 String sub; {
 726     Bool   substituted = FALSE;            /*   only allow one replacement */
 727     Int    maxlen      = strlen(sub) + strlen(new);    /* safe upper bound */
 728     String r = (String) malloc(maxlen+1);  /* result string                */
 729     String t = r;                          /* pointer into r               */
 730     String next = new;                     /* next uncopied char in new    */
 731     String start = next;                   /* start of last path component */
 732     if (r == 0) {
 733         ERRMSG(0) "String storage space exhausted"
 734         EEND;
 735     }
 736     do {
 737         if (*next == PATHSEP || *next == '\0') {
 738             if (!substituted && next == start) {
 739                 String s = sub;
 740                 for(; *s != '\0'; ++s) {
 741                     *t++ = *s;
 742                 }
 743                 substituted = TRUE;
 744             }
 745             start = next+1;
 746         }
 747     } while ((*t++ = *next++) != '\0');
 748     return r;
 749 }
 750
 751
 752 /* --------------------------------------------------------------------------
 753  * Garbage collection notification:
 754  * ------------------------------------------------------------------------*/
 755
 756 Bool gcMessages = FALSE;                /* TRUE => print GC messages       */
 757
 758 Void gcStarted() {                      /* Notify garbage collector start  */
 759 #if HUGS_FOR_WINDOWS
 760     SaveCursor = SetCursor(GarbageCursor);
 761 #endif
 762     if (gcMessages) {
 763         Printf("{{Gc");
 764         FlushStdout();
 765     }
 766 }
 767
 768 Void gcScanning() {                     /* Notify garbage collector scans  */
 769     if (gcMessages) {
 770         Putchar(':');
 771         FlushStdout();
 772     }
 773 }
 774
 775 Void gcRecovered(recovered)             /* Notify garbage collection done  */
 776 Int recovered; {
 777     if (gcMessages) {
 778         Printf("%d}}",recovered);
 779         FlushStdout();
 780     }
 781 #if HUGS_FOR_WINDOWS
 782     SetCursor(SaveCursor);
 783 #endif
 784 }
 785
 786 Cell *CStackBase;                       /* Retain start of C control stack */
 787
 788 #if RISCOS                              /* Stack traversal for RISCOS      */
 789
 790 /* Warning: The following code is specific to the Acorn ARM under RISCOS
 791    (and C4).  We must explicitly walk back through the stack frames, since
 792    the stack is extended from the heap. (see PRM pp. 1757).  gcCStack must
 793    not be modified, since the offset '5' assumes that only v1 is used inside
 794    this function. Hence we do all the real work in gcARM.
 795 */
 796
 797 #define spreg 13 /* C3 has SP=R13 */
 798
 799 #define previousFrame(fp)       ((int *)((fp)[-3]))
 800 #define programCounter(fp)      ((int *)((*(fp)-12) & ~0xFC000003))
 801 #define isSubSPSP(w)            (((w)&dontCare) == doCare)
 802 #define doCare                  (0xE24DD000)  /* SUB r13,r13,#0 */
 803 #define dontCare                (~0x00100FFF) /* S and # bits   */
 804 #define immediateArg(x)         ( ((x)&0xFF) << (((x)&0xF00)>>7) )
 805
 806 static void gcARM(int *fp) {
 807     int si = *programCounter(fp);       /* Save instruction indicates how */
 808                                         /* many registers in this frame   */
 809     int *regs = fp - 4;
 810     if (si & (1<<0)) markWithoutMove(*regs--);
 811     if (si & (1<<1)) markWithoutMove(*regs--);
 812     if (si & (1<<2)) markWithoutMove(*regs--);
 813     if (si & (1<<3)) markWithoutMove(*regs--);
 814     if (si & (1<<4)) markWithoutMove(*regs--);
 815     if (si & (1<<5)) markWithoutMove(*regs--);
 816     if (si & (1<<6)) markWithoutMove(*regs--);
 817     if (si & (1<<7)) markWithoutMove(*regs--);
 818     if (si & (1<<8)) markWithoutMove(*regs--);
 819     if (si & (1<<9)) markWithoutMove(*regs--);
 820     if (previousFrame(fp)) {
 821         /* The non-register stack space is for the previous frame is above
 822            this fp, and not below the previous fp, because of the way stack
 823            extension works. It seems the only way of discovering its size is
 824            finding the SUB sp, sp, #? instruction by walking through the code
 825            following the entry point.
 826         */
 827         int *oldpc = programCounter(previousFrame(fp));
 828         int fsize = 0, i;
 829         for(i = 1; i < 6; ++i)
 830             if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
 831         for(i=1; i<=fsize; ++i)
 832             markWithoutMove(fp[i]);
 833     }
 834 }
 835
 836 void gcCStack() {
 837     int dummy;
 838     int *fp = 5 + &dummy;
 839     while (fp) {
 840         gcARM(fp);
 841         fp = previousFrame(fp);
 842     }
 843 }
 844
 845 #else                   /* Garbage collection for standard stack machines  */
 846
 847 Void gcCStack() {                       /* Garbage collect elements off    */
 848     Cell stackTop = NIL;                /* C stack                         */
 849     Cell *ptr = &stackTop;
 850 #if SIZEOF_INTP == 2
 851     if (((long)(ptr) - (long)(CStackBase))&1)
 852         fatal("gcCStack");
 853 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 854     if (((long)(ptr) - (long)(CStackBase))&1)
 855         fatal("gcCStack");
 856 #else
 857     if (((long)(ptr) - (long)(CStackBase))&3)
 858         fatal("gcCStack");
 859 #endif
 860
 861 #define Blargh markWithoutMove(*ptr);
 862 #if 0
 863                markWithoutMove((*ptr)/sizeof(Cell)); \
 864                markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell));  \
 865                markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
 866 #endif
 867
 868 #define StackGrowsDown  { while (ptr<=CStackBase) { Blargh; ptr++; }; }
 869 #define StackGrowsUp    { while (ptr>=CStackBase) { Blargh; ptr--; }; }
 870 #define GuessDirection  if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
 871
 872 #if STACK_DIRECTION > 0
 873     StackGrowsUp;
 874 #elif STACK_DIRECTION < 0
 875     StackGrowsDown;
 876 #else
 877     GuessDirection;
 878 #endif
 879
 880 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 881     ptr = (Cell *)((long)(&stackTop) + 2);
 882     StackGrowsDown;
 883 #endif
 884
 885 #undef  StackGrowsDown
 886 #undef  StackGrowsUp
 887 #undef  GuessDirection
 888 }
 889 #endif
 890
 891 /* --------------------------------------------------------------------------
 892  * Terminal dependent stuff:
 893  * ------------------------------------------------------------------------*/
 894
 895 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
 896
 897 /* grab the varargs prototype for ioctl */
 898 #if HAVE_SYS_IOCTL_H
 899 # include <sys/ioctl.h>
 900 #endif
 901
 902 /* The order of these three tests is very important because
 903  * some systems have more than one of the requisite header file
 904  * but only one of them seems to work.
 905  * Anyone changing the order of the tests should try enabling each of the
 906  * three branches in turn and write down which ones work as well as which
 907  * OS/compiler they're using.
 908  *
 909  * OS            Compiler      sgtty     termio  termios   notes
 910  * Linux 2.0.18  gcc 2.7.2     absent    works   works     1
 911  *
 912  * Notes:
 913  * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
 914  *    implemented using termios.h.
 915  *    sgtty.h is in /usr/include/bsd which is not on my standard include
 916  *    path.  Adding it does no harm but you might as well use termios.
 917  *    --
 918  *    reid-alastair@cs.yale.edu
 919  */
 920 #if HAVE_TERMIOS_H
 921
 922 #include <termios.h>
 923 typedef  struct termios  TermParams;
 924 #define  getTerminal(tp) tcgetattr(fileno(stdin), &tp)
 925 #define  setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
 926 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 927                          tp.c_cc[VMIN]  = 1;                \
 928                          tp.c_cc[VTIME] = 0;
 929
 930 #elif HAVE_SGTTY_H
 931
 932 #include <sgtty.h>
 933 typedef  struct sgttyb   TermParams;
 934 #define  getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
 935 #define  setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
 936 #if HPUX
 937 #define  noEcho(tp)      tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
 938 #else
 939 #define  noEcho(tp)      tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
 940 #endif
 941
 942 #elif HAVE_TERMIO_H
 943
 944 #include <termio.h>
 945 typedef  struct termio   TermParams;
 946 #define  getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
 947 #define  setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
 948 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 949                          tp.c_cc[VMIN]  = 1;                \
 950                          tp.c_cc[VTIME] = 0;
 951
 952 #endif
 953
 954 static Bool messedWithTerminal = FALSE;
 955 static TermParams originalSettings;
 956
 957 Void normalTerminal() {                 /* restore terminal initial state  */
 958     if (messedWithTerminal)
 959         setTerminal(originalSettings);
 960 }
 961
 962 Void noechoTerminal() {                 /* set terminal into noecho mode   */
 963     TermParams settings;
 964
 965     if (!messedWithTerminal) {
 966         getTerminal(originalSettings);
 967         messedWithTerminal = TRUE;
 968     }
 969     getTerminal(settings);
 970     noEcho(settings);
 971     setTerminal(settings);
 972 }
 973
 974 Int getTerminalWidth() {                /* determine width of terminal     */
 975 #ifdef TIOCGWINSZ
 976 #ifdef _M_UNIX                          /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
 977 #include <sys/stream.h>                 /* Required by sys/ptem.h          */
 978 #include <sys/ptem.h>                   /* Required to declare winsize     */
 979 #endif
 980     static struct winsize terminalSize;
 981     ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
 982     return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
 983 #else
 984     return 80;
 985 #endif
 986 }
 987
 988 Int readTerminalChar() {                /* read character from terminal    */
 989     return getchar();                   /* without echo, assuming that     */
 990 }                                       /* noechoTerminal() is active...   */
 991
 992 #elif SYMANTEC_C
 993
 994 Int readTerminalChar() {                /* read character from terminal    */
 995     return getchar();                   /* without echo, assuming that     */
 996 }                                       /* noechoTerminal() is active...   */
 997
 998 Int getTerminalWidth() {
 999     return console_options.ncols;
1000 }
1001
1002 Void normalTerminal() {
1003     csetmode(C_ECHO, stdin);
1004 }
1005
1006 Void noechoTerminal() {
1007     csetmode(C_NOECHO, stdin);
1008 }
1009
1010 #else /* no terminal driver - eg DOS, RISCOS */
1011
1012 static Bool terminalEchoReqd = TRUE;
1013
1014 Int getTerminalWidth() {
1015 #if RISCOS
1016     int dummy, width;
1017     (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1018     return width+1;
1019 #else
1020     return 80;
1021 #endif
1022 }
1023
1024 Void normalTerminal() {                 /* restore terminal initial state  */
1025     terminalEchoReqd = TRUE;
1026 }
1027
1028 Void noechoTerminal() {                 /* turn terminal echo on/off       */
1029     terminalEchoReqd = FALSE;
1030 }
1031
1032 Int readTerminalChar() {                /* read character from terminal    */
1033     if (terminalEchoReqd) {
1034         return getchar();
1035     } else {
1036         Int c = getch();
1037         return c=='\r' ? '\n' : c;      /* slight paranoia about CR-LF    */
1038     }
1039 }
1040
1041 #endif /* no terminal driver */
1042
1043 /* --------------------------------------------------------------------------
1044  * Interrupt handling:
1045  * ------------------------------------------------------------------------*/
1046
1047 Bool    broken         = FALSE;
1048 static  Bool breakReqd = FALSE;
1049 static  sigProto(ignoreBreak);
1050 static  Void local installHandlers Args((Void));
1051
1052 Bool breakOn(reqd)                      /* set break trapping on if reqd,  */
1053 Bool reqd; {                            /* or off otherwise, returning old */
1054     Bool old  = breakReqd;
1055
1056     breakReqd = reqd;
1057     if (reqd) {
1058         if (broken) {                   /* repond to break signal received */
1059             broken = FALSE;             /* whilst break trap disabled      */
1060             sigRaise(breakHandler);
1061             /* not reached */
1062         }
1063 #if HANDLERS_CANT_LONGJMP
1064         ctrlbrk(ignoreBreak);
1065 #else
1066         ctrlbrk(breakHandler);
1067 #endif
1068     } else {
1069         ctrlbrk(ignoreBreak);
1070     }
1071     return old;
1072 }
1073
1074 static sigHandler(ignoreBreak) {        /* record but don't respond to break*/
1075     ctrlbrk(ignoreBreak);         /* reinstall signal handler               */
1076                                   /* redundant on BSD systems but essential */
1077                                   /* on POSIX and other systems             */
1078     broken = TRUE;
1079     interruptStgRts();
1080     sigResume;
1081 }
1082
1083 #if !DONT_PANIC
1084 static sigProto(panic);
1085 static sigHandler(panic) {              /* exit in a panic, on receipt of  */
1086     everybody(EXIT);                    /* an unexpected signal            */
1087     fprintf(stderr,"\nUnexpected signal\n");
1088     exit(1);
1089     sigResume;/*NOTREACHED*/
1090 }
1091 #endif /* !DONT_PANIC */
1092
1093 static Void local installHandlers() { /* Install handlers for all fatal    */
1094                                       /* signals except SIGINT and SIGBREAK*/
1095 #if !DONT_PANIC && !DOS
1096 # ifdef SIGABRT
1097     signal(SIGABRT,panic);
1098 # endif
1099 # ifdef SIGBUS
1100     signal(SIGBUS,panic);
1101 # endif
1102 # ifdef SIGFPE
1103     signal(SIGFPE,panic);
1104 # endif
1105 # ifdef SIGHUP
1106     signal(SIGHUP,panic);
1107 # endif
1108 # ifdef SIGILL
1109     signal(SIGILL,panic);
1110 # endif
1111 # ifdef SIGQUIT
1112     signal(SIGQUIT,panic);
1113 # endif
1114 # ifdef SIGSEGV
1115     signal(SIGSEGV,panic);
1116 # endif
1117 # ifdef SIGTERM
1118     signal(SIGTERM,panic);
1119 # endif
1120 #endif /* !DONT_PANIC && !DOS */
1121 }
1122
1123 /* --------------------------------------------------------------------------
1124  * Shell escapes:
1125  * ------------------------------------------------------------------------*/
1126
1127 static Bool local startEdit(line,nm)    /* Start editor on file name at    */
1128 Int    line;                            /* given line.  Both name and line */
1129 String nm; {                            /* or just line may be zero        */
1130     static char editorCmd[FILENAME_MAX+1];
1131
1132 #if !SYMANTEC_C
1133     if (hugsEdit && *hugsEdit) {        /* Check that editor configured    */
1134 #else
1135     /* On a Mac, files have creator information, telling which program
1136        to launch to, so an editor named to the empty string "" is often
1137        desirable. */
1138     if (hugsEdit) {        /* Check that editor configured    */
1139 #endif
1140         Int n     = FILENAME_MAX;
1141         String he = hugsEdit;
1142         String ec = editorCmd;
1143         String rd = NULL;               /* Set to nonnull to redo ...      */
1144
1145         for (; n>0 && *he && *he!=' '; n--)
1146             *ec++ = *he++;              /* Copy editor name to buffer      */
1147                                         /* assuming filename ends at space */
1148
1149         if (nm && line && n>1 && *he){  /* Name, line, and enough space    */
1150             rd = ec;                    /* save, in case we don't find name*/
1151             while (n>0 && *he) {
1152                 if (*he=='%') {
1153                     if (*++he=='d' && n>10) {
1154                         sprintf(ec,"%d",line);
1155                         he++;
1156                     }
1157                     else if (*he=='s' && (size_t)n>strlen(nm)) {
1158                         strcpy(ec,nm);
1159                         rd = NULL;
1160                         he++;
1161                     }
1162                     else if (*he=='%' && n>1) {
1163                         strcpy(ec,"%");
1164                         he++;
1165                     }
1166                     else                /* Ignore % char if not followed   */
1167                         *ec = '\0';     /* by one of d, s, or %,           */
1168                     for (; *ec && n>0; n--)
1169                         ec++;
1170                 }   /* ignore % followed by anything other than d, s, or % */
1171                 else {                  /* Copy other characters across    */
1172                     *ec++ = *he++;
1173                     n--;
1174                 }
1175             }
1176         }
1177         else
1178             line = 0;
1179
1180         if (rd) {                       /* If file name was not included   */
1181             ec   = rd;
1182             line = 0;
1183         }
1184
1185         if (nm && line==0 && n>1) {     /* Name, but no line ...           */
1186             *ec++ = ' ';
1187             for (; n>0 && *nm; n--)     /* ... just copy file name         */
1188                 *ec++ = *nm++;
1189         }
1190
1191         *ec = '\0';                     /* Add terminating null byte       */
1192     }
1193     else {
1194         ERRMSG(0) "Hugs is not configured to use an editor"
1195         EEND;
1196     }
1197
1198 #if HAVE_WINEXEC
1199     WinExec(editorCmd, SW_SHOW);
1200     return FALSE;
1201 #else
1202     if (shellEsc(editorCmd))
1203         Printf("Warning: Editor terminated abnormally\n");
1204     return TRUE;
1205 #endif
1206 }
1207
1208 Int shellEsc(s)                         /* run a shell command (or shell)  */
1209 String s; {
1210 #if HAVE_MACSYSTEM
1211     return macsystem(s);
1212 #else
1213 #if HAVE_BIN_SH
1214     if (s[0]=='\0') {
1215         s = fromEnv("SHELL","/bin/sh");
1216     }
1217 #endif
1218     return system(s);
1219 #endif
1220 }
1221
1222 #if RISCOS                              /* RISCOS also needs a chdir()     */
1223 int chdir(char *s) {                    /* RISCOS PRM p. 885    -- JBS     */
1224     return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1225 }
1226 #elif defined HAVE_PBHSETVOLSYNC        /* Macintosh */
1227 int chdir(const char *s) {
1228     char* str;
1229     WDPBRec wd;
1230     wd.ioCompletion = 0;
1231     str = (char*)malloc(strlen(s) + 1);
1232     if (str == 0) return -1;
1233     strcpy(str, s);
1234     wd.ioNamePtr = C2PStr(str);
1235     wd.ioVRefNum = 0;
1236     wd.ioWDDirID = 0;
1237     errno = PBHSetVolSync(&wd);
1238     free(str);
1239     if (errno == 0) {
1240         return 0;
1241     } else {
1242         return -1;
1243     }
1244 }
1245 #endif
1246
1247
1248 /*---------------------------------------------------------------------------
1249  * Printf-related operations:
1250  *-------------------------------------------------------------------------*/
1251
1252 #if !defined(HAVE_VSNPRINTF)
1253 int vsnprintf(buffer, count, fmt, ap)
1254 char*       buffer;
1255 int         count;
1256 const char* fmt;
1257 va_list     ap; {
1258 #if defined(HAVE__VSNPRINTF)
1259     return _vsnprintf(buffer, count, fmt, ap);
1260 #else
1261     return 0;
1262 #endif
1263 }
1264 #endif /* HAVE_VSNPRINTF */
1265
1266 #if !defined(HAVE_SNPRINTF)
1267 int snprintf(char* buffer, int count, const char* fmt, ...) {
1268 #if defined(HAVE__VSNPRINTF)
1269     int r;
1270     va_list ap;                    /* pointer into argument list           */
1271     va_start(ap, fmt);             /* make ap point to first arg after fmt */
1272     r = vsnprintf(buffer, count, fmt, ap);
1273     va_end(ap);                    /* clean up                             */
1274     return r;
1275 #else
1276     return 0;
1277 #endif
1278 }
1279 #endif /* HAVE_SNPRINTF */
1280
1281 /* --------------------------------------------------------------------------
1282  * Read/write values from/to the registry
1283  *
1284  * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1285  * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key.  (Machine entry is only used if
1286  * user entry doesn't exist).
1287  *
1288  * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1289  * ------------------------------------------------------------------------*/
1290
1291 #if USE_REGISTRY
1292
1293 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1294
1295 static Bool   local createKey      Args((HKEY, PHKEY, REGSAM));
1296 static Bool   local queryValue     Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1297 static Bool   local setValue       Args((HKEY, String, DWORD, LPBYTE, DWORD));
1298
1299 static Bool local createKey(hKey, phRootKey, samDesired)
1300 HKEY    hKey;
1301 PHKEY   phRootKey;
1302 REGSAM  samDesired; {
1303     DWORD  dwDisp;
1304     return RegCreateKeyEx(hKey, HugsRoot,
1305                           0, "", REG_OPTION_NON_VOLATILE,
1306                           samDesired, NULL, phRootKey, &dwDisp)
1307            == ERROR_SUCCESS;
1308 }
1309
1310 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1311 HKEY    hKey;
1312 String  regPath;
1313 String  var;
1314 LPDWORD type;
1315 LPBYTE  buf;
1316 DWORD   bufSize; {
1317     HKEY hRootKey;
1318
1319     if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1320         return FALSE;
1321     } else {
1322         LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1323         RegCloseKey(hRootKey);
1324         return (res == ERROR_SUCCESS);
1325     }
1326 }
1327
1328 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1329 HKEY   hKey;
1330 String regPath;
1331 String var;
1332 DWORD  type;
1333 LPBYTE buf;
1334 DWORD  bufSize; {
1335     HKEY hRootKey;
1336
1337     if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1338         return FALSE;
1339     } else {
1340         LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1341         RegCloseKey(hRootKey);
1342         return (res == ERROR_SUCCESS);
1343     }
1344 }
1345
1346 static String local readRegString(key,regPath,var,def) /* read String from registry */
1347 HKEY   key;
1348 String regPath;
1349 String var;
1350 String def; {
1351     static char  buf[300];
1352     DWORD type;
1353     if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1354         && type == REG_SZ) {
1355         return (String)buf;
1356     } else {
1357         return def;
1358     }
1359 }
1360
1361 static Int local readRegInt(var, def)            /* read Int from registry */
1362 String var;
1363 Int    def; {
1364     DWORD buf;
1365     DWORD type;
1366
1367     if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1368                    (LPBYTE)&buf, sizeof(buf))
1369         && type == REG_DWORD) {
1370         return (Int)buf;
1371     } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1372                           (LPBYTE)&buf, sizeof(buf))
1373                && type == REG_DWORD) {
1374         return (Int)buf;
1375     } else {
1376         return def;
1377     }
1378 }
1379
1380 static Bool local writeRegString(var,val)      /* write String to registry */
1381 String var;
1382 String val; {
1383     if (NULL == val) {
1384         val = "";
1385     }
1386     return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1387                     REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1388 }
1389
1390 static Bool local writeRegInt(var,val)         /* write String to registry */
1391 String var;
1392 Int    val; {
1393     return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1394                     REG_DWORD, (LPBYTE)&val, sizeof(val));
1395 }
1396
1397 #endif /* USE_REGISTRY */
1398
1399 /* --------------------------------------------------------------------------
1400  * Machine dependent control:
1401  * ------------------------------------------------------------------------*/
1402
1403 Void machdep(what)                      /* Handle machine specific         */
1404 Int what; {                             /* initialisation etc..            */
1405     switch (what) {
1406         case MARK    : break;
1407         case INSTALL : installHandlers();
1408                        break;
1409         case RESET   :
1410         case BREAK   :
1411         case EXIT    : normalTerminal();
1412 #if HUGS_FOR_WINDOWS
1413                        if (what==EXIT)
1414                            DestroyWindow(hWndMain);
1415                        else
1416                            SetCursor(LoadCursor(NULL,IDC_ARROW));
1417 #endif
1418                        break;
1419     }
1420 }
1421
1422 /*-------------------------------------------------------------------------*/