ghc/interpreter/machdep.c

   1 /* -*- mode: hugs-c; -*- */
   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  *
   7  * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
   8  * All rights reserved. See NOTICE for details and conditions of use etc...
   9  * Hugs version 1.4, December 1997
  10  *
  11  * $RCSfile: machdep.c,v $
  12  * $Revision: 1.2 $
  13  * $Date: 1998/12/02 13:22:20 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include "prelude.h"
  17 #include "storage.h"
  18 #include "connect.h"
  19 #include "hugs.h"  /* for fromEnv */
  20 #include "errors.h"
  21 #include "version.h"
  22
  23 #include "machdep.h"
  24
  25 #include <stdio.h>
  26 #ifdef HAVE_SIGNAL_H
  27 # include <signal.h>
  28 #endif
  29 #ifdef HAVE_SYS_TYPES_H
  30 # include <sys/types.h>
  31 #else
  32 # ifdef HAVE_TYPES_H
  33 #  include <types.h>
  34 # endif
  35 #endif
  36 #if HAVE_SYS_PARAM_H
  37 # include <sys/param.h>
  38 #endif
  39 #ifdef HAVE_SYS_STAT_H
  40 # include <sys/stat.h>
  41 #else
  42 # ifdef HAVE_STAT_H
  43 #  include <stat.h>
  44 # endif
  45 #endif
  46 #ifdef HAVE_TIME_H
  47 # include <time.h>
  48 #endif
  49
  50 /* Windows/DOS include files */
  51 #ifdef HAVE_DOS_H
  52 # include <dos.h>
  53 #endif
  54 #if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS
  55 # include <conio.h>
  56 #endif
  57 #ifdef HAVE_IO_H
  58 # include <io.h>
  59 #endif
  60 #ifdef HAVE_STD_H
  61 # include <std.h>
  62 #endif
  63 #ifdef HAVE_WINDOWS_H
  64 # include <windows.h>
  65 #endif
  66
  67 #if HUGS_FOR_WINDOWS
  68 #include <dir.h>
  69 #include <mem.h>
  70
  71 extern HCURSOR HandCursor;            /* Forward references to cursors   */
  72 extern HCURSOR GarbageCursor;
  73 extern HCURSOR SaveCursor;
  74 static void    local DrawStatusLine     Args((HWND));
  75 #endif
  76
  77 #if DOS
  78 #include <mem.h>
  79 extern unsigned _stklen = 8000;         /* Allocate an 8k stack segment    */
  80 #endif
  81
  82 #if RISCOS
  83 #include "swis.h"
  84 #include "os.h"
  85 #endif
  86
  87 /* Macintosh include files */
  88 #ifdef HAVE_CONSOLE_H
  89 # include <console.h>
  90 #endif
  91 #ifdef HAVE_PASCAL_H
  92 # include <pascal.h>
  93 #endif
  94 #ifdef HAVE_FILES_H
  95 # include <Files.h>
  96 #endif
  97 #ifdef HAVE_FCNTL_H
  98 # include <fcntl.h>
  99 #endif
 100 #ifdef HAVE_ERRNO_H
 101 # include <errno.h>
 102 #endif
 103 #ifdef HAVE_STDLIB_H
 104 # include <stdlib.h>
 105 #endif
 106 #ifdef HAVE_UNIX_H
 107 #include <unix.h>
 108 #endif
 109
 110 /* --------------------------------------------------------------------------
 111  * Find information about a file:
 112  * ------------------------------------------------------------------------*/
 113
 114 static Bool local readable      Args((String));
 115
 116 Void getFileInfo(f,tm,sz)  /* find time stamp and size of file*/
 117 String f;
 118 Time   *tm;
 119 Long   *sz; {
 120 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
 121     struct stat scbuf;
 122     if (!stat(f,&scbuf)) {
 123         *tm = scbuf.st_mtime;
 124         *sz = (Long)(scbuf.st_size);
 125     } else {
 126         *tm = 0;
 127         *sz = 0;
 128     }
 129 #else                                   /* normally just use stat()        */
 130     os_regset r;                        /* RISCOS PRM p.850 and p.837      */
 131     r.r[0] = 17;                        /* Read catalogue, no path         */
 132     r.r[1] = (int)s;
 133     os_swi(OS_File, &r);
 134     if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
 135         tm->hi = r.r[2] & 0xFF;         /* Load address (high byte)        */
 136         tm->lo = r.r[3];                /* Execution address (low 4 bytes) */
 137     } else {                            /* Not found, or not time-stamped  */
 138         tm->hi = tm->lo = 0;
 139     }
 140     *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
 141 #endif
 142 }
 143
 144 #if defined HAVE_GETFINFO               /* Mac971031 */
 145 /* --------------------------------------------------------------------------
 146  * Define a MacOS version of access():
 147  *   If the file is not accessible, -1 is returned and errno is set to
 148  * the reason for the failure.
 149  *   If the file is accessible and the dummy is 0 (existence), 2 (write),
 150  * or 4 (read), the return is 0.
 151  *   If the file is accessible, and the dummy is 1 (executable), then if
 152  * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
 153  *   Warnings: Use with caution. UNIX access do no translate to Macs.
 154  * Check of write access is not implemented (same as read).
 155  * ------------------------------------------------------------------------*/
 156
 157 int access(char *fileName, int dummy) {
 158         FInfo   fi;
 159         short   rc;
 160
 161         errno = getfinfo(fileName, 0, &fi);
 162         if (errno != 0)  return -1;             /* Check file accessible. */
 163
 164         /* Cases dummy = existence, read, write. */
 165         if (dummy == 0 || dummy & 0x6)  return 0;
 166
 167         /* Case dummy = executable. */
 168         if (dummy == 1) {
 169                 if (fi.fdType == 'APPL')  return 0;
 170                 errno = fi.fdType;
 171                 return -1;
 172         }
 173
 174         return 0;
 175 }
 176 #endif
 177
 178 static Bool local readable(f)           /* is f a regular, readable file   */
 179 String f; {
 180 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
 181     return (0 == access(f,4));
 182 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
 183     struct stat scbuf;
 184     return (  !stat(f,&scbuf)
 185            && (scbuf.st_mode & S_IREAD) /* readable     */
 186            && (scbuf.st_mode & S_IFREG) /* regular file */
 187            );
 188 #elif defined HAVE_OS_SWI /* RISCOS specific */
 189     os_regset r;                        /* RISCOS PRM p.850     -- JBS     */
 190     assert(dummy == 0);
 191     r.r[0] = 17; /* Read catalogue, no path */
 192     r.r[1] = (int)f;
 193     os_swi(OS_File, &r);
 194     return r.r[0] != 1; /* Does this check it's a regular file? ADR */
 195 #endif
 196 }
 197
 198
 199 /* --------------------------------------------------------------------------
 200  * Search for script files on the HUGS path:
 201  * ------------------------------------------------------------------------*/
 202
 203 static String local hugsdir       Args((Void));
 204 static String local RealPath      Args((String));
 205 static String local normPath      Args((String));
 206 static Void   local searchChr     Args((Int));
 207 static Void   local searchStr     Args((String));
 208 static Bool   local tryEndings    Args((String));
 209
 210 #if DOS_FILENAMES
 211 # define SLASH                   '\\'
 212 # define isSLASH(c)              ((c)=='\\' || (c)=='/')
 213 # define PATHSEP                 ';'
 214 # define DLL_ENDING              ".dll"
 215 #elif MAC_FILENAMES
 216 # define SLASH                   ':'
 217 # define isSLASH(c)              ((c)==SLASH)
 218 # define PATHSEP                 ';'
 219 /* Mac PEF (Preferred Executable Format) file */
 220 # define DLL_ENDING              ".pef"
 221 #else
 222 # define SLASH                   '/'
 223 # define isSLASH(c)              ((c)==SLASH)
 224 # define PATHSEP                 ':'
 225 # define DLL_ENDING              ".so"
 226 #endif
 227
 228 static String local hugsdir() {     /* directory containing lib/Prelude.hs */
 229 #if HAVE_GETMODULEFILENAME && !DOS
 230     /* On Windows, we can find the binary we're running and it's
 231      * conventional to put the libraries in the same place.
 232      */
 233     static char dir[FILENAME_MAX+1] = "";
 234     if (dir[0] == '\0') { /* not initialised yet */
 235         String slash = 0;
 236         GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
 237         if (dir[0] == '\0') { /* GetModuleFileName must have failed */
 238             return HUGSDIR;
 239         }
 240         if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */
 241             *slash = '\0';
 242         }
 243     }
 244     return dir;
 245 #else
 246     /* On Unix systems, we can't find the binary we're running and
 247      * the libraries may not be installed near the binary anyway.
 248      * This forces us to use a hardwired path which is set at
 249      * configuration time (--datadir=...).
 250      */
 251     return HUGSDIR;
 252 #endif
 253 }
 254
 255 static String local RealPath(s)         /* Find absolute pathname of file  */
 256 String s; {
 257 #if HAVE__FULLPATH  /* eg DOS */
 258     static char path[FILENAME_MAX+1];
 259     _fullpath(path,s,FILENAME_MAX+1);
 260 #elif HAVE_REALPATH /* eg Unix */
 261     static char path[MAXPATHLEN+1];
 262     realpath(s,path);
 263 #else
 264     static char path[FILENAME_MAX+1];
 265     strcpy(path,s);
 266 #endif
 267     return path;
 268 }
 269
 270 int pathCmp(p1,p2)                    /* Compare paths after normalisation */
 271 String p1;
 272 String p2; {
 273 #if HAVE__FULLPATH  /* eg DOS */
 274     static char path1[FILENAME_MAX+1];
 275     static char path2[FILENAME_MAX+1];
 276     _fullpath(path1,p1,FILENAME_MAX+1);
 277     _fullpath(path2,p2,FILENAME_MAX+1);
 278 #elif HAVE_REALPATH /* eg Unix */
 279     static char path1[MAXPATHLEN+1];
 280     static char path2[MAXPATHLEN+1];
 281     realpath(p1,path1);
 282     realpath(p2,path2);
 283 #else
 284     static char path1[FILENAME_MAX+1];
 285     static char path2[FILENAME_MAX+1];
 286     strcpy(path1,p1);
 287     strcpy(path2,p2);
 288 #endif
 289 #if CASE_INSENSITIVE_FILENAMES
 290     strlwr(path1);
 291     strlwr(path2);
 292 #endif
 293     return filenamecmp(path1,path2);
 294 }
 295
 296 static String local normPath(s) /* Try, as much as possible, to normalize  */
 297 String s; {                     /* a pathname in some appropriate manner.  */
 298 #if PATH_CANONICALIZATION
 299     String path = RealPath(s);
 300 #if CASE_INSENSITIVE_FILENAMES
 301     strlwr(path);                       /* and convert to lowercase        */
 302 #endif
 303     return path;
 304 #else /* ! PATH_CANONICALIZATION */
 305     return s;
 306 #endif /* ! PATH_CANONICALIZATION */
 307 }
 308
 309 static String endings[] = { "", ".myhi", ".hs", ".lhs", 0 };
 310 static char   searchBuf[FILENAME_MAX+1];
 311 static Int    searchPos;
 312
 313 #define searchReset(n)          searchBuf[searchPos=(n)]='\0'
 314
 315 static Void local searchChr(c)  /* Add single character to search buffer   */
 316 Int c; {
 317     if (searchPos<FILENAME_MAX) {
 318         searchBuf[searchPos++] = c;
 319         searchBuf[searchPos]   = '\0';
 320     }
 321 }
 322
 323 static Void local searchStr(s)  /* Add string to search buffer             */
 324 String s; {
 325     while (*s && searchPos<FILENAME_MAX)
 326         searchBuf[searchPos++] = *s++;
 327     searchBuf[searchPos] = '\0';
 328 }
 329
 330 static Bool local tryEndings(s) /* Try each of the listed endings          */
 331 String s; {
 332     Int i = 0;
 333     searchStr(s);
 334     for (; endings[i]; ++i) {
 335         Int save = searchPos;
 336         searchStr(endings[i]);
 337         if (readable(searchBuf))
 338             return TRUE;
 339         searchReset(save);
 340     }
 341     return FALSE;
 342 }
 343
 344 String findPathname(along,nm)   /* Look for a file along specified path    */
 345 String along;                   /* Return NULL if file does not exist      */
 346 String nm; {
 347     String s = findMPathname(along,nm);
 348     return s ? s : normPath(searchBuf);
 349 }
 350
 351 String findMPathname(along,nm)  /* Look for a file along specified path    */
 352 String along;                   /* If nonzero, a path prefix from along is */
 353 String nm; {                    /* used as the first prefix in the search. */
 354     String pathpt = hugsPath;
 355
 356     searchReset(0);
 357     if (along) {                /* Was a path for an existing file given?  */
 358         Int last = (-1);
 359         Int i    = 0;
 360         for (; along[i]; i++) {
 361             searchChr(along[i]);
 362             if (isSLASH(along[i]))
 363                 last = i;
 364         }
 365         searchReset(last+1);
 366     }
 367     if (tryEndings(nm))
 368         return normPath(searchBuf);
 369
 370     if (pathpt && *pathpt) {    /* Otherwise, we look along the HUGSPATH   */
 371         Bool more = TRUE;
 372         do {
 373             searchReset(0);
 374             if (*pathpt) {
 375                 if (*pathpt!=PATHSEP) {
 376                     /* Pre-define one MPW-style "shell-variable" */
 377                     if (strncmp(pathpt,"{Hugs}",6)==0) {
 378                         searchStr(hugsdir());
 379                         pathpt += 6;
 380                     }
 381                     do
 382                         searchChr(*pathpt++);
 383                     while (*pathpt && *pathpt!=PATHSEP);
 384                     searchChr(SLASH);
 385                 }
 386                 if (*pathpt==PATHSEP)
 387                     pathpt++;
 388                 else
 389                     more = FALSE;
 390             }
 391             else
 392                 more = FALSE;
 393             if (tryEndings(nm))
 394                 return normPath(searchBuf);
 395         } while (more);
 396     }
 397
 398     searchReset(0);  /* As a last resort, look for file in the current dir */
 399     return (tryEndings(nm) ? normPath(searchBuf) : 0);
 400 }
 401
 402 /* --------------------------------------------------------------------------
 403  * Substitute old value of path into empty entries in new path
 404  * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
 405  * ------------------------------------------------------------------------*/
 406
 407 String substPath(new,sub)              /* substitute sub path into new path*/
 408 String new;
 409 String sub; {
 410     Bool   substituted = FALSE;            /*   only allow one replacement */
 411     Int    maxlen      = strlen(sub) + strlen(new);    /* safe upper bound */
 412     String r = (String) malloc(maxlen+1);  /* result string                */
 413     String t = r;                          /* pointer into r               */
 414     String next = new;                     /* next uncopied char in new    */
 415     String start = next;                   /* start of last path component */
 416     if (r == 0) {
 417         ERRMSG(0) "String storage space exhausted"
 418         EEND;
 419     }
 420     do {
 421         if (*next == PATHSEP || *next == '\0') {
 422             if (!substituted && next == start) {
 423                 String s = sub;
 424                 for(; *s != '\0'; ++s) {
 425                     *t++ = *s;
 426                 }
 427                 substituted = TRUE;
 428             }
 429             start = next+1;
 430         }
 431     } while ((*t++ = *next++) != '\0');
 432     return r;
 433 }
 434
 435
 436 /* --------------------------------------------------------------------------
 437  * Garbage collection notification:
 438  * ------------------------------------------------------------------------*/
 439
 440 Bool gcMessages = FALSE;                /* TRUE => print GC messages       */
 441
 442 Void gcStarted() {                      /* notify garbage collector start  */
 443 #if HUGS_FOR_WINDOWS
 444     SaveCursor = SetCursor(GarbageCursor);
 445 #endif
 446     if (gcMessages) {
 447         printf("{{Gc");
 448         FlushStdout();
 449     }
 450 }
 451
 452 Void gcScanning() {                     /* notify garbage collector scans  */
 453     if (gcMessages) {
 454         Putchar(':');
 455         FlushStdout();
 456     }
 457 }
 458
 459 Void gcRecovered(recovered)             /* notify garbage collection done  */
 460 Int recovered; {
 461     if (gcMessages) {
 462         printf("%d}}",recovered);
 463         fflush(stdout);
 464     }
 465 #if HUGS_FOR_WINDOWS
 466     SetCursor(SaveCursor);
 467 #endif
 468 }
 469
 470 Cell *CStackBase;                       /* Retain start of C control stack */
 471
 472 #if RISCOS                              /* Stack traversal for RISCOS      */
 473
 474 /* Warning: The following code is specific to the Acorn ARM under RISCOS
 475    (and C4).  We must explicitly walk back through the stack frames, since
 476    the stack is extended from the heap. (see PRM pp. 1757).  gcCStack must
 477    not be modified, since the offset '5' assumes that only v1 is used inside
 478    this function. Hence we do all the real work in gcARM.
 479 */
 480
 481 #define spreg 13 /* C3 has SP=R13 */
 482
 483 #define previousFrame(fp)       ((int *)((fp)[-3]))
 484 #define programCounter(fp)      ((int *)((*(fp)-12) & ~0xFC000003))
 485 #define isSubSPSP(w)            (((w)&dontCare) == doCare)
 486 #define doCare                  (0xE24DD000)  /* SUB r13,r13,#0 */
 487 #define dontCare                (~0x00100FFF) /* S and # bits   */
 488 #define immediateArg(x)         ( ((x)&0xFF) << (((x)&0xF00)>>7) )
 489
 490 static void gcARM(int *fp) {
 491     int si = *programCounter(fp);       /* Save instruction indicates how */
 492                                         /* many registers in this frame   */
 493     int *regs = fp - 4;
 494     if (si & (1<<0)) markWithoutMove(*regs--);
 495     if (si & (1<<1)) markWithoutMove(*regs--);
 496     if (si & (1<<2)) markWithoutMove(*regs--);
 497     if (si & (1<<3)) markWithoutMove(*regs--);
 498     if (si & (1<<4)) markWithoutMove(*regs--);
 499     if (si & (1<<5)) markWithoutMove(*regs--);
 500     if (si & (1<<6)) markWithoutMove(*regs--);
 501     if (si & (1<<7)) markWithoutMove(*regs--);
 502     if (si & (1<<8)) markWithoutMove(*regs--);
 503     if (si & (1<<9)) markWithoutMove(*regs--);
 504     if (previousFrame(fp)) {
 505         /* The non-register stack space is for the previous frame is above
 506            this fp, and not below the previous fp, because of the way stack
 507            extension works. It seems the only way of discovering its size is
 508            finding the SUB sp, sp, #? instruction by walking through the code
 509            following the entry point.
 510         */
 511         int *oldpc = programCounter(previousFrame(fp));
 512         int fsize = 0, i;
 513         for(i = 1; i < 6; ++i)
 514             if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
 515         for(i=1; i<=fsize; ++i)
 516             markWithoutMove(fp[i]);
 517     }
 518 }
 519
 520 void gcCStack() {
 521     int dummy;
 522     int *fp = 5 + &dummy;
 523     while (fp) {
 524         gcARM(fp);
 525         fp = previousFrame(fp);
 526     }
 527 }
 528
 529 #else                   /* Garbage collection for standard stack machines  */
 530
 531 Void gcCStack() {                       /* Garbage collect elements off    */
 532     Cell stackTop = NIL;                /* C stack                         */
 533     Cell *ptr = &stackTop;
 534 #if SIZEOF_INTP == 2
 535     if (((long)(ptr) - (long)(CStackBase))&1)
 536         fatal("gcCStack");
 537 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 538     if (((long)(ptr) - (long)(CStackBase))&1)
 539         fatal("gcCStack");
 540 #else
 541     if (((long)(ptr) - (long)(CStackBase))&3)
 542         fatal("gcCStack");
 543 #endif
 544
 545 #define StackGrowsDown  while (ptr<=CStackBase) markWithoutMove(*ptr++)
 546 #define StackGrowsUp    while (ptr>=CStackBase) markWithoutMove(*ptr--)
 547 #define GuessDirection  if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown
 548
 549 #if STACK_DIRECTION > 0
 550     StackGrowsUp;
 551 #elif STACK_DIRECTION < 0
 552     StackGrowsDown;
 553 #else
 554     GuessDirection;
 555 #endif
 556
 557 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
 558     ptr = (Cell *)((long)(&stackTop) + 2);
 559     StackGrowsDown;
 560 #endif
 561
 562 #undef  StackGrowsDown
 563 #undef  StackGrowsUp
 564 #undef  GuessDirection
 565 }
 566 #endif
 567
 568 /* --------------------------------------------------------------------------
 569  * Terminal dependent stuff:
 570  * ------------------------------------------------------------------------*/
 571
 572 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
 573
 574 /* This is believed to be redundant! ADR */
 575 #if HAVE_SYS_IOCTL_H
 576 # include <sys/ioctl.h>
 577 #endif
 578
 579 /* The order of these three tests is very important because
 580  * some systems have more than one of the requisite header file
 581  * but only one of them seems to work.
 582  * Anyone changing the order of the tests should try enabling each of the
 583  * three branches in turn and write down which ones work as well as which
 584  * OS/compiler they're using.
 585  *
 586  * OS            Compiler      sgtty     termio  termios   notes
 587  * Linux 2.0.18  gcc 2.7.2     absent    works   works     1
 588  *
 589  * Notes:
 590  * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
 591  *    implemented using termios.h.
 592  *    sgtty.h is in /usr/include/bsd which is not on my standard include
 593  *    path.  Adding it does no harm but you might as well use termios.
 594  *    --
 595  *    reid-alastair@cs.yale.edu
 596  */
 597 #if HAVE_TERMIOS_H
 598
 599 #include <termios.h>
 600 typedef  struct termios  TermParams;
 601 #define  getTerminal(tp) tcgetattr(fileno(stdin), &tp)
 602 #define  setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
 603 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 604                          tp.c_cc[VMIN]  = 1;                \
 605                          tp.c_cc[VTIME] = 0;
 606
 607 #elif HAVE_SGTTY_H
 608
 609 #include <sgtty.h>
 610 typedef  struct sgttyb   TermParams;
 611 #define  getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
 612 #define  setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
 613 #if HPUX
 614 #define  noEcho(tp)      tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
 615 #else
 616 #define  noEcho(tp)      tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
 617 #endif
 618
 619 #elif HAVE_TERMIO_H
 620
 621 #include <termio.h>
 622 typedef  struct termio   TermParams;
 623 #define  getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
 624 #define  setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
 625 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
 626                          tp.c_cc[VMIN]  = 1;                \
 627                          tp.c_cc[VTIME] = 0;
 628
 629 #endif
 630
 631 static Bool messedWithTerminal = FALSE;
 632 static TermParams originalSettings;
 633
 634 Void normalTerminal() {                 /* restore terminal initial state  */
 635     if (messedWithTerminal)
 636         setTerminal(originalSettings);
 637 }
 638
 639 Void noechoTerminal() {                 /* set terminal into noecho mode   */
 640     TermParams settings;
 641
 642     if (!messedWithTerminal) {
 643         getTerminal(originalSettings);
 644         messedWithTerminal = TRUE;
 645     }
 646     getTerminal(settings);
 647     noEcho(settings);
 648     setTerminal(settings);
 649 }
 650
 651 Int getTerminalWidth() {                /* determine width of terminal     */
 652 #ifdef TIOCGWINSZ
 653 #ifdef _M_UNIX                          /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
 654 #include <sys/stream.h>                 /* Required by sys/ptem.h          */
 655 #include <sys/ptem.h>                   /* Required to declare winsize     */
 656 #endif
 657     static struct winsize terminalSize;
 658     ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
 659     return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
 660 #else
 661     return 80;
 662 #endif
 663 }
 664
 665 Int readTerminalChar() {                /* read character from terminal    */
 666     return getchar();                   /* without echo, assuming that     */
 667 }                                       /* noechoTerminal() is active...   */
 668
 669 #elif SYMANTEC_C
 670
 671 Int readTerminalChar() {                /* read character from terminal    */
 672     return getchar();                   /* without echo, assuming that     */
 673 }                                       /* noechoTerminal() is active...   */
 674
 675 Int getTerminalWidth() {
 676     return console_options.ncols;
 677 }
 678
 679 Void normalTerminal() {
 680     csetmode(C_ECHO, stdin);
 681 }
 682
 683 Void noechoTerminal() {
 684     csetmode(C_NOECHO, stdin);
 685 }
 686
 687 #else /* no terminal driver - eg DOS, RISCOS */
 688
 689 static Bool terminalEchoReqd = TRUE;
 690
 691 Int getTerminalWidth() {
 692 #if RISCOS
 693     int dummy, width;
 694     (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
 695     return width+1;
 696 #else
 697     return 80;
 698 #endif
 699 }
 700
 701 Void normalTerminal() {                 /* restore terminal initial state  */
 702     terminalEchoReqd = TRUE;
 703 }
 704
 705 Void noechoTerminal() {                 /* turn terminal echo on/off       */
 706     terminalEchoReqd = FALSE;
 707 }
 708
 709 Int readTerminalChar() {                /* read character from terminal    */
 710     if (terminalEchoReqd) {
 711         return getchar();
 712     } else {
 713         Int c = getch();
 714         return c=='\r' ? '\n' : c;      /* slight paranoia about CR-LF    */
 715     }
 716 }
 717
 718 #endif /* no terminal driver */
 719
 720 /* --------------------------------------------------------------------------
 721  * Interrupt handling:
 722  * ------------------------------------------------------------------------*/
 723
 724 Bool    broken         = FALSE;
 725 static  Bool breakReqd = FALSE;
 726 static  sigProto(ignoreBreak);
 727 static  Void local installHandlers Args((Void));
 728
 729 Bool breakOn(reqd)                      /* set break trapping on if reqd,  */
 730 Bool reqd; {                            /* or off otherwise, returning old */
 731     Bool old  = breakReqd;
 732
 733     breakReqd = reqd;
 734     if (reqd) {
 735         if (broken) {                   /* repond to break signal received */
 736             broken = FALSE;             /* whilst break trap disabled      */
 737             sigRaise(breakHandler);
 738         }
 739         ctrlbrk(ignoreBreak);
 740     } else {
 741         ctrlbrk(ignoreBreak);
 742     }
 743     return old;
 744 }
 745
 746 static sigHandler(ignoreBreak) {        /* record but don't respond to break*/
 747     ctrlbrk(ignoreBreak);
 748     broken = TRUE;
 749     interruptStgRts();
 750     sigResume;
 751 }
 752
 753 #if !DONT_PANIC
 754 static sigProto(panic);
 755 static sigHandler(panic) {              /* exit in a panic, on receipt of  */
 756     everybody(EXIT);                    /* an unexpected signal            */
 757     fprintf(stderr,"\nUnexpected signal\n");
 758     exit(1);
 759     sigResume;/*NOTREACHED*/
 760 }
 761 #endif /* !DONT_PANIC */
 762
 763 static Void local installHandlers() { /* Install handlers for all fatal    */
 764                                       /* signals except SIGINT and SIGBREAK*/
 765 #if !DONT_PANIC && !DOS
 766 # ifdef SIGABRT
 767     signal(SIGABRT,panic);
 768 # endif
 769 # ifdef SIGBUS
 770     signal(SIGBUS,panic);
 771 # endif
 772 # ifdef SIGFPE
 773     signal(SIGFPE,panic);
 774 # endif
 775 # ifdef SIGHUP
 776     signal(SIGHUP,panic);
 777 # endif
 778 # ifdef SIGILL
 779     signal(SIGILL,panic);
 780 # endif
 781 # ifdef SIGQUIT
 782     signal(SIGQUIT,panic);
 783 # endif
 784 # ifdef SIGSEGV
 785     signal(SIGSEGV,panic);
 786 # endif
 787 # ifdef SIGTERM
 788     signal(SIGTERM,panic);
 789 # endif
 790 #endif /* !DONT_PANIC && !DOS */
 791 }
 792
 793 /* --------------------------------------------------------------------------
 794  * Shell escapes:
 795  * ------------------------------------------------------------------------*/
 796
 797 Bool startEdit(line,nm)                 /* Start editor on file name at    */
 798 Int    line;                            /* given line.  Both name and line */
 799 String nm; {                            /* or just line may be zero        */
 800     static char editorCmd[FILENAME_MAX+1];
 801
 802 #if !SYMANTEC_C
 803     if (hugsEdit && *hugsEdit) {        /* Check that editor configured    */
 804 #else
 805     /* On a Mac, files have creator information, telling which program
 806        to launch to, so an editor named to the empty string "" is often
 807        desirable. */
 808     if (hugsEdit) {        /* Check that editor configured    */
 809 #endif
 810         Int n     = FILENAME_MAX;
 811         String he = hugsEdit;
 812         String ec = editorCmd;
 813         String rd = NULL;               /* Set to nonnull to redo ...      */
 814
 815         for (; n>0 && *he && *he!=' '; n--)
 816             *ec++ = *he++;              /* Copy editor name to buffer      */
 817                                         /* assuming filename ends at space */
 818
 819         if (nm && line && n>1 && *he){  /* Name, line, and enough space    */
 820             rd = ec;                    /* save, in case we don't find name*/
 821             while (n>0 && *he) {
 822                 if (*he=='%') {
 823                     if (*++he=='d' && n>10) {
 824                         sprintf(ec,"%d",line);
 825                         he++;
 826                     }
 827                     else if (*he=='s' && (size_t)n>strlen(nm)) {
 828                         strcpy(ec,nm);
 829                         rd = NULL;
 830                         he++;
 831                     }
 832                     else if (*he=='%' && n>1) {
 833                         strcpy(ec,"%");
 834                         he++;
 835                     }
 836                     else                /* Ignore % char if not followed   */
 837                         *ec = '\0';     /* by one of d, s, or %,           */
 838                     for (; *ec && n>0; n--)
 839                         ec++;
 840                 }   /* ignore % followed by anything other than d, s, or % */
 841                 else {                  /* Copy other characters across    */
 842                     *ec++ = *he++;
 843                     n--;
 844                 }
 845             }
 846         }
 847         else
 848             line = 0;
 849
 850         if (rd) {                       /* If file name was not included   */
 851             ec   = rd;
 852             line = 0;
 853         }
 854
 855         if (nm && line==0 && n>1) {     /* Name, but no line ...           */
 856             *ec++ = ' ';
 857             for (; n>0 && *nm; n--)     /* ... just copy file name         */
 858                 *ec++ = *nm++;
 859         }
 860
 861         *ec = '\0';                     /* Add terminating null byte       */
 862     }
 863     else {
 864         ERRMSG(0) "Hugs is not configured to use an editor"
 865         EEND;
 866     }
 867
 868 #if HAVE_WINEXEC
 869     WinExec(editorCmd, SW_SHOW);
 870     return FALSE;
 871 #else
 872     if (shellEsc(editorCmd))
 873         Printf("Warning: Editor terminated abnormally\n");
 874     return TRUE;
 875 #endif
 876 }
 877
 878 Int shellEsc(s)                         /* run a shell command (or shell)  */
 879 String s; {
 880 #if HAVE_MACSYSTEM
 881     return macsystem(s);
 882 #else
 883 #if HAVE_BIN_SH
 884     if (s[0]=='\0') {
 885         s = fromEnv("SHELL","/bin/sh");
 886     }
 887 #endif
 888     return system(s);
 889 #endif
 890 }
 891
 892 #if RISCOS                              /* RISCOS also needs a chdir()     */
 893 int chdir(char *s) {                    /* RISCOS PRM p. 885    -- JBS     */
 894     return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
 895 }
 896 #elif defined HAVE_PBHSETVOLSYNC        /* Macintosh */
 897 int chdir(const char *s) {
 898     char* str;
 899     WDPBRec wd;
 900     wd.ioCompletion = 0;
 901     str = (char*)malloc(strlen(s) + 1);
 902     if (str == 0) return -1;
 903     strcpy(str, s);
 904     wd.ioNamePtr = C2PStr(str);
 905     wd.ioVRefNum = 0;
 906     wd.ioWDDirID = 0;
 907     errno = PBHSetVolSync(&wd);
 908     free(str);
 909     if (errno == 0) {
 910         return 0;
 911     } else {
 912         return -1;
 913     }
 914 }
 915 #endif
 916
 917
 918 /*---------------------------------------------------------------------------
 919  * Printf-related operations:
 920  *-------------------------------------------------------------------------*/
 921
 922 #if !defined(HAVE_VSNPRINTF)
 923 int vsnprintf(buffer, count, fmt, ap)
 924 char*       buffer;
 925 int         count;
 926 const char* fmt;
 927 va_list     ap; {
 928 #if defined(HAVE__VSNPRINTF)
 929     return _vsnprintf(buffer, count, fmt, ap);
 930 #else
 931     return 0;
 932 #endif
 933 }
 934 #endif /* HAVE_VSNPRINTF */
 935
 936 #if !defined(HAVE_SNPRINTF)
 937 int snprintf(char* buffer, int count, const char* fmt, ...) {
 938 #if defined(HAVE__VSNPRINTF)
 939     int r;
 940     va_list ap;                    /* pointer into argument list           */
 941     va_start(ap, fmt);             /* make ap point to first arg after fmt */
 942     r = vsnprintf(buffer, count, fmt, ap);
 943     va_end(ap);                    /* clean up                             */
 944     return r;
 945 #else
 946     return 0;
 947 #endif
 948 }
 949 #endif /* HAVE_SNPRINTF */
 950
 951 /* --------------------------------------------------------------------------
 952  * Read/write values from/to the registry
 953  *
 954  * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
 955  * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key.  (Machine entry is only used if
 956  * user entry doesn't exist).
 957  *
 958  * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
 959  * ------------------------------------------------------------------------*/
 960
 961 #if USE_REGISTRY
 962
 963 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
 964
 965 static Bool   local createKey      Args((HKEY, PHKEY, REGSAM));
 966 static Bool   local queryValue     Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
 967 static Bool   local setValue       Args((HKEY, String, DWORD, LPBYTE, DWORD));
 968
 969 static Bool local createKey(hKey, phRootKey, samDesired)
 970 HKEY    hKey;
 971 PHKEY   phRootKey;
 972 REGSAM  samDesired; {
 973     DWORD  dwDisp;
 974     return RegCreateKeyEx(hKey, HugsRoot,
 975                           0, "", REG_OPTION_NON_VOLATILE,
 976                           samDesired, NULL, phRootKey, &dwDisp)
 977            == ERROR_SUCCESS;
 978 }
 979
 980 static Bool local queryValue(hKey, var, type, buf, bufSize)
 981 HKEY    hKey;
 982 String  var;
 983 LPDWORD type;
 984 LPBYTE  buf;
 985 DWORD   bufSize; {
 986     HKEY hRootKey;
 987
 988     if (!createKey(hKey, &hRootKey, KEY_READ)) {
 989         return FALSE;
 990     } else {
 991         LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
 992         RegCloseKey(hRootKey);
 993         return (res == ERROR_SUCCESS);
 994     }
 995 }
 996
 997 static Bool local setValue(hKey, var, type, buf, bufSize)
 998 HKEY   hKey;
 999 String var;
1000 DWORD  type;
1001 LPBYTE buf;
1002 DWORD  bufSize; {
1003     HKEY hRootKey;
1004
1005     if (!createKey(hKey, &hRootKey, KEY_WRITE)) {
1006         return FALSE;
1007     } else {
1008         LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1009         RegCloseKey(hRootKey);
1010         return (res == ERROR_SUCCESS);
1011     }
1012 }
1013
1014 String readRegString(var,def)    /* read String from registry */
1015 String var;
1016 String def; {
1017     static char  buf[300];
1018     DWORD type;
1019
1020     if (queryValue(HKEY_CURRENT_USER, var, &type, buf, sizeof(buf))
1021         && type == REG_SZ) {
1022         return (String)buf;
1023     } else if (queryValue(HKEY_LOCAL_MACHINE, var, &type, buf, sizeof(buf))
1024                && type == REG_SZ) {
1025         return (String)buf;
1026     } else {
1027         return NULL;
1028     }
1029 }
1030
1031 Int readRegInt(var, def)            /* read Int from registry */
1032 String var;
1033 Int    def; {
1034     DWORD buf;
1035     DWORD type;
1036
1037     if (queryValue(HKEY_CURRENT_USER, var, &type,
1038                    (LPBYTE)&buf, sizeof(buf))
1039         && type == REG_DWORD) {
1040         return (Int)buf;
1041     } else if (queryValue(HKEY_LOCAL_MACHINE, var, &type,
1042                           (LPBYTE)&buf, sizeof(buf))
1043                && type == REG_DWORD) {
1044         return (Int)buf;
1045     } else {
1046         return def;
1047     }
1048 }
1049
1050 Bool writeRegString(var,val)      /* write String to registry */
1051 String var;
1052 String val; {
1053     if (NULL == val) {
1054         val = "";
1055     }
1056     return setValue(HKEY_CURRENT_USER, var,
1057                     REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1058 }
1059
1060 Bool writeRegInt(var,val)         /* write String to registry */
1061 String var;
1062 Int    val; {
1063     return setValue(HKEY_CURRENT_USER, var,
1064                     REG_DWORD, (LPBYTE)&val, sizeof(val));
1065 }
1066
1067 #endif /* USE_REGISTRY */
1068
1069 /* --------------------------------------------------------------------------
1070  * Machine dependent control:
1071  * ------------------------------------------------------------------------*/
1072
1073 Void machdep(what)                      /* Handle machine specific         */
1074 Int what; {                             /* initialisation etc..            */
1075     switch (what) {
1076         case MARK    : break;
1077         case INSTALL : installHandlers();
1078                        break;
1079         case RESET   :
1080         case BREAK   :
1081         case EXIT    : normalTerminal();
1082 #if HUGS_FOR_WINDOWS
1083                        if (what==EXIT)
1084                            DestroyWindow(hWndMain);
1085                        else
1086                            SetCursor(LoadCursor(NULL,IDC_ARROW));
1087 #endif
1088                        break;
1089     }
1090 }
1091
1092 /*-------------------------------------------------------------------------*/