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.13 $
  17  * $Date: 1999/11/24 17:32:41 $
  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 #define N_DEFAULT_LIBDIR 1000
 608 char defaultLibDir[N_DEFAULT_LIBDIR];
 609
 610 /* Assumes that getcwd()++argv[0] is the absolute path to the
 611    executable.  Basically wrong.
 612 */
 613 void setDefaultLibDir ( String argv_0 )
 614 {
 615    int i;
 616    if (argv_0[0] != SLASH) {
 617       if (!getcwd(defaultLibDir,N_DEFAULT_LIBDIR-strlen(argv_0)-10)) {
 618          ERRMSG(0) "Can't get current working directory"
 619          EEND;
 620       }
 621       i = strlen(defaultLibDir);
 622       if (defaultLibDir[i-1] != SLASH) defaultLibDir[i++] = SLASH;
 623    } else {
 624       i = 0;
 625    }
 626    strcpy(&defaultLibDir[i],argv_0);
 627    i += strlen(argv_0);
 628    while (defaultLibDir[i] != SLASH) i--;
 629    i++;
 630    strcpy(&defaultLibDir[i], "lib");
 631    /* fprintf ( stderr, "default lib dir = %s\n", defaultLibDir );  */
 632 }
 633
 634 Bool findFilesForModule (
 635         String  modName,
 636         String* path,
 637         String* sExt,
 638         Bool* sAvail, Time* sTime, Long* sSize,
 639         Bool* iAvail, Time* iTime, Long* iSize,
 640         Bool* oAvail, Time* oTime, Long* oSize
 641      )
 642 {
 643    /* Let the module name given be M.
 644       For each path entry P,
 645         a  s(rc)       file will be P/M.hs or P/M.lhs
 646         an i(nterface) file will be P/M.hi
 647         an o(bject)    file will be P/M.o
 648       If there is a s file or (both i and o files)
 649         use P to fill in the path names.
 650       Otherwise, move on to the next path entry.
 651       If all path entries are exhausted, return False.
 652    */
 653    Int    nPath;
 654    Bool   literate;
 655    String peStart, peEnd;
 656    String augdPath;       /* .:hugsPath:defaultLibDir */
 657
 658    *path = *sExt = NULL;
 659    *sAvail = *iAvail = *oAvail = FALSE;
 660    *sSize  = *iSize  = *oSize  = 0;
 661
 662    augdPath = malloc(4+strlen(defaultLibDir)+strlen(hugsPath));
 663    if (!augdPath)
 664       internal("moduleNameToFileNames: malloc failed(2)");
 665    augdPath[0] = '.';
 666    augdPath[1] = PATHSEP;
 667    augdPath[2] = 0;
 668    strcat ( augdPath, hugsPath );
 669    augdPath[2+strlen(hugsPath)] = PATHSEP;
 670    augdPath[3+strlen(hugsPath)] = 0;
 671    strcat(augdPath,defaultLibDir);
 672
 673    peEnd = augdPath-1;
 674    while (1) {
 675       /* Advance peStart and peEnd very paranoically, giving up at
 676          the first sign of mutancy in the path string.
 677       */
 678       if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
 679       peStart = peEnd+1;
 680       peEnd = peStart;
 681       while (*peEnd && *peEnd != PATHSEP) peEnd++;
 682
 683       /* Now peStart .. peEnd-1 bracket the next path element. */
 684       nPath = peEnd-peStart;
 685       if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
 686          ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
 687                    hugsPath
 688          EEND;
 689          free(augdPath);
 690          return FALSE;
 691       }
 692
 693       strncpy(searchBuf, peStart, nPath);
 694       searchBuf[nPath] = 0;
 695       if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
 696          searchBuf[nPath++] = SLASH;
 697
 698       strcpy(searchBuf+nPath, modName);
 699       nPath += strlen(modName);
 700
 701       /* searchBuf now holds 'P/M'.  Try out the various endings. */
 702       *path = *sExt = NULL;
 703       *sAvail = *iAvail = *oAvail = FALSE;
 704       *sSize  = *iSize  = *oSize  = 0;
 705
 706       strcpy(searchBuf+nPath, DLL_ENDING);
 707       if (readable(searchBuf)) {
 708          *oAvail = TRUE;
 709          getFileInfo(searchBuf, oTime, oSize);
 710       }
 711
 712       strcpy(searchBuf+nPath, ".hi");
 713       if (readable(searchBuf)) {
 714          *iAvail = TRUE;
 715          getFileInfo(searchBuf, iTime, iSize);
 716       }
 717
 718       strcpy(searchBuf+nPath, ".hs");
 719       if (readable(searchBuf)) {
 720          *sAvail = TRUE;
 721          literate = FALSE;
 722          getFileInfo(searchBuf, sTime, sSize);
 723          *sExt = ".hs";
 724       } else {
 725          strcpy(searchBuf+nPath, ".lhs");
 726          if (readable(searchBuf)) {
 727             *sAvail = TRUE;
 728             literate = TRUE;
 729             getFileInfo(searchBuf, sTime, sSize);
 730             *sExt = ".lhs";
 731          }
 732       }
 733
 734       /* Success? */
 735       if (*sAvail || (*oAvail && *iAvail)) {
 736          nPath -= strlen(modName);
 737          *path = malloc(nPath+1);
 738          if (!(*path))
 739             internal("moduleNameToFileNames: malloc failed(1)");
 740          strncpy(*path, searchBuf, nPath);
 741          (*path)[nPath] = 0;
 742          free(augdPath);
 743          return TRUE;
 744       }
 745
 746    }
 747
 748 }
 749
 750
 751 /* --------------------------------------------------------------------------
 752  * Substitute old value of path into empty entries in new path
 753  * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
 754  * ------------------------------------------------------------------------*/
 755
 756 static String local substPath Args((String,String));
 757
 758 static String local substPath(new,sub) /* substitute sub path into new path*/
 759 String new;
 760 String sub; {
 761     Bool   substituted = FALSE;            /*   only allow one replacement */
 762     Int    maxlen      = strlen(sub) + strlen(new);    /* safe upper bound */
 763     String r = (String) malloc(maxlen+1);  /* result string                */
 764     String t = r;                          /* pointer into r               */
 765     String next = new;                     /* next uncopied char in new    */
 766     String start = next;                   /* start of last path component */
 767     if (r == 0) {
 768         ERRMSG(0) "String storage space exhausted"
 769         EEND;
 770     }
 771     do {
 772         if (*next == PATHSEP || *next == '\0') {
 773             if (!substituted && next == start) {
 774                 String s = sub;
 775                 for(; *s != '\0'; ++s) {
 776                     *t++ = *s;
 777                 }
 778                 substituted = TRUE;
 779             }
 780             start = next+1;
 781         }
 782     } while ((*t++ = *next++) != '\0');
 783     return r;
 784 }
 785
 786
 787 /* --------------------------------------------------------------------------
 788  * Garbage collection notification:
 789  * ------------------------------------------------------------------------*/
 790
 791 Bool gcMessages = FALSE;                /* TRUE => print GC messages       */
 792
 793 Void gcStarted() {                      /* Notify garbage collector start  */
 794 #if HUGS_FOR_WINDOWS
 795     SaveCursor = SetCursor(GarbageCursor);
 796 #endif
 797     if (gcMessages) {
 798         Printf("{{Gc");
 799         FlushStdout();
 800     }
 801 }
 802
 803 Void gcScanning() {                     /* Notify garbage collector scans  */
 804     if (gcMessages) {
 805         Putchar(':');
 806         FlushStdout();
 807     }
 808 }
 809
 810 Void gcRecovered(recovered)             /* Notify garbage collection done  */
 811 Int recovered; {
 812     if (gcMessages) {
 813         Printf("%d}}",recovered);
 814         FlushStdout();
 815     }
 816 #if HUGS_FOR_WINDOWS
 817     SetCursor(SaveCursor);
 818 #endif
 819 }
 820
 821 Cell *CStackBase;                       /* Retain start of C control stack */
 822
 823 #if RISCOS                              /* Stack traversal for RISCOS      */
 824
 825 /* Warning: The following code is specific to the Acorn ARM under RISCOS
 826    (and C4).  We must explicitly walk back through the stack frames, since
 827    the stack is extended from the heap. (see PRM pp. 1757).  gcCStack must
 828    not be modified, since the offset '5' assumes that only v1 is used inside
 829    this function. Hence we do all the real work in gcARM.
 830 */
 831
 832 #define spreg 13 /* C3 has SP=R13 */
 833
 834 #define previousFrame(fp)       ((int *)((fp)[-3]))
 835 #define programCounter(fp)      ((int *)((*(fp)-12) & ~0xFC000003))
 836 #define isSubSPSP(w)            (((w)&dontCare) == doCare)
 837 #define doCare                  (0xE24DD000)  /* SUB r13,r13,#0 */
 838 #define dontCare                (~0x00100FFF) /* S and # bits   */
 839 #define immediateArg(x)         ( ((x)&0xFF) << (((x)&0xF00)>>7) )
 840
 841 static void gcARM(int *fp) {
 842     int si = *programCounter(fp);       /* Save instruction indicates how */
 843                                         /* many registers in this frame   */
 844     int *regs = fp - 4;
 845     if (si & (1<<0)) markWithoutMove(*regs--);
 846     if (si & (1<<1)) markWithoutMove(*regs--);
 847     if (si & (1<<2)) markWithoutMove(*regs--);
 848     if (si & (1<<3)) markWithoutMove(*regs--);
 849     if (si & (1<<4)) markWithoutMove(*regs--);
 850     if (si & (1<<5)) markWithoutMove(*regs--);
 851     if (si & (1<<6)) markWithoutMove(*regs--);
 852     if (si & (1<<7)) markWithoutMove(*regs--);
 853     if (si & (1<<8)) markWithoutMove(*regs--);
 854     if (si & (1<<9)) markWithoutMove(*regs--);
 855     if (previousFrame(fp)) {
 856         /* The non-register stack space is for the previous frame is above
 857            this fp, and not below the previous fp, because of the way stack
 858            extension works. It seems the only way of discovering its size is
 859            finding the SUB sp, sp, #? instruction by walking through the code
 860            following the entry point.
 861         */
 862         int *oldpc = programCounter(previousFrame(fp));
 863         int fsize = 0, i;
 864         for(i = 1; i < 6; ++i)
 865             if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
 866         for(i=1; i<=fsize; ++i)
 867             markWithoutMove(fp[i]);
 868     }
 869 }
 870
 871 void gcCStack() {
 872     int dummy;
 873     int *fp = 5 + &dummy;
 874     while (fp) {
 875         gcARM(fp);
 876         fp = previousFrame(fp);
 877     }
 878 }
 879
 880 #else                   /* Garbage collection for standard stack machines  */
 881
 882 Void gcCStack() {                       /* Garbage collect elements off    */
 883     Cell stackTop = NIL;                /* C stack                         */
 884     Cell *ptr = &stackTop;
 885 #if SIZEOF_INTP == 2
 886     if (((long)(ptr) - (long)(CStackBase))&1)
 887         fatal("gcCStack");
 888 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 889     if (((long)(ptr) - (long)(CStackBase))&1)
 890         fatal("gcCStack");
 891 #else
 892     if (((long)(ptr) - (long)(CStackBase))&3)
 893         fatal("gcCStack");
 894 #endif
 895
 896 #define Blargh markWithoutMove(*ptr);
 897 #if 0
 898                markWithoutMove((*ptr)/sizeof(Cell)); \
 899                markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell));  \
 900                markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
 901 #endif
 902
 903 #define StackGrowsDown  { while (ptr<=CStackBase) { Blargh; ptr++; }; }
 904 #define StackGrowsUp    { while (ptr>=CStackBase) { Blargh; ptr--; }; }
 905 #define GuessDirection  if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
 906
 907 #if STACK_DIRECTION > 0
 908     StackGrowsUp;
 909 #elif STACK_DIRECTION < 0
 910     StackGrowsDown;
 911 #else
 912     GuessDirection;
 913 #endif
 914
 915 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 916     ptr = (Cell *)((long)(&stackTop) + 2);
 917     StackGrowsDown;
 918 #endif
 919
 920 #undef  StackGrowsDown
 921 #undef  StackGrowsUp
 922 #undef  GuessDirection
 923 }
 924 #endif
 925
 926 /* --------------------------------------------------------------------------
 927  * Terminal dependent stuff:
 928  * ------------------------------------------------------------------------*/
 929
 930 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
 931
 932 /* grab the varargs prototype for ioctl */
 933 #if HAVE_SYS_IOCTL_H
 934 # include <sys/ioctl.h>
 935 #endif
 936
 937 /* The order of these three tests is very important because
 938  * some systems have more than one of the requisite header file
 939  * but only one of them seems to work.
 940  * Anyone changing the order of the tests should try enabling each of the
 941  * three branches in turn and write down which ones work as well as which
 942  * OS/compiler they're using.
 943  *
 944  * OS            Compiler      sgtty     termio  termios   notes
 945  * Linux 2.0.18  gcc 2.7.2     absent    works   works     1
 946  *
 947  * Notes:
 948  * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
 949  *    implemented using termios.h.
 950  *    sgtty.h is in /usr/include/bsd which is not on my standard include
 951  *    path.  Adding it does no harm but you might as well use termios.
 952  *    --
 953  *    reid-alastair@cs.yale.edu
 954  */
 955 #if HAVE_TERMIOS_H
 956
 957 #include <termios.h>
 958 typedef  struct termios  TermParams;
 959 #define  getTerminal(tp) tcgetattr(fileno(stdin), &tp)
 960 #define  setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
 961 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 962                          tp.c_cc[VMIN]  = 1;                \
 963                          tp.c_cc[VTIME] = 0;
 964
 965 #elif HAVE_SGTTY_H
 966
 967 #include <sgtty.h>
 968 typedef  struct sgttyb   TermParams;
 969 #define  getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
 970 #define  setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
 971 #if HPUX
 972 #define  noEcho(tp)      tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
 973 #else
 974 #define  noEcho(tp)      tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
 975 #endif
 976
 977 #elif HAVE_TERMIO_H
 978
 979 #include <termio.h>
 980 typedef  struct termio   TermParams;
 981 #define  getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
 982 #define  setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
 983 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 984                          tp.c_cc[VMIN]  = 1;                \
 985                          tp.c_cc[VTIME] = 0;
 986
 987 #endif
 988
 989 static Bool messedWithTerminal = FALSE;
 990 static TermParams originalSettings;
 991
 992 Void normalTerminal() {                 /* restore terminal initial state  */
 993     if (messedWithTerminal)
 994         setTerminal(originalSettings);
 995 }
 996
 997 Void noechoTerminal() {                 /* set terminal into noecho mode   */
 998     TermParams settings;
 999
1000     if (!messedWithTerminal) {
1001         getTerminal(originalSettings);
1002         messedWithTerminal = TRUE;
1003     }
1004     getTerminal(settings);
1005     noEcho(settings);
1006     setTerminal(settings);
1007 }
1008
1009 Int getTerminalWidth() {                /* determine width of terminal     */
1010 #ifdef TIOCGWINSZ
1011 #ifdef _M_UNIX                          /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
1012 #include <sys/stream.h>                 /* Required by sys/ptem.h          */
1013 #include <sys/ptem.h>                   /* Required to declare winsize     */
1014 #endif
1015     static struct winsize terminalSize;
1016     ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
1017     return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
1018 #else
1019     return 80;
1020 #endif
1021 }
1022
1023 Int readTerminalChar() {                /* read character from terminal    */
1024     return getchar();                   /* without echo, assuming that     */
1025 }                                       /* noechoTerminal() is active...   */
1026
1027 #elif SYMANTEC_C
1028
1029 Int readTerminalChar() {                /* read character from terminal    */
1030     return getchar();                   /* without echo, assuming that     */
1031 }                                       /* noechoTerminal() is active...   */
1032
1033 Int getTerminalWidth() {
1034     return console_options.ncols;
1035 }
1036
1037 Void normalTerminal() {
1038     csetmode(C_ECHO, stdin);
1039 }
1040
1041 Void noechoTerminal() {
1042     csetmode(C_NOECHO, stdin);
1043 }
1044
1045 #else /* no terminal driver - eg DOS, RISCOS */
1046
1047 static Bool terminalEchoReqd = TRUE;
1048
1049 Int getTerminalWidth() {
1050 #if RISCOS
1051     int dummy, width;
1052     (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1053     return width+1;
1054 #else
1055     return 80;
1056 #endif
1057 }
1058
1059 Void normalTerminal() {                 /* restore terminal initial state  */
1060     terminalEchoReqd = TRUE;
1061 }
1062
1063 Void noechoTerminal() {                 /* turn terminal echo on/off       */
1064     terminalEchoReqd = FALSE;
1065 }
1066
1067 Int readTerminalChar() {                /* read character from terminal    */
1068     if (terminalEchoReqd) {
1069         return getchar();
1070     } else {
1071 #if IS_WIN32 && !HUGS_FOR_WINDOWS && !__BORLANDC__
1072         /* When reading a character from the console/terminal, we want
1073          * to operate in 'raw' mode (to use old UNIX tty parlance) and have
1074          * it return when a character is available and _not_ wait until
1075          * the next time the user hits carriage return. On Windows platforms,
1076          * this _can_ be done by reading directly from the console, using
1077          * getch().  However, this doesn't sit well with programming
1078          * environments such as Emacs which allow you to create sub-processes
1079          * running Hugs, and then communicate with the running interpreter
1080          * through its standard input and output handles. If you use getch()
1081          * in that setting, you end up trying to read the (unused) console
1082          * of the editor itself, through which not a lot of characters is
1083          * bound to come out, since the editor communicates input to Hugs
1084          * via the standard input handle.
1085          *
1086          * To avoid this rather unfortunate situation, we use the Win32
1087          * console API and re-jig the input properties of the standard
1088          * input handle before trying to read a character using stdio's
1089          * getchar().
1090          *
1091          * The 'cost' of this solution is that it is Win32 specific and
1092          * won't work with Windows 3.1 + it is kind of ugly and verbose
1093          * to have to futz around with the console properties on a
1094          * per-char basis. Both of these disadvantages aren't in my
1095          * opinion fatal.
1096          *
1097          * -- sof 5/99
1098          */
1099         Int c;
1100         DWORD mo;
1101         HANDLE hIn;
1102
1103         /* I don't quite understand why, but if the FILE*'s underlying file
1104            descriptor is in text mode, we seem to lose the first carriage
1105            return.
1106          */
1107         setmode(fileno(stdin), _O_BINARY);
1108         hIn = GetStdHandle(STD_INPUT_HANDLE);
1109         GetConsoleMode(hIn, &mo);
1110         SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
1111         /*
1112          * On Win9x, the first time you change the mode (as above) a
1113          * raw '\n' is inserted.  Since enter maps to a raw '\r', and we
1114          * map this (below) to '\n', we can just ignore all *raw* '\n's.
1115          */
1116         do {
1117           c = getc(stdin);
1118         } while (c == '\n');
1119
1120         /* Same as it ever was - revert back state of stdin. */
1121         SetConsoleMode(hIn, mo);
1122         setmode(fileno(stdin), _O_TEXT);
1123 #else
1124         Int c = getch();
1125 #endif
1126         return c=='\r' ? '\n' : c;      /* slight paranoia about CR-LF    */
1127     }
1128 }
1129
1130 #endif /* no terminal driver */
1131
1132 /* --------------------------------------------------------------------------
1133  * Interrupt handling:
1134  * ------------------------------------------------------------------------*/
1135
1136 Bool    broken         = FALSE;
1137 static  Bool breakReqd = FALSE;
1138 static  sigProto(ignoreBreak);
1139 static  Void local installHandlers Args((Void));
1140
1141 Bool breakOn(reqd)                      /* set break trapping on if reqd,  */
1142 Bool reqd; {                            /* or off otherwise, returning old */
1143     Bool old  = breakReqd;
1144
1145     breakReqd = reqd;
1146     if (reqd) {
1147         if (broken) {                   /* repond to break signal received */
1148             broken = FALSE;             /* whilst break trap disabled      */
1149             sigRaise(breakHandler);
1150             /* not reached */
1151         }
1152 #if HANDLERS_CANT_LONGJMP
1153         ctrlbrk(ignoreBreak);
1154 #else
1155         ctrlbrk(breakHandler);
1156 #endif
1157     } else {
1158         ctrlbrk(ignoreBreak);
1159     }
1160     return old;
1161 }
1162
1163 static sigHandler(ignoreBreak) {        /* record but don't respond to break*/
1164     ctrlbrk(ignoreBreak);         /* reinstall signal handler               */
1165                                   /* redundant on BSD systems but essential */
1166                                   /* on POSIX and other systems             */
1167     broken = TRUE;
1168     interruptStgRts();
1169     sigResume;
1170 }
1171
1172 #if !DONT_PANIC
1173 static sigProto(panic);
1174 static sigHandler(panic) {              /* exit in a panic, on receipt of  */
1175     everybody(EXIT);                    /* an unexpected signal            */
1176     fprintf(stderr,"\nUnexpected signal\n");
1177     exit(1);
1178     sigResume;/*NOTREACHED*/
1179 }
1180 #endif /* !DONT_PANIC */
1181
1182 #if IS_WIN32
1183 BOOL WINAPI consoleHandler(DWORD dwCtrlType) {
1184     switch (dwCtrlType) {               /* Allows Hugs to be terminated    */
1185         case CTRL_CLOSE_EVENT :         /* from the window's close menu.   */
1186             ExitProcess(0);
1187     }
1188     return FALSE;
1189 }
1190 #endif
1191
1192 static Void local installHandlers() { /* Install handlers for all fatal    */
1193                                       /* signals except SIGINT and SIGBREAK*/
1194 #if IS_WIN32
1195     SetConsoleCtrlHandler(consoleHandler,TRUE);
1196 #endif
1197 #if !DONT_PANIC && !DOS
1198 # ifdef SIGABRT
1199     signal(SIGABRT,panic);
1200 # endif
1201 # ifdef SIGBUS
1202     signal(SIGBUS,panic);
1203 # endif
1204 # ifdef SIGFPE
1205     signal(SIGFPE,panic);
1206 # endif
1207 # ifdef SIGHUP
1208     signal(SIGHUP,panic);
1209 # endif
1210 # ifdef SIGILL
1211     signal(SIGILL,panic);
1212 # endif
1213 # ifdef SIGQUIT
1214     signal(SIGQUIT,panic);
1215 # endif
1216 # ifdef SIGSEGV
1217     signal(SIGSEGV,panic);
1218 # endif
1219 # ifdef SIGTERM
1220     signal(SIGTERM,panic);
1221 # endif
1222 #endif /* !DONT_PANIC && !DOS */
1223 }
1224
1225 /* --------------------------------------------------------------------------
1226  * Shell escapes:
1227  * ------------------------------------------------------------------------*/
1228
1229 static Bool local startEdit(line,nm)    /* Start editor on file name at    */
1230 Int    line;                            /* given line.  Both name and line */
1231 String nm; {                            /* or just line may be zero        */
1232     static char editorCmd[FILENAME_MAX+1];
1233
1234 #if !SYMANTEC_C
1235     if (hugsEdit && *hugsEdit) {        /* Check that editor configured    */
1236 #else
1237     /* On a Mac, files have creator information, telling which program
1238        to launch to, so an editor named to the empty string "" is often
1239        desirable. */
1240     if (hugsEdit) {        /* Check that editor configured    */
1241 #endif
1242         Int n     = FILENAME_MAX;
1243         String he = hugsEdit;
1244         String ec = editorCmd;
1245         String rd = NULL;               /* Set to nonnull to redo ...      */
1246
1247         for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
1248             *ec++ = *he++;              /* Copy editor name to buffer      */
1249                                         /* assuming filename ends at space */
1250
1251         if (nm && line && n>1 && *he){  /* Name, line, and enough space    */
1252             rd = ec;                    /* save, in case we don't find name*/
1253             while (n>0 && *he) {
1254                 if (*he=='%') {
1255                     if (*++he=='d' && n>10) {
1256                         sprintf(ec,"%d",line);
1257                         he++;
1258                     }
1259                     else if (*he=='s' && (size_t)n>strlen(nm)) {
1260                         strcpy(ec,nm);
1261                         rd = NULL;
1262                         he++;
1263                     }
1264                     else if (*he=='%' && n>1) {
1265                         strcpy(ec,"%");
1266                         he++;
1267                     }
1268                     else                /* Ignore % char if not followed   */
1269                         *ec = '\0';     /* by one of d, s, or %,           */
1270                     for (; *ec && n>0; n--)
1271                         ec++;
1272                 }   /* ignore % followed by anything other than d, s, or % */
1273                 else {                  /* Copy other characters across    */
1274                     *ec++ = *he++;
1275                     n--;
1276                 }
1277             }
1278         }
1279         else
1280             line = 0;
1281
1282         if (rd) {                       /* If file name was not included   */
1283             ec   = rd;
1284             line = 0;
1285         }
1286
1287         if (nm && line==0 && n>1) {     /* Name, but no line ...           */
1288             *ec++ = ' ';
1289             for (; n>0 && *nm; n--)     /* ... just copy file name         */
1290                 *ec++ = *nm++;
1291         }
1292
1293         *ec = '\0';                     /* Add terminating null byte       */
1294     }
1295     else {
1296         ERRMSG(0) "Hugs is not configured to use an editor"
1297         EEND;
1298     }
1299
1300 #if HAVE_WINEXEC
1301     WinExec(editorCmd, SW_SHOW);
1302     return FALSE;
1303 #else
1304     if (shellEsc(editorCmd))
1305         Printf("Warning: Editor terminated abnormally\n");
1306     return TRUE;
1307 #endif
1308 }
1309
1310 Int shellEsc(s)                         /* run a shell command (or shell)  */
1311 String s; {
1312 #if HAVE_MACSYSTEM
1313     return macsystem(s);
1314 #else
1315 #if HAVE_BIN_SH
1316     if (s[0]=='\0') {
1317         s = fromEnv("SHELL","/bin/sh");
1318     }
1319 #endif
1320     return system(s);
1321 #endif
1322 }
1323
1324 #if RISCOS                              /* RISCOS also needs a chdir()     */
1325 int chdir(char *s) {                    /* RISCOS PRM p. 885    -- JBS     */
1326     return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1327 }
1328 #elif defined HAVE_PBHSETVOLSYNC        /* Macintosh */
1329 int chdir(const char *s) {
1330     char* str;
1331     WDPBRec wd;
1332     wd.ioCompletion = 0;
1333     str = (char*)malloc(strlen(s) + 1);
1334     if (str == 0) return -1;
1335     strcpy(str, s);
1336     wd.ioNamePtr = C2PStr(str);
1337     wd.ioVRefNum = 0;
1338     wd.ioWDDirID = 0;
1339     errno = PBHSetVolSync(&wd);
1340     free(str);
1341     if (errno == 0) {
1342         return 0;
1343     } else {
1344         return -1;
1345     }
1346 }
1347 #endif
1348
1349
1350 /*---------------------------------------------------------------------------
1351  * Printf-related operations:
1352  *-------------------------------------------------------------------------*/
1353
1354 #if !defined(HAVE_VSNPRINTF)
1355 int vsnprintf(buffer, count, fmt, ap)
1356 char*       buffer;
1357 int         count;
1358 const char* fmt;
1359 va_list     ap; {
1360 #if defined(HAVE__VSNPRINTF)
1361     return _vsnprintf(buffer, count, fmt, ap);
1362 #else
1363     return 0;
1364 #endif
1365 }
1366 #endif /* HAVE_VSNPRINTF */
1367
1368 #if !defined(HAVE_SNPRINTF)
1369 int snprintf(char* buffer, int count, const char* fmt, ...) {
1370 #if defined(HAVE__VSNPRINTF)
1371     int r;
1372     va_list ap;                    /* pointer into argument list           */
1373     va_start(ap, fmt);             /* make ap point to first arg after fmt */
1374     r = vsnprintf(buffer, count, fmt, ap);
1375     va_end(ap);                    /* clean up                             */
1376     return r;
1377 #else
1378     return 0;
1379 #endif
1380 }
1381 #endif /* HAVE_SNPRINTF */
1382
1383 /* --------------------------------------------------------------------------
1384  * Read/write values from/to the registry
1385  *
1386  * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1387  * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key.  (Machine entry is only used if
1388  * user entry doesn't exist).
1389  *
1390  * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1391  * ------------------------------------------------------------------------*/
1392
1393 #if USE_REGISTRY
1394
1395 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1396
1397 static Bool   local createKey      Args((HKEY, PHKEY, REGSAM));
1398 static Bool   local queryValue     Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1399 static Bool   local setValue       Args((HKEY, String, DWORD, LPBYTE, DWORD));
1400
1401 static Bool local createKey(hKey, phRootKey, samDesired)
1402 HKEY    hKey;
1403 PHKEY   phRootKey;
1404 REGSAM  samDesired; {
1405     DWORD  dwDisp;
1406     return RegCreateKeyEx(hKey, HugsRoot,
1407                           0, "", REG_OPTION_NON_VOLATILE,
1408                           samDesired, NULL, phRootKey, &dwDisp)
1409            == ERROR_SUCCESS;
1410 }
1411
1412 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1413 HKEY    hKey;
1414 String  regPath;
1415 String  var;
1416 LPDWORD type;
1417 LPBYTE  buf;
1418 DWORD   bufSize; {
1419     HKEY hRootKey;
1420
1421     if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1422         return FALSE;
1423     } else {
1424         LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1425         RegCloseKey(hRootKey);
1426         return (res == ERROR_SUCCESS);
1427     }
1428 }
1429
1430 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1431 HKEY   hKey;
1432 String regPath;
1433 String var;
1434 DWORD  type;
1435 LPBYTE buf;
1436 DWORD  bufSize; {
1437     HKEY hRootKey;
1438
1439     if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1440         return FALSE;
1441     } else {
1442         LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1443         RegCloseKey(hRootKey);
1444         return (res == ERROR_SUCCESS);
1445     }
1446 }
1447
1448 static String local readRegString(key,regPath,var,def) /* read String from registry */
1449 HKEY   key;
1450 String regPath;
1451 String var;
1452 String def; {
1453     static char  buf[300];
1454     DWORD type;
1455     if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1456         && type == REG_SZ) {
1457         return (String)buf;
1458     } else {
1459         return def;
1460     }
1461 }
1462
1463 static Int local readRegInt(var, def)            /* read Int from registry */
1464 String var;
1465 Int    def; {
1466     DWORD buf;
1467     DWORD type;
1468
1469     if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1470                    (LPBYTE)&buf, sizeof(buf))
1471         && type == REG_DWORD) {
1472         return (Int)buf;
1473     } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1474                           (LPBYTE)&buf, sizeof(buf))
1475                && type == REG_DWORD) {
1476         return (Int)buf;
1477     } else {
1478         return def;
1479     }
1480 }
1481
1482 static Bool local writeRegString(var,val)      /* write String to registry */
1483 String var;
1484 String val; {
1485     if (NULL == val) {
1486         val = "";
1487     }
1488     return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1489                     REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1490 }
1491
1492 static Bool local writeRegInt(var,val)         /* write String to registry */
1493 String var;
1494 Int    val; {
1495     return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1496                     REG_DWORD, (LPBYTE)&val, sizeof(val));
1497 }
1498
1499 #endif /* USE_REGISTRY */
1500
1501 /* --------------------------------------------------------------------------
1502  * Things to do with the argv/argc and the env
1503  * ------------------------------------------------------------------------*/
1504
1505 int nh_argc ( void )
1506 {
1507   return prog_argc;
1508 }
1509
1510 int nh_argvb ( int argno, int offset )
1511 {
1512   return (int)(prog_argv[argno][offset]);
1513 }
1514
1515 /* --------------------------------------------------------------------------
1516  * Machine dependent control:
1517  * ------------------------------------------------------------------------*/
1518
1519 Void machdep(what)                      /* Handle machine specific         */
1520 Int what; {                             /* initialisation etc..            */
1521     switch (what) {
1522         case MARK    : break;
1523         case INSTALL : installHandlers();
1524                        break;
1525         case RESET   :
1526         case BREAK   :
1527         case EXIT    : normalTerminal();
1528 #if HUGS_FOR_WINDOWS
1529                        if (what==EXIT)
1530                            DestroyWindow(hWndMain);
1531                        else
1532                            SetCursor(LoadCursor(NULL,IDC_ARROW));
1533 #endif
1534                        break;
1535     }
1536 }
1537
1538 /*-------------------------------------------------------------------------*/