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