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)
9 * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
10 * Haskell Group 1994-99, and is distributed as Open Source software
11 * under the Artistic License; see the file "Artistic" that is included
12 * in the distribution for details.
14 * $RCSfile: machdep.c,v $
16 * $Date: 1999/02/03 17:08:32 $
17 * ------------------------------------------------------------------------*/
22 #ifdef HAVE_SYS_TYPES_H
23 # include <sys/types.h>
30 # include <sys/param.h>
32 #ifdef HAVE_SYS_STAT_H
33 # include <sys/stat.h>
43 /* Windows/DOS include files */
47 #if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS
64 extern HCURSOR HandCursor; /* Forward references to cursors */
65 extern HCURSOR GarbageCursor;
66 extern HCURSOR SaveCursor;
67 static void local DrawStatusLine Args((HWND));
72 extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */
80 /* Macintosh include files */
103 /* --------------------------------------------------------------------------
104 * Prototypes for registry reading
105 * ------------------------------------------------------------------------*/
109 /* where have we hidden things in the registry? */
111 #define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\")
114 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
115 #define ProjectRoot ("SOFTWARE\\Haskell\\Hugs\\Projects\\")
117 static Bool local createKey Args((HKEY, String, PHKEY, REGSAM));
118 static Bool local queryValue Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD));
119 static Bool local setValue Args((HKEY, String, String, DWORD, LPBYTE, DWORD));
120 static String local readRegString Args((HKEY, String, String, String));
121 static Int local readRegInt Args((String,Int));
122 static Bool local writeRegString Args((String,String));
123 static Bool local writeRegInt Args((String,Int));
125 static String local readRegChildStrings Args((HKEY, String, String, Char, String));
126 #endif /* USE_REGISTRY */
128 /* --------------------------------------------------------------------------
129 * Find information about a file:
130 * ------------------------------------------------------------------------*/
133 typedef struct { unsigned hi, lo; } Time;
134 #define timeChanged(now,thn) (now.hi!=thn.hi || now.lo!=thn.lo)
135 #define timeSet(var,tm) var.hi = tm.hi; var.lo = tm.lo
138 #define timeChanged(now,thn) (now!=thn)
139 #define timeSet(var,tm) var = tm
142 static Void local getFileInfo Args((String, Time *, Long *));
143 static Bool local readable Args((String));
145 static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/
149 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
151 if (!stat(f,&scbuf)) {
152 *tm = scbuf.st_mtime;
153 *sz = (Long)(scbuf.st_size);
158 #else /* normally just use stat() */
159 os_regset r; /* RISCOS PRM p.850 and p.837 */
160 r.r[0] = 17; /* Read catalogue, no path */
163 if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
164 tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
165 tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
166 } else { /* Not found, or not time-stamped */
169 *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
173 #if defined HAVE_GETFINFO /* Mac971031 */
174 /* --------------------------------------------------------------------------
175 * Define a MacOS version of access():
176 * If the file is not accessible, -1 is returned and errno is set to
177 * the reason for the failure.
178 * If the file is accessible and the dummy is 0 (existence), 2 (write),
179 * or 4 (read), the return is 0.
180 * If the file is accessible, and the dummy is 1 (executable), then if
181 * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
182 * Warnings: Use with caution. UNIX access do no translate to Macs.
183 * Check of write access is not implemented (same as read).
184 * ------------------------------------------------------------------------*/
186 int access(char *fileName, int dummy) {
190 errno = getfinfo(fileName, 0, &fi);
191 if (errno != 0) return -1; /* Check file accessible. */
193 /* Cases dummy = existence, read, write. */
194 if (dummy == 0 || dummy & 0x6) return 0;
196 /* Case dummy = executable. */
198 if (fi.fdType == 'APPL') return 0;
207 static Bool local readable(f) /* is f a regular, readable file */
209 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
210 return (0 == access(f,4));
211 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
213 return ( !stat(f,&scbuf)
214 && (scbuf.st_mode & S_IREAD) /* readable */
215 && (scbuf.st_mode & S_IFREG) /* regular file */
217 #elif defined HAVE_OS_SWI /* RISCOS specific */
218 os_regset r; /* RISCOS PRM p.850 -- JBS */
220 r.r[0] = 17; /* Read catalogue, no path */
223 return r.r[0] != 1; /* Does this check it's a regular file? ADR */
228 /* --------------------------------------------------------------------------
229 * Search for script files on the HUGS path:
230 * ------------------------------------------------------------------------*/
232 static String local hugsdir Args((Void));
234 static String local hscriptDir Args((Void));
236 static String local RealPath Args((String));
237 static int local pathCmp Args((String, String));
238 static String local normPath Args((String));
239 static Void local searchChr Args((Int));
240 static Void local searchStr Args((String));
241 static Bool local tryEndings Args((String));
245 # define isSLASH(c) ((c)=='\\' || (c)=='/')
247 # define DLL_ENDING ".dll"
250 # define isSLASH(c) ((c)==SLASH)
252 /* Mac PEF (Preferred Executable Format) file */
253 # define DLL_ENDING ".pef"
256 # define isSLASH(c) ((c)==SLASH)
258 # define DLL_ENDING ".so"
261 static String local hugsdir() { /* directory containing lib/Prelude.hs */
263 /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
264 static char dir[FILENAME_MAX+1] = "";
265 if (dir[0] == '\0') { /* not initialised yet */
266 String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
273 #elif HAVE_GETMODULEFILENAME && !DOS
274 /* On Windows, we can find the binary we're running and it's
275 * conventional to put the libraries in the same place.
277 static char dir[FILENAME_MAX+1] = "";
278 if (dir[0] == '\0') { /* not initialised yet */
280 GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
281 if (dir[0] == '\0') { /* GetModuleFileName must have failed */
284 if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */
290 /* On Unix systems, we can't find the binary we're running and
291 * the libraries may not be installed near the binary anyway.
292 * This forces us to use a hardwired path which is set at
293 * configuration time (--datadir=...).
300 static String local hscriptDir() { /* directory containing ?? what Daan? */
301 static char dir[FILENAME_MAX+1] = "";
302 if (dir[0] == '\0') { /* not initialised yet */
303 String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
313 static String local RealPath(s) /* Find absolute pathname of file */
315 #if HAVE__FULLPATH /* eg DOS */
316 static char path[FILENAME_MAX+1];
317 _fullpath(path,s,FILENAME_MAX+1);
318 #elif HAVE_REALPATH /* eg Unix */
319 static char path[MAXPATHLEN+1];
322 static char path[FILENAME_MAX+1];
328 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
331 #if HAVE__FULLPATH /* eg DOS */
332 static char path1[FILENAME_MAX+1];
333 static char path2[FILENAME_MAX+1];
334 _fullpath(path1,p1,FILENAME_MAX+1);
335 _fullpath(path2,p2,FILENAME_MAX+1);
336 #elif HAVE_REALPATH /* eg Unix */
337 static char path1[MAXPATHLEN+1];
338 static char path2[MAXPATHLEN+1];
342 static char path1[FILENAME_MAX+1];
343 static char path2[FILENAME_MAX+1];
347 #if CASE_INSENSITIVE_FILENAMES
351 return filenamecmp(path1,path2);
354 static String local normPath(s) /* Try, as much as possible, to normalize */
355 String s; { /* a pathname in some appropriate manner. */
356 #if PATH_CANONICALIZATION
357 String path = RealPath(s);
358 #if CASE_INSENSITIVE_FILENAMES
359 strlwr(path); /* and convert to lowercase */
362 #else /* ! PATH_CANONICALIZATION */
364 #endif /* ! PATH_CANONICALIZATION */
368 static String endings[] = { "", ".hs", ".lhs", ".hsx", ".hash", 0 };
370 static String endings[] = { "", ".hs", ".lhs", 0 };
372 static char searchBuf[FILENAME_MAX+1];
373 static Int searchPos;
375 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
377 static Void local searchChr(c) /* Add single character to search buffer */
379 if (searchPos<FILENAME_MAX) {
380 searchBuf[searchPos++] = (char)c;
381 searchBuf[searchPos] = '\0';
385 static Void local searchStr(s) /* Add string to search buffer */
387 while (*s && searchPos<FILENAME_MAX)
388 searchBuf[searchPos++] = *s++;
389 searchBuf[searchPos] = '\0';
392 static Bool local tryEndings(s) /* Try each of the listed endings */
396 for (; endings[i]; ++i) {
397 Int save = searchPos;
398 searchStr(endings[i]);
399 if (readable(searchBuf))
410 /* scandir, June 98 Daan Leijen
411 searches the base directory and its direct subdirectories for a file
413 input: searchbuf contains SLASH terminated base directory
414 argument s contains the (base) filename
415 output: TRUE: searchBuf contains the full filename
416 FALSE: searchBuf is garbage, file not found
420 #ifdef HAVE_WINDOWS_H
422 static Bool scanSubDirs(s)
425 struct _finddata_t findInfo;
430 /* is it in the current directory ? */
431 if (tryEndings(s)) return TRUE;
436 /* initiate the search */
437 handle = _findfirst( searchBuf, &findInfo );
438 if (handle==-1) { errno = 0; return FALSE; }
440 /* search all subdirectories */
442 /* if we have a valid sub directory */
443 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
444 (findInfo.name[0] != '.')) {
446 searchStr(findInfo.name);
452 } while (_findnext( handle, &findInfo ) == 0);
454 _findclose( handle );
458 #elif defined(HAVE_FTW_H)
462 static char baseFile[FILENAME_MAX+1];
463 static char basePath[FILENAME_MAX+1];
464 static int basePathLen;
466 static int scanitem( const char* path,
467 const struct stat* statinfo,
470 if (info == FTW_D) { /* is it a directory */
474 if (tryEndings(baseFile)) {
481 static Bool scanSubDirs(s)
486 strcpy(basePath,searchBuf);
487 basePathLen = strlen(basePath);
489 /* is it in the current directory ? */
490 if (tryEndings(s)) return TRUE;
492 /* otherwise scan the subdirectories */
493 r = ftw( basePath, scanitem, 2 );
498 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
499 #endif /* SEARCH_DIR */
501 String findPathname(along,nm) /* Look for a file along specified path */
502 String along; /* Return NULL if file does not exist */
504 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
505 String s = findMPathname(along,nm,hugsPath);
510 s = findMPathname(along,nm,projectPath);
513 #endif /* USE_REGISTRY */
514 return s ? s : normPath(searchBuf);
517 /* AC, 1/21/99: modified to pass in path to search explicitly */
518 String findMPathname(along,nm,path)/* Look for a file along specified path */
519 String along; /* If nonzero, a path prefix from along is */
520 String nm; /* used as the first prefix in the search. */
522 String pathpt = path;
525 if (along) { /* Was a path for an existing file given? */
528 for (; along[i]; i++) {
530 if (isSLASH(along[i]))
536 return normPath(searchBuf);
538 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
541 Bool recurse = FALSE; /* DL: shall we recurse ? */
544 if (*pathpt!=PATHSEP) {
545 /* Pre-define one MPW-style "shell-variable" */
546 if (strncmp(pathpt,"{Hugs}",6)==0) {
547 searchStr(hugsdir());
551 /* And another - we ought to generalise this stuff */
552 else if (strncmp(pathpt,"{HScript}",9)==0) {
553 searchStr(hscriptDir());
558 searchChr(*pathpt++);
559 } while (*pathpt && *pathpt!=PATHSEP);
560 recurse = (pathpt[-1] == SLASH);
565 if (*pathpt==PATHSEP)
573 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
574 return normPath(searchBuf);
577 if (tryEndings(nm)) {
578 return normPath(searchBuf);
584 searchReset(0); /* As a last resort, look for file in the current dir */
585 return (tryEndings(nm) ? normPath(searchBuf) : 0);
588 /* --------------------------------------------------------------------------
589 * Substitute old value of path into empty entries in new path
590 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
591 * ------------------------------------------------------------------------*/
593 static String local substPath Args((String,String));
595 static String local substPath(new,sub) /* substitute sub path into new path*/
598 Bool substituted = FALSE; /* only allow one replacement */
599 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
600 String r = (String) malloc(maxlen+1); /* result string */
601 String t = r; /* pointer into r */
602 String next = new; /* next uncopied char in new */
603 String start = next; /* start of last path component */
605 ERRMSG(0) "String storage space exhausted"
609 if (*next == PATHSEP || *next == '\0') {
610 if (!substituted && next == start) {
612 for(; *s != '\0'; ++s) {
619 } while ((*t++ = *next++) != '\0');
624 /* --------------------------------------------------------------------------
625 * Get time/date stamp for inclusion in compiled files:
626 * ------------------------------------------------------------------------*/
629 String timeString() { /* return time&date string */
630 time_t clock; /* must end with '\n' character */
632 return(ctime(&clock));
636 /* --------------------------------------------------------------------------
637 * Garbage collection notification:
638 * ------------------------------------------------------------------------*/
640 Bool gcMessages = FALSE; /* TRUE => print GC messages */
642 Void gcStarted() { /* Notify garbage collector start */
644 SaveCursor = SetCursor(GarbageCursor);
652 Void gcScanning() { /* Notify garbage collector scans */
659 Void gcRecovered(recovered) /* Notify garbage collection done */
662 Printf("%d}}",recovered);
666 SetCursor(SaveCursor);
670 Cell *CStackBase; /* Retain start of C control stack */
672 #if RISCOS /* Stack traversal for RISCOS */
674 /* Warning: The following code is specific to the Acorn ARM under RISCOS
675 (and C4). We must explicitly walk back through the stack frames, since
676 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
677 not be modified, since the offset '5' assumes that only v1 is used inside
678 this function. Hence we do all the real work in gcARM.
681 #define spreg 13 /* C3 has SP=R13 */
683 #define previousFrame(fp) ((int *)((fp)[-3]))
684 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
685 #define isSubSPSP(w) (((w)&dontCare) == doCare)
686 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
687 #define dontCare (~0x00100FFF) /* S and # bits */
688 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
690 static void gcARM(int *fp) {
691 int si = *programCounter(fp); /* Save instruction indicates how */
692 /* many registers in this frame */
694 if (si & (1<<0)) markWithoutMove(*regs--);
695 if (si & (1<<1)) markWithoutMove(*regs--);
696 if (si & (1<<2)) markWithoutMove(*regs--);
697 if (si & (1<<3)) markWithoutMove(*regs--);
698 if (si & (1<<4)) markWithoutMove(*regs--);
699 if (si & (1<<5)) markWithoutMove(*regs--);
700 if (si & (1<<6)) markWithoutMove(*regs--);
701 if (si & (1<<7)) markWithoutMove(*regs--);
702 if (si & (1<<8)) markWithoutMove(*regs--);
703 if (si & (1<<9)) markWithoutMove(*regs--);
704 if (previousFrame(fp)) {
705 /* The non-register stack space is for the previous frame is above
706 this fp, and not below the previous fp, because of the way stack
707 extension works. It seems the only way of discovering its size is
708 finding the SUB sp, sp, #? instruction by walking through the code
709 following the entry point.
711 int *oldpc = programCounter(previousFrame(fp));
713 for(i = 1; i < 6; ++i)
714 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
715 for(i=1; i<=fsize; ++i)
716 markWithoutMove(fp[i]);
722 int *fp = 5 + &dummy;
725 fp = previousFrame(fp);
729 #else /* Garbage collection for standard stack machines */
731 Void gcCStack() { /* Garbage collect elements off */
732 Cell stackTop = NIL; /* C stack */
733 Cell *ptr = &stackTop;
735 if (((long)(ptr) - (long)(CStackBase))&1)
737 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
738 if (((long)(ptr) - (long)(CStackBase))&1)
741 if (((long)(ptr) - (long)(CStackBase))&3)
745 #define StackGrowsDown while (ptr<=CStackBase) markWithoutMove(*ptr++)
746 #define StackGrowsUp while (ptr>=CStackBase) markWithoutMove(*ptr--)
747 #define GuessDirection if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown
749 #if STACK_DIRECTION > 0
751 #elif STACK_DIRECTION < 0
757 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
758 ptr = (Cell *)((long)(&stackTop) + 2);
762 #undef StackGrowsDown
764 #undef GuessDirection
768 /* --------------------------------------------------------------------------
769 * Terminal dependent stuff:
770 * ------------------------------------------------------------------------*/
772 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
774 /* grab the varargs prototype for ioctl */
776 # include <sys/ioctl.h>
779 /* The order of these three tests is very important because
780 * some systems have more than one of the requisite header file
781 * but only one of them seems to work.
782 * Anyone changing the order of the tests should try enabling each of the
783 * three branches in turn and write down which ones work as well as which
784 * OS/compiler they're using.
786 * OS Compiler sgtty termio termios notes
787 * Linux 2.0.18 gcc 2.7.2 absent works works 1
790 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
791 * implemented using termios.h.
792 * sgtty.h is in /usr/include/bsd which is not on my standard include
793 * path. Adding it does no harm but you might as well use termios.
795 * reid-alastair@cs.yale.edu
800 typedef struct termios TermParams;
801 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
802 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
803 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
810 typedef struct sgttyb TermParams;
811 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
812 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
814 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
816 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
822 typedef struct termio TermParams;
823 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
824 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
825 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
831 static Bool messedWithTerminal = FALSE;
832 static TermParams originalSettings;
834 Void normalTerminal() { /* restore terminal initial state */
835 if (messedWithTerminal)
836 setTerminal(originalSettings);
839 Void noechoTerminal() { /* set terminal into noecho mode */
842 if (!messedWithTerminal) {
843 getTerminal(originalSettings);
844 messedWithTerminal = TRUE;
846 getTerminal(settings);
848 setTerminal(settings);
851 Int getTerminalWidth() { /* determine width of terminal */
853 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
854 #include <sys/stream.h> /* Required by sys/ptem.h */
855 #include <sys/ptem.h> /* Required to declare winsize */
857 static struct winsize terminalSize;
858 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
859 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
865 Int readTerminalChar() { /* read character from terminal */
866 return getchar(); /* without echo, assuming that */
867 } /* noechoTerminal() is active... */
871 Int readTerminalChar() { /* read character from terminal */
872 return getchar(); /* without echo, assuming that */
873 } /* noechoTerminal() is active... */
875 Int getTerminalWidth() {
876 return console_options.ncols;
879 Void normalTerminal() {
880 csetmode(C_ECHO, stdin);
883 Void noechoTerminal() {
884 csetmode(C_NOECHO, stdin);
887 #else /* no terminal driver - eg DOS, RISCOS */
889 static Bool terminalEchoReqd = TRUE;
891 Int getTerminalWidth() {
894 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
901 Void normalTerminal() { /* restore terminal initial state */
902 terminalEchoReqd = TRUE;
905 Void noechoTerminal() { /* turn terminal echo on/off */
906 terminalEchoReqd = FALSE;
909 Int readTerminalChar() { /* read character from terminal */
910 if (terminalEchoReqd) {
914 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
918 #endif /* no terminal driver */
920 /* --------------------------------------------------------------------------
921 * Interrupt handling:
922 * ------------------------------------------------------------------------*/
925 static Bool breakReqd = FALSE;
926 static sigProto(ignoreBreak);
927 static Void local installHandlers Args((Void));
929 Bool breakOn(reqd) /* set break trapping on if reqd, */
930 Bool reqd; { /* or off otherwise, returning old */
931 Bool old = breakReqd;
935 if (broken) { /* repond to break signal received */
936 broken = FALSE; /* whilst break trap disabled */
937 sigRaise(breakHandler);
940 #if HANDLERS_CANT_LONGJMP
941 ctrlbrk(ignoreBreak);
943 ctrlbrk(breakHandler);
946 ctrlbrk(ignoreBreak);
951 static sigHandler(ignoreBreak) { /* record but don't respond to break*/
952 ctrlbrk(ignoreBreak); /* reinstall signal handler */
953 /* redundant on BSD systems but essential */
954 /* on POSIX and other systems */
961 static sigProto(panic);
962 static sigHandler(panic) { /* exit in a panic, on receipt of */
963 everybody(EXIT); /* an unexpected signal */
964 fprintf(stderr,"\nUnexpected signal\n");
966 sigResume;/*NOTREACHED*/
968 #endif /* !DONT_PANIC */
970 static Void local installHandlers() { /* Install handlers for all fatal */
971 /* signals except SIGINT and SIGBREAK*/
972 #if !DONT_PANIC && !DOS
974 signal(SIGABRT,panic);
977 signal(SIGBUS,panic);
980 signal(SIGFPE,panic);
983 signal(SIGHUP,panic);
986 signal(SIGILL,panic);
989 signal(SIGQUIT,panic);
992 signal(SIGSEGV,panic);
995 signal(SIGTERM,panic);
997 #endif /* !DONT_PANIC && !DOS */
1000 /* --------------------------------------------------------------------------
1002 * ------------------------------------------------------------------------*/
1004 static Bool local startEdit(line,nm) /* Start editor on file name at */
1005 Int line; /* given line. Both name and line */
1006 String nm; { /* or just line may be zero */
1007 static char editorCmd[FILENAME_MAX+1];
1010 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1012 /* On a Mac, files have creator information, telling which program
1013 to launch to, so an editor named to the empty string "" is often
1015 if (hugsEdit) { /* Check that editor configured */
1017 Int n = FILENAME_MAX;
1018 String he = hugsEdit;
1019 String ec = editorCmd;
1020 String rd = NULL; /* Set to nonnull to redo ... */
1022 for (; n>0 && *he && *he!=' '; n--)
1023 *ec++ = *he++; /* Copy editor name to buffer */
1024 /* assuming filename ends at space */
1026 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1027 rd = ec; /* save, in case we don't find name*/
1028 while (n>0 && *he) {
1030 if (*++he=='d' && n>10) {
1031 sprintf(ec,"%d",line);
1034 else if (*he=='s' && (size_t)n>strlen(nm)) {
1039 else if (*he=='%' && n>1) {
1043 else /* Ignore % char if not followed */
1044 *ec = '\0'; /* by one of d, s, or %, */
1045 for (; *ec && n>0; n--)
1047 } /* ignore % followed by anything other than d, s, or % */
1048 else { /* Copy other characters across */
1057 if (rd) { /* If file name was not included */
1062 if (nm && line==0 && n>1) { /* Name, but no line ... */
1064 for (; n>0 && *nm; n--) /* ... just copy file name */
1068 *ec = '\0'; /* Add terminating null byte */
1071 ERRMSG(0) "Hugs is not configured to use an editor"
1076 WinExec(editorCmd, SW_SHOW);
1079 if (shellEsc(editorCmd))
1080 Printf("Warning: Editor terminated abnormally\n");
1085 Int shellEsc(s) /* run a shell command (or shell) */
1088 return macsystem(s);
1092 s = fromEnv("SHELL","/bin/sh");
1099 #if RISCOS /* RISCOS also needs a chdir() */
1100 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1101 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1103 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1104 int chdir(const char *s) {
1107 wd.ioCompletion = 0;
1108 str = (char*)malloc(strlen(s) + 1);
1109 if (str == 0) return -1;
1111 wd.ioNamePtr = C2PStr(str);
1114 errno = PBHSetVolSync(&wd);
1125 /*---------------------------------------------------------------------------
1126 * Printf-related operations:
1127 *-------------------------------------------------------------------------*/
1129 #if !defined(HAVE_VSNPRINTF)
1130 int vsnprintf(buffer, count, fmt, ap)
1135 #if defined(HAVE__VSNPRINTF)
1136 return _vsnprintf(buffer, count, fmt, ap);
1141 #endif /* HAVE_VSNPRINTF */
1143 #if !defined(HAVE_SNPRINTF)
1144 int snprintf(char* buffer, int count, const char* fmt, ...) {
1145 #if defined(HAVE__VSNPRINTF)
1147 va_list ap; /* pointer into argument list */
1148 va_start(ap, fmt); /* make ap point to first arg after fmt */
1149 r = vsnprintf(buffer, count, fmt, ap);
1150 va_end(ap); /* clean up */
1156 #endif /* HAVE_SNPRINTF */
1158 /* --------------------------------------------------------------------------
1159 * Read/write values from/to the registry
1161 * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1162 * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
1163 * user entry doesn't exist).
1165 * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1166 * ------------------------------------------------------------------------*/
1170 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1172 static Bool local createKey Args((HKEY, PHKEY, REGSAM));
1173 static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1174 static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD));
1176 static Bool local createKey(hKey, phRootKey, samDesired)
1179 REGSAM samDesired; {
1181 return RegCreateKeyEx(hKey, HugsRoot,
1182 0, "", REG_OPTION_NON_VOLATILE,
1183 samDesired, NULL, phRootKey, &dwDisp)
1187 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1196 if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1199 LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1200 RegCloseKey(hRootKey);
1201 return (res == ERROR_SUCCESS);
1205 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1214 if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1217 LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1218 RegCloseKey(hRootKey);
1219 return (res == ERROR_SUCCESS);
1223 static String local readRegString(key,regPath,var,def) /* read String from registry */
1228 static char buf[300];
1230 if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1231 && type == REG_SZ) {
1238 static Int local readRegInt(var, def) /* read Int from registry */
1244 if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1245 (LPBYTE)&buf, sizeof(buf))
1246 && type == REG_DWORD) {
1248 } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1249 (LPBYTE)&buf, sizeof(buf))
1250 && type == REG_DWORD) {
1257 static Bool local writeRegString(var,val) /* write String to registry */
1263 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1264 REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1267 static Bool local writeRegInt(var,val) /* write String to registry */
1270 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1271 REG_DWORD, (LPBYTE)&val, sizeof(val));
1274 #endif /* USE_REGISTRY */
1276 /* --------------------------------------------------------------------------
1277 * Machine dependent control:
1278 * ------------------------------------------------------------------------*/
1280 Void machdep(what) /* Handle machine specific */
1281 Int what; { /* initialisation etc.. */
1284 case INSTALL : installHandlers();
1288 case EXIT : normalTerminal();
1289 #if HUGS_FOR_WINDOWS
1291 DestroyWindow(hWndMain);
1293 SetCursor(LoadCursor(NULL,IDC_ARROW));
1299 /*-------------------------------------------------------------------------*/