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