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