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.32 $
  17  * $Date: 2000/05/26 10:14:33 $
  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
  31 #if 0
  32 #if HAVE_SYS_PARAM_H
  33 # include <sys/param.h>
  34 #endif
  35 #endif
  36
  37 #ifdef HAVE_SYS_STAT_H
  38 # include <sys/stat.h>
  39 #else
  40 # ifdef HAVE_STAT_H
  41 #  include <stat.h>
  42 # endif
  43 #endif
  44 #ifdef HAVE_TIME_H
  45 # include <time.h>
  46 #endif
  47
  48 /* Windows/DOS include files */
  49 #ifdef HAVE_DOS_H
  50 # include <dos.h>
  51 #endif
  52 #if defined HAVE_CONIO_H
  53 # include <conio.h>
  54 #endif
  55 #ifdef HAVE_IO_H
  56 # include <io.h>
  57 #endif
  58 #ifdef HAVE_STD_H
  59 # include <std.h>
  60 #endif
  61 #ifdef HAVE_WINDOWS_H
  62 # include <windows.h>
  63 #endif
  64
  65 #if DOS
  66 #include <mem.h>
  67 extern unsigned _stklen = 8000;         /* Allocate an 8k stack segment    */
  68 #endif
  69
  70 #if RISCOS
  71 #include "swis.h"
  72 #include "os.h"
  73 #endif
  74
  75 /* Macintosh include files */
  76 #ifdef HAVE_CONSOLE_H
  77 # include <console.h>
  78 #endif
  79 #ifdef HAVE_PASCAL_H
  80 # include <pascal.h>
  81 #endif
  82 #ifdef HAVE_FILES_H
  83 # include <Files.h>
  84 #endif
  85 #ifdef HAVE_FCNTL_H
  86 # include <fcntl.h>
  87 #endif
  88 #ifdef HAVE_ERRNO_H
  89 # include <errno.h>
  90 #endif
  91 #ifdef HAVE_STDLIB_H
  92 # include <stdlib.h>
  93 #endif
  94 #ifdef HAVE_UNIX_H
  95 #include <unix.h>
  96 #endif
  97 #if SYMANTEC_C
  98 int allow_break_count = 0;
  99 #endif
 100
 101 /* --------------------------------------------------------------------------
 102  * Find information about a file:
 103  * ------------------------------------------------------------------------*/
 104
 105 #include "machdep_time.h"
 106
 107 static Bool local readable      ( String );
 108 static Void local getFileInfo   ( String, Time *, Long * );
 109
 110 static Void local getFileInfo(f,tm,sz)  /* find time stamp and size of file*/
 111 String f;
 112 Time   *tm;
 113 Long   *sz; {
 114 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
 115     struct stat scbuf;
 116     if (!stat(f,&scbuf)) {
 117         if (tm) *tm = scbuf.st_mtime;
 118         *sz = (Long)(scbuf.st_size);
 119     } else {
 120         if (tm) *tm = 0;
 121         *sz = 0;
 122     }
 123 #else                                   /* normally just use stat()        */
 124     os_regset r;                        /* RISCOS PRM p.850 and p.837      */
 125     r.r[0] = 17;                        /* Read catalogue, no path         */
 126     r.r[1] = (int)s;
 127     os_swi(OS_File, &r);
 128     if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
 129         if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte)        */
 130         if (tm) tm->lo = r.r[3];        /* Execution address (low 4 bytes) */
 131     } else {                            /* Not found, or not time-stamped  */
 132         if (tm) tm->hi = tm->lo = 0;
 133     }
 134     *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
 135 #endif
 136 }
 137
 138 Void getFileSize ( String f, Long* sz )
 139 {
 140    getFileInfo ( f, NULL, sz );
 141 }
 142
 143 #if defined HAVE_GETFINFO               /* Mac971031 */
 144 /* --------------------------------------------------------------------------
 145  * Define a MacOS version of access():
 146  *   If the file is not accessible, -1 is returned and errno is set to
 147  * the reason for the failure.
 148  *   If the file is accessible and the dummy is 0 (existence), 2 (write),
 149  * or 4 (read), the return is 0.
 150  *   If the file is accessible, and the dummy is 1 (executable), then if
 151  * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
 152  *   Warnings: Use with caution. UNIX access do no translate to Macs.
 153  * Check of write access is not implemented (same as read).
 154  * ------------------------------------------------------------------------*/
 155
 156 int access(char *fileName, int dummy) {
 157         FInfo   fi;
 158         short   rc;
 159
 160         errno = getfinfo(fileName, 0, &fi);
 161         if (errno != 0)  return -1;             /* Check file accessible. */
 162
 163         /* Cases dummy = existence, read, write. */
 164         if (dummy == 0 || dummy & 0x6)  return 0;
 165
 166         /* Case dummy = executable. */
 167         if (dummy == 1) {
 168                 if (fi.fdType == 'APPL')  return 0;
 169                 errno = fi.fdType;
 170                 return -1;
 171         }
 172
 173         return 0;
 174 }
 175 #endif
 176
 177 static Bool local readable(f)           /* is f a regular, readable file   */
 178 String f; {
 179 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
 180     return (0 == access(f,4));
 181 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
 182     struct stat scbuf;
 183     /* fprintf(stderr, "readable: %s\n", f ); */
 184     return (  !stat(f,&scbuf)
 185            && (scbuf.st_mode & S_IREAD) /* readable     */
 186            && (scbuf.st_mode & S_IFREG) /* regular file */
 187            );
 188 #elif defined HAVE_OS_SWI /* RISCOS specific */
 189     os_regset r;                        /* RISCOS PRM p.850     -- JBS     */
 190     assert(dummy == 0);
 191     r.r[0] = 17; /* Read catalogue, no path */
 192     r.r[1] = (int)f;
 193     os_swi(OS_File, &r);
 194     return r.r[0] != 1; /* Does this check it's a regular file? ADR */
 195 #endif
 196 }
 197
 198
 199 /* --------------------------------------------------------------------------
 200  * Search for script files on the HUGS path:
 201  * ------------------------------------------------------------------------*/
 202
 203 static String local hugsdir       ( Void );
 204 #if HSCRIPT
 205 static String local hscriptDir    ( Void );
 206 #endif
 207 static int    local pathCmp       ( String, String );
 208 static String local normPath      ( String );
 209 static Void   local searchChr     ( Int );
 210 static Void   local searchStr     ( String );
 211 static Bool   local tryEndings    ( String );
 212
 213 #if (DOS_FILENAMES || __CYGWIN32__)
 214 # define SLASH                   '/'
 215 # define SLASH_STR               "/"
 216 # define isSLASH(c)              ((c)=='\\' || (c)=='/')
 217 # define PATHSEP                 ';'
 218 # define PATHSEP_STR             ";"
 219 # define DLL_ENDING              ".u_o"
 220 #elif MAC_FILENAMES
 221 # define SLASH                   ':'
 222 # define isSLASH(c)              ((c)==SLASH)
 223 # define PATHSEP                 ';'
 224 # define PATHSEP_STR             ";"
 225 /* Mac PEF (Preferred Executable Format) file */
 226 # define DLL_ENDING              ".pef"
 227 #else
 228 # define SLASH                   '/'
 229 # define SLASH_STR               "/"
 230 # define isSLASH(c)              ((c)==SLASH)
 231 # define PATHSEP                 ':'
 232 # define PATHSEP_STR             ":"
 233 # define DLL_ENDING              ".u_o"
 234 #endif
 235
 236 static String local hugsdir() {     /* directory containing lib/Prelude.hs */
 237 #if HSCRIPT
 238     /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
 239     static char dir[FILENAME_MAX+1] = "";
 240     if (dir[0] == '\0') { /* not initialised yet */
 241         String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
 242                                  HUGSDIR);
 243         if (s) {
 244             strcpy(dir,s);
 245         }
 246     }
 247     return dir;
 248 #elif HAVE_GETMODULEFILENAME && !DOS && !__CYGWIN32__
 249     /* On Windows, we can find the binary we're running and it's
 250      * conventional to put the libraries in the same place.
 251      */
 252     static char dir[FILENAME_MAX+1] = "";
 253     if (dir[0] == '\0') { /* not initialised yet */
 254         String slash = 0;
 255         GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
 256         if (dir[0] == '\0') { /* GetModuleFileName must have failed */
 257             return HUGSDIR;
 258         }
 259         slash = strrchr(dir,SLASH);
 260         if (slash) { /* truncate after directory name */
 261             *slash = '\0';
 262         }
 263     }
 264     return dir;
 265 #else
 266     /* On Unix systems, we can't find the binary we're running and
 267      * the libraries may not be installed near the binary anyway.
 268      * This forces us to use a hardwired path which is set at
 269      * configuration time (--datadir=...).
 270      */
 271     return HUGSDIR;
 272 #endif
 273 }
 274
 275 #if HSCRIPT
 276 static String local hscriptDir() {  /* Directory containing hscript.dll    */
 277     static char dir[FILENAME_MAX+1] = "";
 278     if (dir[0] == '\0') { /* not initialised yet */
 279         String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
 280         if (s) {
 281             strcpy(dir,s);
 282         }
 283     }
 284     return dir;
 285 }
 286 #endif
 287
 288
 289 static String local normPath(s) /* Try, as much as possible, to normalize  */
 290 String s; {                     /* a pathname in some appropriate manner.  */
 291 #if PATH_CANONICALIZATION
 292     String path = RealPath(s);
 293 #if CASE_INSENSITIVE_FILENAMES
 294     strlwr(path);                       /* and convert to lowercase        */
 295 #endif
 296     return path;
 297 #else /* ! PATH_CANONICALIZATION */
 298     return s;
 299 #endif /* ! PATH_CANONICALIZATION */
 300 }
 301
 302 #if HSCRIPT
 303 static String endings[] = { "", ".u_hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
 304 #else
 305 static String endings[] = { "", ".u_hi", ".hs", ".lhs", 0 };
 306 #endif
 307 static char   searchBuf[FILENAME_MAX+1];
 308 static Int    searchPos;
 309
 310 #define searchReset(n)          searchBuf[searchPos=(n)]='\0'
 311
 312 static Void local searchChr(c)  /* Add single character to search buffer   */
 313 Int c; {
 314     if (searchPos<FILENAME_MAX) {
 315         searchBuf[searchPos++] = (char)c;
 316         searchBuf[searchPos]   = '\0';
 317     }
 318 }
 319
 320 static Void local searchStr(s)  /* Add string to search buffer             */
 321 String s; {
 322     while (*s && searchPos<FILENAME_MAX)
 323         searchBuf[searchPos++] = *s++;
 324     searchBuf[searchPos] = '\0';
 325 }
 326
 327 static Bool local tryEndings(s) /* Try each of the listed endings          */
 328 String s; {
 329     Int i = 0;
 330     searchStr(s);
 331     for (; endings[i]; ++i) {
 332         Int save = searchPos;
 333         searchStr(endings[i]);
 334         if (readable(searchBuf))
 335             return TRUE;
 336         searchReset(save);
 337     }
 338     return FALSE;
 339 }
 340
 341
 342
 343 #if SEARCH_DIR
 344
 345 /* scandir, June 98 Daan Leijen
 346    searches the base directory and its direct subdirectories for a file
 347
 348    input: searchbuf contains SLASH terminated base directory
 349           argument s contains the (base) filename
 350    output: TRUE: searchBuf contains the full filename
 351            FALSE: searchBuf is garbage, file not found
 352 */
 353
 354
 355 #ifdef HAVE_WINDOWS_H
 356
 357 static Bool scanSubDirs(s)
 358 String s;
 359 {
 360     struct _finddata_t findInfo;
 361     long handle;
 362     int  save;
 363
 364     save = searchPos;
 365     /* is it in the current directory ? */
 366     if (tryEndings(s)) return TRUE;
 367
 368     searchReset(save);
 369     searchStr("*");
 370
 371     /* initiate the search */
 372     handle = _findfirst( searchBuf, &findInfo );
 373     if (handle==-1) { errno = 0; return FALSE; }
 374
 375     /* search all subdirectories */
 376     do {
 377         /* if we have a valid sub directory */
 378         if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
 379             (findInfo.name[0] != '.')) {
 380             searchReset(save);
 381             searchStr(findInfo.name);
 382             searchChr(SLASH);
 383             if (tryEndings(s)) {
 384                 return TRUE;
 385             }
 386         }
 387     } while (_findnext( handle, &findInfo ) == 0);
 388
 389     _findclose( handle );
 390     return FALSE;
 391 }
 392
 393 #elif defined(HAVE_FTW_H)
 394
 395 #include <ftw.h>
 396
 397 static char baseFile[FILENAME_MAX+1];
 398 static char basePath[FILENAME_MAX+1];
 399 static int  basePathLen;
 400
 401 static int scanitem( const char* path,
 402                      const struct stat* statinfo,
 403                      int info )
 404 {
 405     if (info == FTW_D) { /* is it a directory */
 406         searchReset(0);
 407         searchStr(path);
 408         searchChr(SLASH);
 409         if (tryEndings(baseFile)) {
 410             return 1;
 411         }
 412     }
 413     return 0;
 414 }
 415
 416 static Bool scanSubDirs(s)
 417 String s;
 418 {
 419     int r;
 420     strcpy(baseFile,s);
 421     strcpy(basePath,searchBuf);
 422     basePathLen = strlen(basePath);
 423
 424     /* is it in the current directory ? */
 425     if (tryEndings(s)) return TRUE;
 426
 427     /* otherwise scan the subdirectories */
 428     r = ftw( basePath, scanitem, 2 );
 429     errno = 0;
 430     return (r > 0);
 431 }
 432
 433 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
 434 #endif /* SEARCH_DIR */
 435
 436 String findPathname(along,nm)   /* Look for a file along specified path    */
 437 String along;                   /* Return NULL if file does not exist      */
 438 String nm; {
 439     /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
 440     String s = findMPathname(along,nm,hugsPath);
 441     return s ? s : normPath(searchBuf);
 442 }
 443
 444 /* AC, 1/21/99: modified to pass in path to search explicitly */
 445 String findMPathname(along,nm,path)/* Look for a file along specified path   */
 446 String along;                   /* If nonzero, a path prefix from along is */
 447 String nm;                      /* used as the first prefix in the search. */
 448 String path; {
 449     String pathpt = path;
 450
 451     searchReset(0);
 452     if (along) {                /* Was a path for an existing file given?  */
 453         Int last = (-1);
 454         Int i    = 0;
 455         for (; along[i]; i++) {
 456             searchChr(along[i]);
 457             if (isSLASH(along[i]))
 458                 last = i;
 459         }
 460         searchReset(last+1);
 461     }
 462     if (tryEndings(nm))
 463         return normPath(searchBuf);
 464
 465     if (pathpt && *pathpt) {    /* Otherwise, we look along the HUGSPATH   */
 466         Bool more = TRUE;
 467         do {
 468             Bool recurse = FALSE;   /* DL: shall we recurse ? */
 469             searchReset(0);
 470             if (*pathpt) {
 471                 if (*pathpt!=PATHSEP) {
 472                     /* Pre-define one MPW-style "shell-variable" */
 473                     if (strncmp(pathpt,"{Hugs}",6)==0) {
 474                         searchStr(hugsdir());
 475                         pathpt += 6;
 476                     }
 477 #if HSCRIPT
 478                     /* And another - we ought to generalise this stuff */
 479                     else if (strncmp(pathpt,"{HScript}",9)==0) {
 480                         searchStr(hscriptDir());
 481                         pathpt += 9;
 482                     }
 483 #endif
 484                     do {
 485                         searchChr(*pathpt++);
 486                     } while (*pathpt && *pathpt!=PATHSEP);
 487                     recurse = (pathpt[-1] == SLASH);
 488                     if (!recurse) {
 489                         searchChr(SLASH);
 490                     }
 491                 }
 492                 if (*pathpt==PATHSEP)
 493                     pathpt++;
 494                 else
 495                     more = FALSE;
 496             } else {
 497                 more = FALSE;
 498             }
 499 #if SEARCH_DIR
 500             if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
 501                 return normPath(searchBuf);
 502             }
 503 #else
 504             if (tryEndings(nm)) {
 505                 return normPath(searchBuf);
 506             }
 507 #endif
 508         } while (more);
 509     }
 510
 511     searchReset(0);  /* As a last resort, look for file in the current dir */
 512     return (tryEndings(nm) ? normPath(searchBuf) : 0);
 513 }
 514
 515 /* --------------------------------------------------------------------------
 516  * New path handling stuff for the Combined System (tm)
 517  * ------------------------------------------------------------------------*/
 518
 519 char installDir[N_INSTALLDIR];
 520
 521 /* Sets installDir to $STGHUGSDIR, and ensures there is a trailing
 522    slash at the end.
 523 */
 524 void setInstallDir ( String argv_0 )
 525 {
 526    int   i;
 527    char* r = getenv("STGHUGSDIR");
 528    if (!r) {
 529       fprintf(stderr,
 530           "%s: installation error: environment variable STGHUGSDIR is not set.\n",
 531           argv_0 );
 532       fprintf(stderr,
 533           "%s: pls set it to be the directory where STGHugs98 is installed.\n\n",
 534           argv_0 );
 535       exit(2);
 536
 537    }
 538
 539    if (strlen(r) > N_INSTALLDIR-30 ) {
 540       fprintf(stderr,
 541           "%s: environment variable STGHUGSDIR is suspiciously long; pls remedy\n\n",
 542           argv_0 );
 543       exit(2);
 544    }
 545
 546    strcpy ( installDir, r );
 547    i = strlen(installDir);
 548    if (installDir[i-1] != SLASH) installDir[i++] = SLASH;
 549    installDir[i] = 0;
 550 }
 551
 552
 553 Bool findFilesForModule (
 554         String  modName,
 555         String* path,
 556         String* sExt,
 557         Bool* sAvail,  Time* sTime,  Long* sSize,
 558         Bool* oiAvail, Time* oiTime, Long* oSize, Long* iSize
 559      )
 560 {
 561    /* Let the module name given be M.
 562       For each path entry P,
 563         a  s(rc)       file will be P/M.hs or P/M.lhs
 564         an i(nterface) file will be P/M.hi
 565         an o(bject)    file will be P/M.o
 566       If there is a s file or (both i and o files)
 567         use P to fill in the path names.
 568       Otherwise, move on to the next path entry.
 569       If all path entries are exhausted, return False.
 570
 571       If in standalone, only look for (and succeed for) source modules.
 572       Caller free()s path.  sExt is statically allocated.
 573       srcExt is only set if a valid source file is found.
 574    */
 575    Int    nPath;
 576    Bool   literate;
 577    String peStart, peEnd;
 578    String augdPath;       /* .:hugsPath:installDir/../lib/std:installDir/lib */
 579    Time   oTime,  iTime;
 580    Bool   oAvail, iAvail;
 581
 582    *path = *sExt = NULL;
 583    *sAvail = *oiAvail = oAvail = iAvail = FALSE;
 584    *sSize  = *oSize  = *iSize  = 0;
 585
 586    augdPath = malloc( 2*(10+3+strlen(installDir))
 587                       +strlen(hugsPath) +50/*paranoia*/);
 588    if (!augdPath)
 589       internal("moduleNameToFileNames: malloc failed(2)");
 590
 591    augdPath[0] = 0;
 592
 593    if (combined) {
 594       strcat(augdPath, installDir);
 595       strcat(augdPath, "..");
 596       strcat(augdPath, SLASH_STR);
 597       strcat(augdPath, "lib");
 598       strcat(augdPath, SLASH_STR);
 599       strcat(augdPath, "std");
 600       strcat(augdPath, PATHSEP_STR);
 601    }
 602
 603    strcat(augdPath, installDir);
 604    strcat(augdPath, "lib");
 605    strcat(augdPath, PATHSEP_STR);
 606
 607    /* these two were previously before the above `if' */
 608    strcat(augdPath, ".");
 609    strcat(augdPath, PATHSEP_STR);
 610
 611    strcat(augdPath, hugsPath);
 612    strcat(augdPath, PATHSEP_STR);
 613
 614    /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */
 615
 616    peEnd = augdPath-1;
 617    while (1) {
 618       /* Advance peStart and peEnd very paranoically, giving up at
 619          the first sign of mutancy in the path string.
 620       */
 621       if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
 622       peStart = peEnd+1;
 623       peEnd = peStart;
 624       while (*peEnd && *peEnd != PATHSEP) peEnd++;
 625
 626       /* Now peStart .. peEnd-1 bracket the next path element. */
 627       nPath = peEnd-peStart;
 628       if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
 629          ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
 630                    hugsPath
 631          EEND;
 632          free(augdPath);
 633          return FALSE;
 634       }
 635
 636       strncpy(searchBuf, peStart, nPath);
 637       searchBuf[nPath] = 0;
 638       if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
 639          searchBuf[nPath++] = SLASH;
 640
 641       strcpy(searchBuf+nPath, modName);
 642       nPath += strlen(modName);
 643
 644       /* searchBuf now holds 'P/M'.  Try out the various endings. */
 645       *path = *sExt                         = NULL;
 646       *sAvail = *oiAvail = oAvail = iAvail  = FALSE;
 647       *sSize = *oSize = *iSize              = 0;
 648
 649       if (combined) {
 650          strcpy(searchBuf+nPath, DLL_ENDING);
 651          if (readable(searchBuf)) {
 652             oAvail = TRUE;
 653             getFileInfo(searchBuf, &oTime, oSize);
 654          }
 655          strcpy(searchBuf+nPath, HI_ENDING);
 656          if (readable(searchBuf)) {
 657             iAvail = TRUE;
 658             getFileInfo(searchBuf, &iTime, iSize);
 659          }
 660          if (oAvail && iAvail) {
 661             *oiAvail = TRUE;
 662             *oiTime = whicheverIsLater ( oTime, iTime );
 663          }
 664       }
 665
 666       strcpy(searchBuf+nPath, ".hs");
 667       if (readable(searchBuf)) {
 668          *sAvail = TRUE;
 669          literate = FALSE;
 670          getFileInfo(searchBuf, sTime, sSize);
 671          *sExt = ".hs";
 672       } else {
 673          strcpy(searchBuf+nPath, ".lhs");
 674          if (readable(searchBuf)) {
 675             *sAvail = TRUE;
 676             literate = TRUE;
 677             getFileInfo(searchBuf, sTime, sSize);
 678             *sExt = ".lhs";
 679          }
 680       }
 681
 682       /* Success? */
 683       if (*sAvail || *oiAvail) {
 684          nPath -= strlen(modName);
 685          *path = malloc(nPath+1);
 686          if (!(*path))
 687             internal("moduleNameToFileNames: malloc failed(1)");
 688          strncpy(*path, searchBuf, nPath);
 689          (*path)[nPath] = 0;
 690          free(augdPath);
 691          return TRUE;
 692       }
 693
 694    }
 695
 696 }
 697
 698
 699 /* If the primaryObjectName is (eg)
 700      /foo/bar/PrelSwamp.o
 701    and the extraFileName is (eg)
 702      swampy_cbits
 703    and DLL_ENDING is set to .o
 704    return
 705      /foo/bar/swampy_cbits.o
 706      and set *extraFileSize to its size, or -1 if not avail
 707 */
 708 String getExtraObjectInfo ( String primaryObjectName,
 709                             String extraFileName,
 710                             Int*   extraFileSize )
 711 {
 712    Time   xTime;
 713    Long   xSize;
 714    String xtra;
 715
 716    Int i = strlen(primaryObjectName)-1;
 717    while (i >= 0 && primaryObjectName[i] != SLASH) i--;
 718    if (i == -1) return extraFileName;
 719    i++;
 720    xtra = malloc ( i+3+strlen(extraFileName)+strlen(DLL_ENDING) );
 721    if (!xtra) internal("deriveExtraObjectName: malloc failed");
 722    strncpy ( xtra, primaryObjectName, i );
 723    xtra[i] = 0;
 724    strcat ( xtra, extraFileName );
 725    strcat ( xtra, DLL_ENDING );
 726
 727    *extraFileSize = -1;
 728    if (readable(xtra)) {
 729       getFileInfo ( xtra, &xTime, &xSize );
 730       *extraFileSize = xSize;
 731    }
 732    return xtra;
 733 }
 734
 735
 736 /* --------------------------------------------------------------------------
 737  * Substitute old value of path into empty entries in new path
 738  * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
 739  * ------------------------------------------------------------------------*/
 740
 741 static String local substPath ( String,String );
 742
 743 static String local substPath(new,sub) /* substitute sub path into new path*/
 744 String new;
 745 String sub; {
 746     Bool   substituted = FALSE;            /*   only allow one replacement */
 747     Int    maxlen      = strlen(sub) + strlen(new);    /* safe upper bound */
 748     String r = (String) malloc(maxlen+1);  /* result string                */
 749     String t = r;                          /* pointer into r               */
 750     String next = new;                     /* next uncopied char in new    */
 751     String start = next;                   /* start of last path component */
 752     if (r == 0) {
 753         ERRMSG(0) "String storage space exhausted"
 754         EEND;
 755     }
 756     do {
 757         if (*next == PATHSEP || *next == '\0') {
 758             if (!substituted && next == start) {
 759                 String s = sub;
 760                 for(; *s != '\0'; ++s) {
 761                     *t++ = *s;
 762                 }
 763                 substituted = TRUE;
 764             }
 765             start = next+1;
 766         }
 767     } while ((*t++ = *next++) != '\0');
 768     return r;
 769 }
 770
 771
 772 /* --------------------------------------------------------------------------
 773  * Garbage collection notification:
 774  * ------------------------------------------------------------------------*/
 775
 776 Bool gcMessages = FALSE;                /* TRUE => print GC messages       */
 777
 778 Void gcStarted() {                      /* Notify garbage collector start  */
 779     if (gcMessages) {
 780         Printf("{{Gc");
 781         FlushStdout();
 782     }
 783 }
 784
 785 Void gcScanning() {                     /* Notify garbage collector scans  */
 786     if (gcMessages) {
 787         Putchar(':');
 788         FlushStdout();
 789     }
 790 }
 791
 792 Void gcRecovered(recovered)             /* Notify garbage collection done  */
 793 Int recovered; {
 794     if (gcMessages) {
 795         Printf("%d}}",recovered);
 796         FlushStdout();
 797     }
 798 }
 799
 800 Cell *CStackBase;                       /* Retain start of C control stack */
 801
 802 #if RISCOS                              /* Stack traversal for RISCOS      */
 803
 804 /* Warning: The following code is specific to the Acorn ARM under RISCOS
 805    (and C4).  We must explicitly walk back through the stack frames, since
 806    the stack is extended from the heap. (see PRM pp. 1757).  gcCStack must
 807    not be modified, since the offset '5' assumes that only v1 is used inside
 808    this function. Hence we do all the real work in gcARM.
 809 */
 810
 811 #define spreg 13 /* C3 has SP=R13 */
 812
 813 #define previousFrame(fp)       ((int *)((fp)[-3]))
 814 #define programCounter(fp)      ((int *)((*(fp)-12) & ~0xFC000003))
 815 #define isSubSPSP(w)            (((w)&dontCare) == doCare)
 816 #define doCare                  (0xE24DD000)  /* SUB r13,r13,#0 */
 817 #define dontCare                (~0x00100FFF) /* S and # bits   */
 818 #define immediateArg(x)         ( ((x)&0xFF) << (((x)&0xF00)>>7) )
 819
 820 static void gcARM(int *fp) {
 821     int si = *programCounter(fp);       /* Save instruction indicates how */
 822                                         /* many registers in this frame   */
 823     int *regs = fp - 4;
 824     if (si & (1<<0)) markWithoutMove(*regs--);
 825     if (si & (1<<1)) markWithoutMove(*regs--);
 826     if (si & (1<<2)) markWithoutMove(*regs--);
 827     if (si & (1<<3)) markWithoutMove(*regs--);
 828     if (si & (1<<4)) markWithoutMove(*regs--);
 829     if (si & (1<<5)) markWithoutMove(*regs--);
 830     if (si & (1<<6)) markWithoutMove(*regs--);
 831     if (si & (1<<7)) markWithoutMove(*regs--);
 832     if (si & (1<<8)) markWithoutMove(*regs--);
 833     if (si & (1<<9)) markWithoutMove(*regs--);
 834     if (previousFrame(fp)) {
 835         /* The non-register stack space is for the previous frame is above
 836            this fp, and not below the previous fp, because of the way stack
 837            extension works. It seems the only way of discovering its size is
 838            finding the SUB sp, sp, #? instruction by walking through the code
 839            following the entry point.
 840         */
 841         int *oldpc = programCounter(previousFrame(fp));
 842         int fsize = 0, i;
 843         for(i = 1; i < 6; ++i)
 844             if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
 845         for(i=1; i<=fsize; ++i)
 846             markWithoutMove(fp[i]);
 847     }
 848 }
 849
 850 void gcCStack() {
 851     int dummy;
 852     int *fp = 5 + &dummy;
 853     while (fp) {
 854         gcARM(fp);
 855         fp = previousFrame(fp);
 856     }
 857 }
 858
 859 #else                   /* Garbage collection for standard stack machines  */
 860
 861 Void gcCStack() {                       /* Garbage collect elements off    */
 862     Cell stackTop = NIL;                /* C stack                         */
 863     Cell *ptr = &stackTop;
 864 #if SIZEOF_VOID_P == 2
 865     if (((long)(ptr) - (long)(CStackBase))&1)
 866         fatal("gcCStack");
 867 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 868     if (((long)(ptr) - (long)(CStackBase))&1)
 869         fatal("gcCStack");
 870 #else
 871     if (((long)(ptr) - (long)(CStackBase))&3)
 872         fatal("gcCStack");
 873 #endif
 874
 875 #define Blargh mark(*ptr);
 876 #if 0
 877                markWithoutMove((*ptr)/sizeof(Cell)); \
 878                markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell));  \
 879                markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
 880 #endif
 881
 882 #define StackGrowsDown  { while (ptr<=CStackBase) { Blargh; ptr++; }; }
 883 #define StackGrowsUp    { while (ptr>=CStackBase) { Blargh; ptr--; }; }
 884 #define GuessDirection  if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
 885
 886 #if STACK_DIRECTION > 0
 887     StackGrowsUp;
 888 #elif STACK_DIRECTION < 0
 889     StackGrowsDown;
 890 #else
 891     GuessDirection;
 892 #endif
 893
 894 #if SIZEOF_VOID_P==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 895     ptr = (Cell *)((long)(&stackTop) + 2);
 896     StackGrowsDown;
 897 #endif
 898
 899 #undef  StackGrowsDown
 900 #undef  StackGrowsUp
 901 #undef  GuessDirection
 902 }
 903 #endif
 904
 905 /* --------------------------------------------------------------------------
 906  * Interrupt handling:
 907  * ------------------------------------------------------------------------*/
 908
 909 static Void installHandlers ( void ) { /* Install handlers for all fatal   */
 910                                       /* signals except SIGINT and SIGBREAK*/
 911 #if IS_WIN32
 912     /* SetConsoleCtrlHandler(consoleHandler,TRUE); */
 913 #endif
 914 #if !DONT_PANIC && !DOS
 915 # ifdef SIGABRT
 916     signal(SIGABRT,panic);
 917 # endif
 918 # ifdef SIGBUS
 919     signal(SIGBUS,panic);
 920 # endif
 921 # ifdef SIGFPE
 922     signal(SIGFPE,panic);
 923 # endif
 924 # ifdef SIGHUP
 925     signal(SIGHUP,panic);
 926 # endif
 927 # ifdef SIGILL
 928     signal(SIGILL,panic);
 929 # endif
 930 # ifdef SIGQUIT
 931     signal(SIGQUIT,panic);
 932 # endif
 933 # ifdef SIGSEGV
 934     signal(SIGSEGV,panic);
 935 # endif
 936 # ifdef SIGTERM
 937     signal(SIGTERM,panic);
 938 # endif
 939 #endif /* !DONT_PANIC && !DOS */
 940 }
 941
 942 /* --------------------------------------------------------------------------
 943  * Shell escapes:
 944  * ------------------------------------------------------------------------*/
 945
 946 static Bool local startEdit(line,nm)    /* Start editor on file name at    */
 947 Int    line;                            /* given line.  Both name and line */
 948 String nm; {                            /* or just line may be zero        */
 949     static char editorCmd[FILENAME_MAX+1];
 950
 951 #if !SYMANTEC_C
 952     if (hugsEdit && *hugsEdit) {        /* Check that editor configured    */
 953 #else
 954     /* On a Mac, files have creator information, telling which program
 955        to launch to, so an editor named to the empty string "" is often
 956        desirable. */
 957     if (hugsEdit) {        /* Check that editor configured    */
 958 #endif
 959         Int n     = FILENAME_MAX;
 960         String he = hugsEdit;
 961         String ec = editorCmd;
 962         String rd = NULL;               /* Set to nonnull to redo ...      */
 963
 964         for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
 965             *ec++ = *he++;              /* Copy editor name to buffer      */
 966                                         /* assuming filename ends at space */
 967
 968         if (nm && line && n>1 && *he){  /* Name, line, and enough space    */
 969             rd = ec;                    /* save, in case we don't find name*/
 970             while (n>0 && *he) {
 971                 if (*he=='%') {
 972                     if (*++he=='d' && n>10) {
 973                         sprintf(ec,"%d",line);
 974                         he++;
 975                     }
 976                     else if (*he=='s' && (size_t)n>strlen(nm)) {
 977                         strcpy(ec,nm);
 978                         rd = NULL;
 979                         he++;
 980                     }
 981                     else if (*he=='%' && n>1) {
 982                         strcpy(ec,"%");
 983                         he++;
 984                     }
 985                     else                /* Ignore % char if not followed   */
 986                         *ec = '\0';     /* by one of d, s, or %,           */
 987                     for (; *ec && n>0; n--)
 988                         ec++;
 989                 }   /* ignore % followed by anything other than d, s, or % */
 990                 else {                  /* Copy other characters across    */
 991                     *ec++ = *he++;
 992                     n--;
 993                 }
 994             }
 995         }
 996         else
 997             line = 0;
 998
 999         if (rd) {                       /* If file name was not included   */
1000             ec   = rd;
1001             line = 0;
1002         }
1003
1004         if (nm && line==0 && n>1) {     /* Name, but no line ...           */
1005             *ec++ = ' ';
1006             for (; n>0 && *nm; n--)     /* ... just copy file name         */
1007                 *ec++ = *nm++;
1008         }
1009
1010         *ec = '\0';                     /* Add terminating null byte       */
1011     }
1012     else {
1013         ERRMSG(0) "Hugs is not configured to use an editor"
1014         EEND;
1015     }
1016
1017 #if HAVE_WINEXEC
1018     WinExec(editorCmd, SW_SHOW);
1019     return FALSE;
1020 #else
1021     if (shellEsc(editorCmd))
1022         Printf("Warning: Editor terminated abnormally\n");
1023     return TRUE;
1024 #endif
1025 }
1026
1027 Int shellEsc(s)                         /* run a shell command (or shell)  */
1028 String s; {
1029 #if HAVE_MACSYSTEM
1030     return macsystem(s);
1031 #else
1032 #if HAVE_BIN_SH
1033     if (s[0]=='\0') {
1034         s = fromEnv("SHELL","/bin/sh");
1035     }
1036 #endif
1037     return system(s);
1038 #endif
1039 }
1040
1041 #if RISCOS                              /* RISCOS also needs a chdir()     */
1042 int chdir(char *s) {                    /* RISCOS PRM p. 885    -- JBS     */
1043     return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1044 }
1045 #elif defined HAVE_PBHSETVOLSYNC        /* Macintosh */
1046 int chdir(const char *s) {
1047     char* str;
1048     WDPBRec wd;
1049     wd.ioCompletion = 0;
1050     str = (char*)malloc(strlen(s) + 1);
1051     if (str == 0) return -1;
1052     strcpy(str, s);
1053     wd.ioNamePtr = C2PStr(str);
1054     wd.ioVRefNum = 0;
1055     wd.ioWDDirID = 0;
1056     errno = PBHSetVolSync(&wd);
1057     free(str);
1058     if (errno == 0) {
1059         return 0;
1060     } else {
1061         return -1;
1062     }
1063 }
1064 #endif
1065
1066
1067 /* --------------------------------------------------------------------------
1068  * Things to do with the argv/argc and the env
1069  * ------------------------------------------------------------------------*/
1070
1071 int nh_argc ( void )
1072 {
1073   return prog_argc;
1074 }
1075
1076 int nh_argvb ( int argno, int offset )
1077 {
1078   return (int)(prog_argv[argno][offset]);
1079 }
1080
1081 /* --------------------------------------------------------------------------
1082  * Machine dependent control:
1083  * ------------------------------------------------------------------------*/
1084
1085 Void machdep(what)                      /* Handle machine specific         */
1086 Int what; {                             /* initialisation etc..            */
1087     switch (what) {
1088         case MARK    : break;
1089         case POSTPREL: break;
1090         case PREPREL : installHandlers();
1091                        break;
1092         case RESET   :
1093         case BREAK   :
1094         case EXIT    :
1095                        break;
1096     }
1097 }
1098
1099 /*-------------------------------------------------------------------------*/