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