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/03/01 14:46:49 $
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","");
312 #if 0 /* apparently unused */
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];
330 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
333 #if HAVE__FULLPATH /* eg DOS */
334 static char path1[FILENAME_MAX+1];
335 static char path2[FILENAME_MAX+1];
336 _fullpath(path1,p1,FILENAME_MAX+1);
337 _fullpath(path2,p2,FILENAME_MAX+1);
338 #elif HAVE_REALPATH /* eg Unix */
339 static char path1[MAXPATHLEN+1];
340 static char path2[MAXPATHLEN+1];
344 static char path1[FILENAME_MAX+1];
345 static char path2[FILENAME_MAX+1];
349 #if CASE_INSENSITIVE_FILENAMES
353 return filenamecmp(path1,path2);
356 static String local normPath(s) /* Try, as much as possible, to normalize */
357 String s; { /* a pathname in some appropriate manner. */
358 #if PATH_CANONICALIZATION
359 String path = RealPath(s);
360 #if CASE_INSENSITIVE_FILENAMES
361 strlwr(path); /* and convert to lowercase */
364 #else /* ! PATH_CANONICALIZATION */
366 #endif /* ! PATH_CANONICALIZATION */
370 static String endings[] = { "", ".hs", ".lhs", ".hsx", ".hash", 0 };
372 static String endings[] = { "", ".hs", ".lhs", 0 };
374 static char searchBuf[FILENAME_MAX+1];
375 static Int searchPos;
377 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
379 static Void local searchChr(c) /* Add single character to search buffer */
381 if (searchPos<FILENAME_MAX) {
382 searchBuf[searchPos++] = (char)c;
383 searchBuf[searchPos] = '\0';
387 static Void local searchStr(s) /* Add string to search buffer */
389 while (*s && searchPos<FILENAME_MAX)
390 searchBuf[searchPos++] = *s++;
391 searchBuf[searchPos] = '\0';
394 static Bool local tryEndings(s) /* Try each of the listed endings */
398 for (; endings[i]; ++i) {
399 Int save = searchPos;
400 searchStr(endings[i]);
401 if (readable(searchBuf))
412 /* scandir, June 98 Daan Leijen
413 searches the base directory and its direct subdirectories for a file
415 input: searchbuf contains SLASH terminated base directory
416 argument s contains the (base) filename
417 output: TRUE: searchBuf contains the full filename
418 FALSE: searchBuf is garbage, file not found
422 #ifdef HAVE_WINDOWS_H
424 static Bool scanSubDirs(s)
427 struct _finddata_t findInfo;
432 /* is it in the current directory ? */
433 if (tryEndings(s)) return TRUE;
438 /* initiate the search */
439 handle = _findfirst( searchBuf, &findInfo );
440 if (handle==-1) { errno = 0; return FALSE; }
442 /* search all subdirectories */
444 /* if we have a valid sub directory */
445 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
446 (findInfo.name[0] != '.')) {
448 searchStr(findInfo.name);
454 } while (_findnext( handle, &findInfo ) == 0);
456 _findclose( handle );
460 #elif defined(HAVE_FTW_H)
464 static char baseFile[FILENAME_MAX+1];
465 static char basePath[FILENAME_MAX+1];
466 static int basePathLen;
468 static int scanitem( const char* path,
469 const struct stat* statinfo,
472 if (info == FTW_D) { /* is it a directory */
476 if (tryEndings(baseFile)) {
483 static Bool scanSubDirs(s)
488 strcpy(basePath,searchBuf);
489 basePathLen = strlen(basePath);
491 /* is it in the current directory ? */
492 if (tryEndings(s)) return TRUE;
494 /* otherwise scan the subdirectories */
495 r = ftw( basePath, scanitem, 2 );
500 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
501 #endif /* SEARCH_DIR */
503 String findPathname(along,nm) /* Look for a file along specified path */
504 String along; /* Return NULL if file does not exist */
506 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
507 String s = findMPathname(along,nm,hugsPath);
512 s = findMPathname(along,nm,projectPath);
515 #endif /* USE_REGISTRY */
516 return s ? s : normPath(searchBuf);
519 /* AC, 1/21/99: modified to pass in path to search explicitly */
520 String findMPathname(along,nm,path)/* Look for a file along specified path */
521 String along; /* If nonzero, a path prefix from along is */
522 String nm; /* used as the first prefix in the search. */
524 String pathpt = path;
527 if (along) { /* Was a path for an existing file given? */
530 for (; along[i]; i++) {
532 if (isSLASH(along[i]))
538 return normPath(searchBuf);
540 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
543 Bool recurse = FALSE; /* DL: shall we recurse ? */
546 if (*pathpt!=PATHSEP) {
547 /* Pre-define one MPW-style "shell-variable" */
548 if (strncmp(pathpt,"{Hugs}",6)==0) {
549 searchStr(hugsdir());
553 /* And another - we ought to generalise this stuff */
554 else if (strncmp(pathpt,"{HScript}",9)==0) {
555 searchStr(hscriptDir());
560 searchChr(*pathpt++);
561 } while (*pathpt && *pathpt!=PATHSEP);
562 recurse = (pathpt[-1] == SLASH);
567 if (*pathpt==PATHSEP)
575 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
576 return normPath(searchBuf);
579 if (tryEndings(nm)) {
580 return normPath(searchBuf);
586 searchReset(0); /* As a last resort, look for file in the current dir */
587 return (tryEndings(nm) ? normPath(searchBuf) : 0);
590 /* --------------------------------------------------------------------------
591 * Substitute old value of path into empty entries in new path
592 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
593 * ------------------------------------------------------------------------*/
595 static String local substPath Args((String,String));
597 static String local substPath(new,sub) /* substitute sub path into new path*/
600 Bool substituted = FALSE; /* only allow one replacement */
601 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
602 String r = (String) malloc(maxlen+1); /* result string */
603 String t = r; /* pointer into r */
604 String next = new; /* next uncopied char in new */
605 String start = next; /* start of last path component */
607 ERRMSG(0) "String storage space exhausted"
611 if (*next == PATHSEP || *next == '\0') {
612 if (!substituted && next == start) {
614 for(; *s != '\0'; ++s) {
621 } while ((*t++ = *next++) != '\0');
626 /* --------------------------------------------------------------------------
627 * Get time/date stamp for inclusion in compiled files:
628 * ------------------------------------------------------------------------*/
631 String timeString() { /* return time&date string */
632 time_t clock; /* must end with '\n' character */
634 return(ctime(&clock));
638 /* --------------------------------------------------------------------------
639 * Garbage collection notification:
640 * ------------------------------------------------------------------------*/
642 Bool gcMessages = FALSE; /* TRUE => print GC messages */
644 Void gcStarted() { /* Notify garbage collector start */
646 SaveCursor = SetCursor(GarbageCursor);
654 Void gcScanning() { /* Notify garbage collector scans */
661 Void gcRecovered(recovered) /* Notify garbage collection done */
664 Printf("%d}}",recovered);
668 SetCursor(SaveCursor);
672 Cell *CStackBase; /* Retain start of C control stack */
674 #if RISCOS /* Stack traversal for RISCOS */
676 /* Warning: The following code is specific to the Acorn ARM under RISCOS
677 (and C4). We must explicitly walk back through the stack frames, since
678 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
679 not be modified, since the offset '5' assumes that only v1 is used inside
680 this function. Hence we do all the real work in gcARM.
683 #define spreg 13 /* C3 has SP=R13 */
685 #define previousFrame(fp) ((int *)((fp)[-3]))
686 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
687 #define isSubSPSP(w) (((w)&dontCare) == doCare)
688 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
689 #define dontCare (~0x00100FFF) /* S and # bits */
690 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
692 static void gcARM(int *fp) {
693 int si = *programCounter(fp); /* Save instruction indicates how */
694 /* many registers in this frame */
696 if (si & (1<<0)) markWithoutMove(*regs--);
697 if (si & (1<<1)) markWithoutMove(*regs--);
698 if (si & (1<<2)) markWithoutMove(*regs--);
699 if (si & (1<<3)) markWithoutMove(*regs--);
700 if (si & (1<<4)) markWithoutMove(*regs--);
701 if (si & (1<<5)) markWithoutMove(*regs--);
702 if (si & (1<<6)) markWithoutMove(*regs--);
703 if (si & (1<<7)) markWithoutMove(*regs--);
704 if (si & (1<<8)) markWithoutMove(*regs--);
705 if (si & (1<<9)) markWithoutMove(*regs--);
706 if (previousFrame(fp)) {
707 /* The non-register stack space is for the previous frame is above
708 this fp, and not below the previous fp, because of the way stack
709 extension works. It seems the only way of discovering its size is
710 finding the SUB sp, sp, #? instruction by walking through the code
711 following the entry point.
713 int *oldpc = programCounter(previousFrame(fp));
715 for(i = 1; i < 6; ++i)
716 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
717 for(i=1; i<=fsize; ++i)
718 markWithoutMove(fp[i]);
724 int *fp = 5 + &dummy;
727 fp = previousFrame(fp);
731 #else /* Garbage collection for standard stack machines */
733 Void gcCStack() { /* Garbage collect elements off */
734 Cell stackTop = NIL; /* C stack */
735 Cell *ptr = &stackTop;
737 if (((long)(ptr) - (long)(CStackBase))&1)
739 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
740 if (((long)(ptr) - (long)(CStackBase))&1)
743 if (((long)(ptr) - (long)(CStackBase))&3)
747 #define StackGrowsDown while (ptr<=CStackBase) markWithoutMove(*ptr++)
748 #define StackGrowsUp while (ptr>=CStackBase) markWithoutMove(*ptr--)
749 #define GuessDirection if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown
751 #if STACK_DIRECTION > 0
753 #elif STACK_DIRECTION < 0
759 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
760 ptr = (Cell *)((long)(&stackTop) + 2);
764 #undef StackGrowsDown
766 #undef GuessDirection
770 /* --------------------------------------------------------------------------
771 * Terminal dependent stuff:
772 * ------------------------------------------------------------------------*/
774 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
776 /* grab the varargs prototype for ioctl */
778 # include <sys/ioctl.h>
781 /* The order of these three tests is very important because
782 * some systems have more than one of the requisite header file
783 * but only one of them seems to work.
784 * Anyone changing the order of the tests should try enabling each of the
785 * three branches in turn and write down which ones work as well as which
786 * OS/compiler they're using.
788 * OS Compiler sgtty termio termios notes
789 * Linux 2.0.18 gcc 2.7.2 absent works works 1
792 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
793 * implemented using termios.h.
794 * sgtty.h is in /usr/include/bsd which is not on my standard include
795 * path. Adding it does no harm but you might as well use termios.
797 * reid-alastair@cs.yale.edu
802 typedef struct termios TermParams;
803 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
804 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
805 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
812 typedef struct sgttyb TermParams;
813 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
814 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
816 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
818 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
824 typedef struct termio TermParams;
825 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
826 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
827 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
833 static Bool messedWithTerminal = FALSE;
834 static TermParams originalSettings;
836 Void normalTerminal() { /* restore terminal initial state */
837 if (messedWithTerminal)
838 setTerminal(originalSettings);
841 Void noechoTerminal() { /* set terminal into noecho mode */
844 if (!messedWithTerminal) {
845 getTerminal(originalSettings);
846 messedWithTerminal = TRUE;
848 getTerminal(settings);
850 setTerminal(settings);
853 Int getTerminalWidth() { /* determine width of terminal */
855 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
856 #include <sys/stream.h> /* Required by sys/ptem.h */
857 #include <sys/ptem.h> /* Required to declare winsize */
859 static struct winsize terminalSize;
860 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
861 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
867 Int readTerminalChar() { /* read character from terminal */
868 return getchar(); /* without echo, assuming that */
869 } /* noechoTerminal() is active... */
873 Int readTerminalChar() { /* read character from terminal */
874 return getchar(); /* without echo, assuming that */
875 } /* noechoTerminal() is active... */
877 Int getTerminalWidth() {
878 return console_options.ncols;
881 Void normalTerminal() {
882 csetmode(C_ECHO, stdin);
885 Void noechoTerminal() {
886 csetmode(C_NOECHO, stdin);
889 #else /* no terminal driver - eg DOS, RISCOS */
891 static Bool terminalEchoReqd = TRUE;
893 Int getTerminalWidth() {
896 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
903 Void normalTerminal() { /* restore terminal initial state */
904 terminalEchoReqd = TRUE;
907 Void noechoTerminal() { /* turn terminal echo on/off */
908 terminalEchoReqd = FALSE;
911 Int readTerminalChar() { /* read character from terminal */
912 if (terminalEchoReqd) {
916 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
920 #endif /* no terminal driver */
922 /* --------------------------------------------------------------------------
923 * Interrupt handling:
924 * ------------------------------------------------------------------------*/
927 static Bool breakReqd = FALSE;
928 static sigProto(ignoreBreak);
929 static Void local installHandlers Args((Void));
931 Bool breakOn(reqd) /* set break trapping on if reqd, */
932 Bool reqd; { /* or off otherwise, returning old */
933 Bool old = breakReqd;
937 if (broken) { /* repond to break signal received */
938 broken = FALSE; /* whilst break trap disabled */
939 sigRaise(breakHandler);
942 #if HANDLERS_CANT_LONGJMP
943 ctrlbrk(ignoreBreak);
945 ctrlbrk(breakHandler);
948 ctrlbrk(ignoreBreak);
953 static sigHandler(ignoreBreak) { /* record but don't respond to break*/
954 ctrlbrk(ignoreBreak); /* reinstall signal handler */
955 /* redundant on BSD systems but essential */
956 /* on POSIX and other systems */
963 static sigProto(panic);
964 static sigHandler(panic) { /* exit in a panic, on receipt of */
965 everybody(EXIT); /* an unexpected signal */
966 fprintf(stderr,"\nUnexpected signal\n");
968 sigResume;/*NOTREACHED*/
970 #endif /* !DONT_PANIC */
972 static Void local installHandlers() { /* Install handlers for all fatal */
973 /* signals except SIGINT and SIGBREAK*/
974 #if !DONT_PANIC && !DOS
976 signal(SIGABRT,panic);
979 signal(SIGBUS,panic);
982 signal(SIGFPE,panic);
985 signal(SIGHUP,panic);
988 signal(SIGILL,panic);
991 signal(SIGQUIT,panic);
994 signal(SIGSEGV,panic);
997 signal(SIGTERM,panic);
999 #endif /* !DONT_PANIC && !DOS */
1002 /* --------------------------------------------------------------------------
1004 * ------------------------------------------------------------------------*/
1006 static Bool local startEdit(line,nm) /* Start editor on file name at */
1007 Int line; /* given line. Both name and line */
1008 String nm; { /* or just line may be zero */
1009 static char editorCmd[FILENAME_MAX+1];
1012 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1014 /* On a Mac, files have creator information, telling which program
1015 to launch to, so an editor named to the empty string "" is often
1017 if (hugsEdit) { /* Check that editor configured */
1019 Int n = FILENAME_MAX;
1020 String he = hugsEdit;
1021 String ec = editorCmd;
1022 String rd = NULL; /* Set to nonnull to redo ... */
1024 for (; n>0 && *he && *he!=' '; n--)
1025 *ec++ = *he++; /* Copy editor name to buffer */
1026 /* assuming filename ends at space */
1028 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1029 rd = ec; /* save, in case we don't find name*/
1030 while (n>0 && *he) {
1032 if (*++he=='d' && n>10) {
1033 sprintf(ec,"%d",line);
1036 else if (*he=='s' && (size_t)n>strlen(nm)) {
1041 else if (*he=='%' && n>1) {
1045 else /* Ignore % char if not followed */
1046 *ec = '\0'; /* by one of d, s, or %, */
1047 for (; *ec && n>0; n--)
1049 } /* ignore % followed by anything other than d, s, or % */
1050 else { /* Copy other characters across */
1059 if (rd) { /* If file name was not included */
1064 if (nm && line==0 && n>1) { /* Name, but no line ... */
1066 for (; n>0 && *nm; n--) /* ... just copy file name */
1070 *ec = '\0'; /* Add terminating null byte */
1073 ERRMSG(0) "Hugs is not configured to use an editor"
1078 WinExec(editorCmd, SW_SHOW);
1081 if (shellEsc(editorCmd))
1082 Printf("Warning: Editor terminated abnormally\n");
1087 Int shellEsc(s) /* run a shell command (or shell) */
1090 return macsystem(s);
1094 s = fromEnv("SHELL","/bin/sh");
1101 #if RISCOS /* RISCOS also needs a chdir() */
1102 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1103 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1105 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1106 int chdir(const char *s) {
1109 wd.ioCompletion = 0;
1110 str = (char*)malloc(strlen(s) + 1);
1111 if (str == 0) return -1;
1113 wd.ioNamePtr = C2PStr(str);
1116 errno = PBHSetVolSync(&wd);
1127 /*---------------------------------------------------------------------------
1128 * Printf-related operations:
1129 *-------------------------------------------------------------------------*/
1131 #if !defined(HAVE_VSNPRINTF)
1132 int vsnprintf(buffer, count, fmt, ap)
1137 #if defined(HAVE__VSNPRINTF)
1138 return _vsnprintf(buffer, count, fmt, ap);
1143 #endif /* HAVE_VSNPRINTF */
1145 #if !defined(HAVE_SNPRINTF)
1146 int snprintf(char* buffer, int count, const char* fmt, ...) {
1147 #if defined(HAVE__VSNPRINTF)
1149 va_list ap; /* pointer into argument list */
1150 va_start(ap, fmt); /* make ap point to first arg after fmt */
1151 r = vsnprintf(buffer, count, fmt, ap);
1152 va_end(ap); /* clean up */
1158 #endif /* HAVE_SNPRINTF */
1160 /* --------------------------------------------------------------------------
1161 * Read/write values from/to the registry
1163 * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1164 * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
1165 * user entry doesn't exist).
1167 * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1168 * ------------------------------------------------------------------------*/
1172 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1174 static Bool local createKey Args((HKEY, PHKEY, REGSAM));
1175 static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1176 static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD));
1178 static Bool local createKey(hKey, phRootKey, samDesired)
1181 REGSAM samDesired; {
1183 return RegCreateKeyEx(hKey, HugsRoot,
1184 0, "", REG_OPTION_NON_VOLATILE,
1185 samDesired, NULL, phRootKey, &dwDisp)
1189 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1198 if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1201 LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1202 RegCloseKey(hRootKey);
1203 return (res == ERROR_SUCCESS);
1207 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1216 if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1219 LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1220 RegCloseKey(hRootKey);
1221 return (res == ERROR_SUCCESS);
1225 static String local readRegString(key,regPath,var,def) /* read String from registry */
1230 static char buf[300];
1232 if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1233 && type == REG_SZ) {
1240 static Int local readRegInt(var, def) /* read Int from registry */
1246 if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1247 (LPBYTE)&buf, sizeof(buf))
1248 && type == REG_DWORD) {
1250 } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1251 (LPBYTE)&buf, sizeof(buf))
1252 && type == REG_DWORD) {
1259 static Bool local writeRegString(var,val) /* write String to registry */
1265 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1266 REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1269 static Bool local writeRegInt(var,val) /* write String to registry */
1272 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1273 REG_DWORD, (LPBYTE)&val, sizeof(val));
1276 #endif /* USE_REGISTRY */
1278 /* --------------------------------------------------------------------------
1279 * Machine dependent control:
1280 * ------------------------------------------------------------------------*/
1282 Void machdep(what) /* Handle machine specific */
1283 Int what; { /* initialisation etc.. */
1286 case INSTALL : installHandlers();
1290 case EXIT : normalTerminal();
1291 #if HUGS_FOR_WINDOWS
1293 DestroyWindow(hWndMain);
1295 SetCursor(LoadCursor(NULL,IDC_ARROW));
1301 /*-------------------------------------------------------------------------*/