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/06/07 17:22:37 $
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
136 error timeEarlier not defined
139 #define timeChanged(now,thn) (now!=thn)
140 #define timeSet(var,tm) var = tm
141 #define timeEarlier(earlier,now) (earlier < now)
144 static Bool local readable Args((String));
145 static Void local getFileInfo Args((String, Time *, Long *));
147 static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/
151 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
153 if (!stat(f,&scbuf)) {
154 if (tm) *tm = scbuf.st_mtime;
155 *sz = (Long)(scbuf.st_size);
160 #else /* normally just use stat() */
161 os_regset r; /* RISCOS PRM p.850 and p.837 */
162 r.r[0] = 17; /* Read catalogue, no path */
165 if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
166 if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
167 if (tm) tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
168 } else { /* Not found, or not time-stamped */
169 if (tm) tm->hi = tm->lo = 0;
171 *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
175 Void getFileSize ( String f, Long* sz )
177 getFileInfo ( f, NULL, sz );
180 #if defined HAVE_GETFINFO /* Mac971031 */
181 /* --------------------------------------------------------------------------
182 * Define a MacOS version of access():
183 * If the file is not accessible, -1 is returned and errno is set to
184 * the reason for the failure.
185 * If the file is accessible and the dummy is 0 (existence), 2 (write),
186 * or 4 (read), the return is 0.
187 * If the file is accessible, and the dummy is 1 (executable), then if
188 * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
189 * Warnings: Use with caution. UNIX access do no translate to Macs.
190 * Check of write access is not implemented (same as read).
191 * ------------------------------------------------------------------------*/
193 int access(char *fileName, int dummy) {
197 errno = getfinfo(fileName, 0, &fi);
198 if (errno != 0) return -1; /* Check file accessible. */
200 /* Cases dummy = existence, read, write. */
201 if (dummy == 0 || dummy & 0x6) return 0;
203 /* Case dummy = executable. */
205 if (fi.fdType == 'APPL') return 0;
214 static Bool local readable(f) /* is f a regular, readable file */
216 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
217 return (0 == access(f,4));
218 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
220 //fprintf(stderr, "readable: %s\n", f );
221 return ( !stat(f,&scbuf)
222 && (scbuf.st_mode & S_IREAD) /* readable */
223 && (scbuf.st_mode & S_IFREG) /* regular file */
225 #elif defined HAVE_OS_SWI /* RISCOS specific */
226 os_regset r; /* RISCOS PRM p.850 -- JBS */
228 r.r[0] = 17; /* Read catalogue, no path */
231 return r.r[0] != 1; /* Does this check it's a regular file? ADR */
236 /* --------------------------------------------------------------------------
237 * Search for script files on the HUGS path:
238 * ------------------------------------------------------------------------*/
240 static String local hugsdir Args((Void));
242 static String local hscriptDir Args((Void));
244 //static String local RealPath Args((String));
245 static int local pathCmp Args((String, String));
246 static String local normPath Args((String));
247 static Void local searchChr Args((Int));
248 static Void local searchStr Args((String));
249 static Bool local tryEndings Args((String));
253 # define isSLASH(c) ((c)=='\\' || (c)=='/')
255 # define DLL_ENDING ".dll"
258 # define isSLASH(c) ((c)==SLASH)
260 /* Mac PEF (Preferred Executable Format) file */
261 # define DLL_ENDING ".pef"
264 # define isSLASH(c) ((c)==SLASH)
266 # define DLL_ENDING ".o"
269 static String local hugsdir() { /* directory containing lib/Prelude.hs */
271 /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
272 static char dir[FILENAME_MAX+1] = "";
273 if (dir[0] == '\0') { /* not initialised yet */
274 String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
281 #elif HAVE_GETMODULEFILENAME && !DOS
282 /* On Windows, we can find the binary we're running and it's
283 * conventional to put the libraries in the same place.
285 static char dir[FILENAME_MAX+1] = "";
286 if (dir[0] == '\0') { /* not initialised yet */
288 GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
289 if (dir[0] == '\0') { /* GetModuleFileName must have failed */
292 if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */
298 /* On Unix systems, we can't find the binary we're running and
299 * the libraries may not be installed near the binary anyway.
300 * This forces us to use a hardwired path which is set at
301 * configuration time (--datadir=...).
308 static String local hscriptDir() { /* directory containing ?? what Daan? */
309 static char dir[FILENAME_MAX+1] = "";
310 if (dir[0] == '\0') { /* not initialised yet */
311 String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
320 #if 0 /* apparently unused */
321 static String local RealPath(s) /* Find absolute pathname of file */
323 #if HAVE__FULLPATH /* eg DOS */
324 static char path[FILENAME_MAX+1];
325 _fullpath(path,s,FILENAME_MAX+1);
326 #elif HAVE_REALPATH /* eg Unix */
327 static char path[MAXPATHLEN+1];
330 static char path[FILENAME_MAX+1];
338 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
341 #if HAVE__FULLPATH /* eg DOS */
342 static char path1[FILENAME_MAX+1];
343 static char path2[FILENAME_MAX+1];
344 _fullpath(path1,p1,FILENAME_MAX+1);
345 _fullpath(path2,p2,FILENAME_MAX+1);
346 #elif HAVE_REALPATH /* eg Unix */
347 static char path1[MAXPATHLEN+1];
348 static char path2[MAXPATHLEN+1];
352 static char path1[FILENAME_MAX+1];
353 static char path2[FILENAME_MAX+1];
357 #if CASE_INSENSITIVE_FILENAMES
361 return filenamecmp(path1,path2);
364 static String local normPath(s) /* Try, as much as possible, to normalize */
365 String s; { /* a pathname in some appropriate manner. */
366 #if PATH_CANONICALIZATION
367 String path = RealPath(s);
368 #if CASE_INSENSITIVE_FILENAMES
369 strlwr(path); /* and convert to lowercase */
372 #else /* ! PATH_CANONICALIZATION */
374 #endif /* ! PATH_CANONICALIZATION */
378 static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
380 static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
382 static char searchBuf[FILENAME_MAX+1];
383 static Int searchPos;
385 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
387 static Void local searchChr(c) /* Add single character to search buffer */
389 if (searchPos<FILENAME_MAX) {
390 searchBuf[searchPos++] = (char)c;
391 searchBuf[searchPos] = '\0';
395 static Void local searchStr(s) /* Add string to search buffer */
397 while (*s && searchPos<FILENAME_MAX)
398 searchBuf[searchPos++] = *s++;
399 searchBuf[searchPos] = '\0';
402 static Bool local tryEndings(s) /* Try each of the listed endings */
406 for (; endings[i]; ++i) {
407 Int save = searchPos;
408 searchStr(endings[i]);
409 if (readable(searchBuf))
420 /* scandir, June 98 Daan Leijen
421 searches the base directory and its direct subdirectories for a file
423 input: searchbuf contains SLASH terminated base directory
424 argument s contains the (base) filename
425 output: TRUE: searchBuf contains the full filename
426 FALSE: searchBuf is garbage, file not found
430 #ifdef HAVE_WINDOWS_H
432 static Bool scanSubDirs(s)
435 struct _finddata_t findInfo;
440 /* is it in the current directory ? */
441 if (tryEndings(s)) return TRUE;
446 /* initiate the search */
447 handle = _findfirst( searchBuf, &findInfo );
448 if (handle==-1) { errno = 0; return FALSE; }
450 /* search all subdirectories */
452 /* if we have a valid sub directory */
453 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
454 (findInfo.name[0] != '.')) {
456 searchStr(findInfo.name);
462 } while (_findnext( handle, &findInfo ) == 0);
464 _findclose( handle );
468 #elif defined(HAVE_FTW_H)
472 static char baseFile[FILENAME_MAX+1];
473 static char basePath[FILENAME_MAX+1];
474 static int basePathLen;
476 static int scanitem( const char* path,
477 const struct stat* statinfo,
480 if (info == FTW_D) { /* is it a directory */
484 if (tryEndings(baseFile)) {
491 static Bool scanSubDirs(s)
496 strcpy(basePath,searchBuf);
497 basePathLen = strlen(basePath);
499 /* is it in the current directory ? */
500 if (tryEndings(s)) return TRUE;
502 /* otherwise scan the subdirectories */
503 r = ftw( basePath, scanitem, 2 );
508 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
509 #endif /* SEARCH_DIR */
511 String findPathname(along,nm) /* Look for a file along specified path */
512 String along; /* Return NULL if file does not exist */
514 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
515 String s = findMPathname(along,nm,hugsPath);
520 s = findMPathname(along,nm,projectPath);
523 #endif /* USE_REGISTRY */
524 return s ? s : normPath(searchBuf);
527 /* AC, 1/21/99: modified to pass in path to search explicitly */
528 String findMPathname(along,nm,path)/* Look for a file along specified path */
529 String along; /* If nonzero, a path prefix from along is */
530 String nm; /* used as the first prefix in the search. */
532 String pathpt = path;
535 if (along) { /* Was a path for an existing file given? */
538 for (; along[i]; i++) {
540 if (isSLASH(along[i]))
546 return normPath(searchBuf);
548 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
551 Bool recurse = FALSE; /* DL: shall we recurse ? */
554 if (*pathpt!=PATHSEP) {
555 /* Pre-define one MPW-style "shell-variable" */
556 if (strncmp(pathpt,"{Hugs}",6)==0) {
557 searchStr(hugsdir());
561 /* And another - we ought to generalise this stuff */
562 else if (strncmp(pathpt,"{HScript}",9)==0) {
563 searchStr(hscriptDir());
568 searchChr(*pathpt++);
569 } while (*pathpt && *pathpt!=PATHSEP);
570 recurse = (pathpt[-1] == SLASH);
575 if (*pathpt==PATHSEP)
583 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
584 return normPath(searchBuf);
587 if (tryEndings(nm)) {
588 return normPath(searchBuf);
594 searchReset(0); /* As a last resort, look for file in the current dir */
595 return (tryEndings(nm) ? normPath(searchBuf) : 0);
598 /* --------------------------------------------------------------------------
599 * New path handling stuff for the Combined System (tm)
600 * ------------------------------------------------------------------------*/
602 Bool findFilesForModule (
606 Bool* sAvail, Time* sTime, Long* sSize,
607 Bool* iAvail, Time* iTime, Long* iSize,
608 Bool* oAvail, Time* oTime, Long* oSize
611 /* Let the module name given be M.
612 For each path entry P,
613 a s(rc) file will be P/M.hs or P/M.lhs
614 an i(nterface) file will be P/M.hi
615 an o(bject) file will be P/M.o
616 If there is a s file or (both i and o files)
617 use P to fill in the path names.
618 Otherwise, move on to the next path entry.
619 If all path entries are exhausted, return False.
623 String peStart, peEnd;
624 String augdPath; /* . and then hugsPath */
626 *path = *sExt = NULL;
627 *sAvail = *iAvail = *oAvail = FALSE;
628 *sSize = *iSize = *oSize = 0;
630 augdPath = malloc(3+strlen(hugsPath));
632 internal("moduleNameToFileNames: malloc failed(2)");
634 augdPath[1] = PATHSEP;
636 strcat(augdPath,hugsPath);
640 /* Advance peStart and peEnd very paranoically, giving up at
641 the first sign of mutancy in the path string.
643 if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
646 while (*peEnd && *peEnd != PATHSEP) peEnd++;
648 /* Now peStart .. peEnd-1 bracket the next path element. */
649 nPath = peEnd-peStart;
650 if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
651 ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
658 strncpy(searchBuf, peStart, nPath);
659 searchBuf[nPath] = 0;
660 if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
661 searchBuf[nPath++] = SLASH;
663 strcpy(searchBuf+nPath, modName);
664 nPath += strlen(modName);
666 /* searchBuf now holds 'P/M'. Try out the various endings. */
667 *path = *sExt = NULL;
668 *sAvail = *iAvail = *oAvail = FALSE;
669 *sSize = *iSize = *oSize = 0;
671 strcpy(searchBuf+nPath, DLL_ENDING);
672 if (readable(searchBuf)) {
674 getFileInfo(searchBuf, oTime, oSize);
677 strcpy(searchBuf+nPath, ".hi");
678 if (readable(searchBuf)) {
680 getFileInfo(searchBuf, iTime, iSize);
683 strcpy(searchBuf+nPath, ".hs");
684 if (readable(searchBuf)) {
687 getFileInfo(searchBuf, sTime, sSize);
690 strcpy(searchBuf+nPath, ".lhs");
691 if (readable(searchBuf)) {
694 getFileInfo(searchBuf, sTime, sSize);
700 if (*sAvail || (*oAvail && *iAvail)) {
701 nPath -= strlen(modName);
702 *path = malloc(nPath+1);
704 internal("moduleNameToFileNames: malloc failed(1)");
705 strncpy(*path, searchBuf, nPath);
716 /* --------------------------------------------------------------------------
717 * Substitute old value of path into empty entries in new path
718 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
719 * ------------------------------------------------------------------------*/
721 static String local substPath Args((String,String));
723 static String local substPath(new,sub) /* substitute sub path into new path*/
726 Bool substituted = FALSE; /* only allow one replacement */
727 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
728 String r = (String) malloc(maxlen+1); /* result string */
729 String t = r; /* pointer into r */
730 String next = new; /* next uncopied char in new */
731 String start = next; /* start of last path component */
733 ERRMSG(0) "String storage space exhausted"
737 if (*next == PATHSEP || *next == '\0') {
738 if (!substituted && next == start) {
740 for(; *s != '\0'; ++s) {
747 } while ((*t++ = *next++) != '\0');
752 /* --------------------------------------------------------------------------
753 * Garbage collection notification:
754 * ------------------------------------------------------------------------*/
756 Bool gcMessages = FALSE; /* TRUE => print GC messages */
758 Void gcStarted() { /* Notify garbage collector start */
760 SaveCursor = SetCursor(GarbageCursor);
768 Void gcScanning() { /* Notify garbage collector scans */
775 Void gcRecovered(recovered) /* Notify garbage collection done */
778 Printf("%d}}",recovered);
782 SetCursor(SaveCursor);
786 Cell *CStackBase; /* Retain start of C control stack */
788 #if RISCOS /* Stack traversal for RISCOS */
790 /* Warning: The following code is specific to the Acorn ARM under RISCOS
791 (and C4). We must explicitly walk back through the stack frames, since
792 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
793 not be modified, since the offset '5' assumes that only v1 is used inside
794 this function. Hence we do all the real work in gcARM.
797 #define spreg 13 /* C3 has SP=R13 */
799 #define previousFrame(fp) ((int *)((fp)[-3]))
800 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
801 #define isSubSPSP(w) (((w)&dontCare) == doCare)
802 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
803 #define dontCare (~0x00100FFF) /* S and # bits */
804 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
806 static void gcARM(int *fp) {
807 int si = *programCounter(fp); /* Save instruction indicates how */
808 /* many registers in this frame */
810 if (si & (1<<0)) markWithoutMove(*regs--);
811 if (si & (1<<1)) markWithoutMove(*regs--);
812 if (si & (1<<2)) markWithoutMove(*regs--);
813 if (si & (1<<3)) markWithoutMove(*regs--);
814 if (si & (1<<4)) markWithoutMove(*regs--);
815 if (si & (1<<5)) markWithoutMove(*regs--);
816 if (si & (1<<6)) markWithoutMove(*regs--);
817 if (si & (1<<7)) markWithoutMove(*regs--);
818 if (si & (1<<8)) markWithoutMove(*regs--);
819 if (si & (1<<9)) markWithoutMove(*regs--);
820 if (previousFrame(fp)) {
821 /* The non-register stack space is for the previous frame is above
822 this fp, and not below the previous fp, because of the way stack
823 extension works. It seems the only way of discovering its size is
824 finding the SUB sp, sp, #? instruction by walking through the code
825 following the entry point.
827 int *oldpc = programCounter(previousFrame(fp));
829 for(i = 1; i < 6; ++i)
830 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
831 for(i=1; i<=fsize; ++i)
832 markWithoutMove(fp[i]);
838 int *fp = 5 + &dummy;
841 fp = previousFrame(fp);
845 #else /* Garbage collection for standard stack machines */
847 Void gcCStack() { /* Garbage collect elements off */
848 Cell stackTop = NIL; /* C stack */
849 Cell *ptr = &stackTop;
851 if (((long)(ptr) - (long)(CStackBase))&1)
853 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
854 if (((long)(ptr) - (long)(CStackBase))&1)
857 if (((long)(ptr) - (long)(CStackBase))&3)
861 #define Blargh markWithoutMove(*ptr);
863 markWithoutMove((*ptr)/sizeof(Cell)); \
864 markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \
865 markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
868 #define StackGrowsDown { while (ptr<=CStackBase) { Blargh; ptr++; }; }
869 #define StackGrowsUp { while (ptr>=CStackBase) { Blargh; ptr--; }; }
870 #define GuessDirection if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
872 #if STACK_DIRECTION > 0
874 #elif STACK_DIRECTION < 0
880 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
881 ptr = (Cell *)((long)(&stackTop) + 2);
885 #undef StackGrowsDown
887 #undef GuessDirection
891 /* --------------------------------------------------------------------------
892 * Terminal dependent stuff:
893 * ------------------------------------------------------------------------*/
895 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
897 /* grab the varargs prototype for ioctl */
899 # include <sys/ioctl.h>
902 /* The order of these three tests is very important because
903 * some systems have more than one of the requisite header file
904 * but only one of them seems to work.
905 * Anyone changing the order of the tests should try enabling each of the
906 * three branches in turn and write down which ones work as well as which
907 * OS/compiler they're using.
909 * OS Compiler sgtty termio termios notes
910 * Linux 2.0.18 gcc 2.7.2 absent works works 1
913 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
914 * implemented using termios.h.
915 * sgtty.h is in /usr/include/bsd which is not on my standard include
916 * path. Adding it does no harm but you might as well use termios.
918 * reid-alastair@cs.yale.edu
923 typedef struct termios TermParams;
924 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
925 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
926 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
933 typedef struct sgttyb TermParams;
934 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
935 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
937 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
939 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
945 typedef struct termio TermParams;
946 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
947 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
948 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
954 static Bool messedWithTerminal = FALSE;
955 static TermParams originalSettings;
957 Void normalTerminal() { /* restore terminal initial state */
958 if (messedWithTerminal)
959 setTerminal(originalSettings);
962 Void noechoTerminal() { /* set terminal into noecho mode */
965 if (!messedWithTerminal) {
966 getTerminal(originalSettings);
967 messedWithTerminal = TRUE;
969 getTerminal(settings);
971 setTerminal(settings);
974 Int getTerminalWidth() { /* determine width of terminal */
976 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
977 #include <sys/stream.h> /* Required by sys/ptem.h */
978 #include <sys/ptem.h> /* Required to declare winsize */
980 static struct winsize terminalSize;
981 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
982 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
988 Int readTerminalChar() { /* read character from terminal */
989 return getchar(); /* without echo, assuming that */
990 } /* noechoTerminal() is active... */
994 Int readTerminalChar() { /* read character from terminal */
995 return getchar(); /* without echo, assuming that */
996 } /* noechoTerminal() is active... */
998 Int getTerminalWidth() {
999 return console_options.ncols;
1002 Void normalTerminal() {
1003 csetmode(C_ECHO, stdin);
1006 Void noechoTerminal() {
1007 csetmode(C_NOECHO, stdin);
1010 #else /* no terminal driver - eg DOS, RISCOS */
1012 static Bool terminalEchoReqd = TRUE;
1014 Int getTerminalWidth() {
1017 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1024 Void normalTerminal() { /* restore terminal initial state */
1025 terminalEchoReqd = TRUE;
1028 Void noechoTerminal() { /* turn terminal echo on/off */
1029 terminalEchoReqd = FALSE;
1032 Int readTerminalChar() { /* read character from terminal */
1033 if (terminalEchoReqd) {
1037 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
1041 #endif /* no terminal driver */
1043 /* --------------------------------------------------------------------------
1044 * Interrupt handling:
1045 * ------------------------------------------------------------------------*/
1047 Bool broken = FALSE;
1048 static Bool breakReqd = FALSE;
1049 static sigProto(ignoreBreak);
1050 static Void local installHandlers Args((Void));
1052 Bool breakOn(reqd) /* set break trapping on if reqd, */
1053 Bool reqd; { /* or off otherwise, returning old */
1054 Bool old = breakReqd;
1058 if (broken) { /* repond to break signal received */
1059 broken = FALSE; /* whilst break trap disabled */
1060 sigRaise(breakHandler);
1063 #if HANDLERS_CANT_LONGJMP
1064 ctrlbrk(ignoreBreak);
1066 ctrlbrk(breakHandler);
1069 ctrlbrk(ignoreBreak);
1074 static sigHandler(ignoreBreak) { /* record but don't respond to break*/
1075 ctrlbrk(ignoreBreak); /* reinstall signal handler */
1076 /* redundant on BSD systems but essential */
1077 /* on POSIX and other systems */
1084 static sigProto(panic);
1085 static sigHandler(panic) { /* exit in a panic, on receipt of */
1086 everybody(EXIT); /* an unexpected signal */
1087 fprintf(stderr,"\nUnexpected signal\n");
1089 sigResume;/*NOTREACHED*/
1091 #endif /* !DONT_PANIC */
1093 static Void local installHandlers() { /* Install handlers for all fatal */
1094 /* signals except SIGINT and SIGBREAK*/
1095 #if !DONT_PANIC && !DOS
1097 signal(SIGABRT,panic);
1100 signal(SIGBUS,panic);
1103 signal(SIGFPE,panic);
1106 signal(SIGHUP,panic);
1109 signal(SIGILL,panic);
1112 signal(SIGQUIT,panic);
1115 signal(SIGSEGV,panic);
1118 signal(SIGTERM,panic);
1120 #endif /* !DONT_PANIC && !DOS */
1123 /* --------------------------------------------------------------------------
1125 * ------------------------------------------------------------------------*/
1127 static Bool local startEdit(line,nm) /* Start editor on file name at */
1128 Int line; /* given line. Both name and line */
1129 String nm; { /* or just line may be zero */
1130 static char editorCmd[FILENAME_MAX+1];
1133 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1135 /* On a Mac, files have creator information, telling which program
1136 to launch to, so an editor named to the empty string "" is often
1138 if (hugsEdit) { /* Check that editor configured */
1140 Int n = FILENAME_MAX;
1141 String he = hugsEdit;
1142 String ec = editorCmd;
1143 String rd = NULL; /* Set to nonnull to redo ... */
1145 for (; n>0 && *he && *he!=' '; n--)
1146 *ec++ = *he++; /* Copy editor name to buffer */
1147 /* assuming filename ends at space */
1149 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1150 rd = ec; /* save, in case we don't find name*/
1151 while (n>0 && *he) {
1153 if (*++he=='d' && n>10) {
1154 sprintf(ec,"%d",line);
1157 else if (*he=='s' && (size_t)n>strlen(nm)) {
1162 else if (*he=='%' && n>1) {
1166 else /* Ignore % char if not followed */
1167 *ec = '\0'; /* by one of d, s, or %, */
1168 for (; *ec && n>0; n--)
1170 } /* ignore % followed by anything other than d, s, or % */
1171 else { /* Copy other characters across */
1180 if (rd) { /* If file name was not included */
1185 if (nm && line==0 && n>1) { /* Name, but no line ... */
1187 for (; n>0 && *nm; n--) /* ... just copy file name */
1191 *ec = '\0'; /* Add terminating null byte */
1194 ERRMSG(0) "Hugs is not configured to use an editor"
1199 WinExec(editorCmd, SW_SHOW);
1202 if (shellEsc(editorCmd))
1203 Printf("Warning: Editor terminated abnormally\n");
1208 Int shellEsc(s) /* run a shell command (or shell) */
1211 return macsystem(s);
1215 s = fromEnv("SHELL","/bin/sh");
1222 #if RISCOS /* RISCOS also needs a chdir() */
1223 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1224 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1226 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1227 int chdir(const char *s) {
1230 wd.ioCompletion = 0;
1231 str = (char*)malloc(strlen(s) + 1);
1232 if (str == 0) return -1;
1234 wd.ioNamePtr = C2PStr(str);
1237 errno = PBHSetVolSync(&wd);
1248 /*---------------------------------------------------------------------------
1249 * Printf-related operations:
1250 *-------------------------------------------------------------------------*/
1252 #if !defined(HAVE_VSNPRINTF)
1253 int vsnprintf(buffer, count, fmt, ap)
1258 #if defined(HAVE__VSNPRINTF)
1259 return _vsnprintf(buffer, count, fmt, ap);
1264 #endif /* HAVE_VSNPRINTF */
1266 #if !defined(HAVE_SNPRINTF)
1267 int snprintf(char* buffer, int count, const char* fmt, ...) {
1268 #if defined(HAVE__VSNPRINTF)
1270 va_list ap; /* pointer into argument list */
1271 va_start(ap, fmt); /* make ap point to first arg after fmt */
1272 r = vsnprintf(buffer, count, fmt, ap);
1273 va_end(ap); /* clean up */
1279 #endif /* HAVE_SNPRINTF */
1281 /* --------------------------------------------------------------------------
1282 * Read/write values from/to the registry
1284 * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1285 * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
1286 * user entry doesn't exist).
1288 * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1289 * ------------------------------------------------------------------------*/
1293 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1295 static Bool local createKey Args((HKEY, PHKEY, REGSAM));
1296 static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1297 static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD));
1299 static Bool local createKey(hKey, phRootKey, samDesired)
1302 REGSAM samDesired; {
1304 return RegCreateKeyEx(hKey, HugsRoot,
1305 0, "", REG_OPTION_NON_VOLATILE,
1306 samDesired, NULL, phRootKey, &dwDisp)
1310 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1319 if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1322 LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1323 RegCloseKey(hRootKey);
1324 return (res == ERROR_SUCCESS);
1328 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1337 if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1340 LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1341 RegCloseKey(hRootKey);
1342 return (res == ERROR_SUCCESS);
1346 static String local readRegString(key,regPath,var,def) /* read String from registry */
1351 static char buf[300];
1353 if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1354 && type == REG_SZ) {
1361 static Int local readRegInt(var, def) /* read Int from registry */
1367 if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1368 (LPBYTE)&buf, sizeof(buf))
1369 && type == REG_DWORD) {
1371 } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1372 (LPBYTE)&buf, sizeof(buf))
1373 && type == REG_DWORD) {
1380 static Bool local writeRegString(var,val) /* write String to registry */
1386 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1387 REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1390 static Bool local writeRegInt(var,val) /* write String to registry */
1393 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1394 REG_DWORD, (LPBYTE)&val, sizeof(val));
1397 #endif /* USE_REGISTRY */
1399 /* --------------------------------------------------------------------------
1400 * Machine dependent control:
1401 * ------------------------------------------------------------------------*/
1403 Void machdep(what) /* Handle machine specific */
1404 Int what; { /* initialisation etc.. */
1407 case INSTALL : installHandlers();
1411 case EXIT : normalTerminal();
1412 #if HUGS_FOR_WINDOWS
1414 DestroyWindow(hWndMain);
1416 SetCursor(LoadCursor(NULL,IDC_ARROW));
1422 /*-------------------------------------------------------------------------*/