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 * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
10 * Yale Haskell Group, and the Oregon Graduate Institute of Science and
11 * Technology, 1994-1999, All rights reserved. It is distributed as
12 * free software under the license in the file "License", which is
13 * included in the distribution.
15 * $RCSfile: machdep.c,v $
17 * $Date: 1999/12/10 15:59:48 $
18 * ------------------------------------------------------------------------*/
23 #ifdef HAVE_SYS_TYPES_H
24 # include <sys/types.h>
31 # include <sys/param.h>
33 #ifdef HAVE_SYS_STAT_H
34 # include <sys/stat.h>
44 /* Windows/DOS include files */
48 #if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS
65 extern HCURSOR HandCursor; /* Forward references to cursors */
66 extern HCURSOR GarbageCursor;
67 extern HCURSOR SaveCursor;
68 static void local DrawStatusLine Args((HWND));
73 extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */
81 /* Macintosh include files */
104 int allow_break_count = 0;
107 /* --------------------------------------------------------------------------
108 * Prototypes for registry reading
109 * ------------------------------------------------------------------------*/
113 /* where have we hidden things in the registry? */
115 #define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\")
118 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
119 #define ProjectRoot ("SOFTWARE\\Haskell\\Projects\\")
121 static Bool local createKey Args((HKEY, String, PHKEY, REGSAM));
122 static Bool local queryValue Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD));
123 static Bool local setValue Args((HKEY, String, String, DWORD, LPBYTE, DWORD));
124 static String local readRegString Args((HKEY, String, String, String));
125 static Int local readRegInt Args((String,Int));
126 static Bool local writeRegString Args((String,String));
127 static Bool local writeRegInt Args((String,Int));
129 static String local readRegChildStrings Args((HKEY, String, String, Char, String));
130 #endif /* USE_REGISTRY */
132 /* --------------------------------------------------------------------------
133 * Find information about a file:
134 * ------------------------------------------------------------------------*/
137 typedef struct { unsigned hi, lo; } Time;
138 #define timeChanged(now,thn) (now.hi!=thn.hi || now.lo!=thn.lo)
139 #define timeSet(var,tm) var.hi = tm.hi; var.lo = tm.lo
140 error timeEarlier not defined
143 #define timeChanged(now,thn) (now!=thn)
144 #define timeSet(var,tm) var = tm
145 #define timeEarlier(earlier,now) (earlier < now)
148 static Bool local readable Args((String));
149 static Void local getFileInfo Args((String, Time *, Long *));
151 static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/
155 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
157 if (!stat(f,&scbuf)) {
158 if (tm) *tm = scbuf.st_mtime;
159 *sz = (Long)(scbuf.st_size);
164 #else /* normally just use stat() */
165 os_regset r; /* RISCOS PRM p.850 and p.837 */
166 r.r[0] = 17; /* Read catalogue, no path */
169 if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
170 if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
171 if (tm) tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
172 } else { /* Not found, or not time-stamped */
173 if (tm) tm->hi = tm->lo = 0;
175 *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
179 Void getFileSize ( String f, Long* sz )
181 getFileInfo ( f, NULL, sz );
184 #if defined HAVE_GETFINFO /* Mac971031 */
185 /* --------------------------------------------------------------------------
186 * Define a MacOS version of access():
187 * If the file is not accessible, -1 is returned and errno is set to
188 * the reason for the failure.
189 * If the file is accessible and the dummy is 0 (existence), 2 (write),
190 * or 4 (read), the return is 0.
191 * If the file is accessible, and the dummy is 1 (executable), then if
192 * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
193 * Warnings: Use with caution. UNIX access do no translate to Macs.
194 * Check of write access is not implemented (same as read).
195 * ------------------------------------------------------------------------*/
197 int access(char *fileName, int dummy) {
201 errno = getfinfo(fileName, 0, &fi);
202 if (errno != 0) return -1; /* Check file accessible. */
204 /* Cases dummy = existence, read, write. */
205 if (dummy == 0 || dummy & 0x6) return 0;
207 /* Case dummy = executable. */
209 if (fi.fdType == 'APPL') return 0;
218 static Bool local readable(f) /* is f a regular, readable file */
220 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
221 return (0 == access(f,4));
222 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
224 /* fprintf(stderr, "readable: %s\n", f ); */
225 return ( !stat(f,&scbuf)
226 && (scbuf.st_mode & S_IREAD) /* readable */
227 && (scbuf.st_mode & S_IFREG) /* regular file */
229 #elif defined HAVE_OS_SWI /* RISCOS specific */
230 os_regset r; /* RISCOS PRM p.850 -- JBS */
232 r.r[0] = 17; /* Read catalogue, no path */
235 return r.r[0] != 1; /* Does this check it's a regular file? ADR */
240 /* --------------------------------------------------------------------------
241 * Search for script files on the HUGS path:
242 * ------------------------------------------------------------------------*/
244 static String local hugsdir Args((Void));
246 static String local hscriptDir Args((Void));
248 //static String local RealPath Args((String));
249 static int local pathCmp Args((String, String));
250 static String local normPath Args((String));
251 static Void local searchChr Args((Int));
252 static Void local searchStr Args((String));
253 static Bool local tryEndings Args((String));
257 # define isSLASH(c) ((c)=='\\' || (c)=='/')
259 # define PATHSEP_STR ";"
260 # define DLL_ENDING ".dll"
263 # define isSLASH(c) ((c)==SLASH)
265 # define PATHSEP_STR ";"
266 /* Mac PEF (Preferred Executable Format) file */
267 # define DLL_ENDING ".pef"
270 # define isSLASH(c) ((c)==SLASH)
272 # define PATHSEP_STR ":"
273 # define DLL_ENDING ".u_o"
276 static String local hugsdir() { /* directory containing lib/Prelude.hs */
278 /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
279 static char dir[FILENAME_MAX+1] = "";
280 if (dir[0] == '\0') { /* not initialised yet */
281 String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
288 #elif HAVE_GETMODULEFILENAME && !DOS && !__CYGWIN32__
289 /* On Windows, we can find the binary we're running and it's
290 * conventional to put the libraries in the same place.
292 static char dir[FILENAME_MAX+1] = "";
293 if (dir[0] == '\0') { /* not initialised yet */
295 GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
296 if (dir[0] == '\0') { /* GetModuleFileName must have failed */
299 slash = strrchr(dir,SLASH);
300 if (slash) { /* truncate after directory name */
306 /* On Unix systems, we can't find the binary we're running and
307 * the libraries may not be installed near the binary anyway.
308 * This forces us to use a hardwired path which is set at
309 * configuration time (--datadir=...).
316 static String local hscriptDir() { /* Directory containing hscript.dll */
317 static char dir[FILENAME_MAX+1] = "";
318 if (dir[0] == '\0') { /* not initialised yet */
319 String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
328 #if 0 /* apparently unused */
329 static String local RealPath(s) /* Find absolute pathname of file */
331 #if HAVE__FULLPATH /* eg DOS */
332 static char path[FILENAME_MAX+1];
333 _fullpath(path,s,FILENAME_MAX+1);
334 #elif HAVE_REALPATH /* eg Unix */
335 static char path[MAXPATHLEN+1];
338 static char path[FILENAME_MAX+1];
346 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
349 #if HAVE__FULLPATH /* eg DOS */
350 static char path1[FILENAME_MAX+1];
351 static char path2[FILENAME_MAX+1];
352 _fullpath(path1,p1,FILENAME_MAX+1);
353 _fullpath(path2,p2,FILENAME_MAX+1);
354 #elif HAVE_REALPATH /* eg Unix */
355 static char path1[MAXPATHLEN+1];
356 static char path2[MAXPATHLEN+1];
360 static char path1[FILENAME_MAX+1];
361 static char path2[FILENAME_MAX+1];
365 #if CASE_INSENSITIVE_FILENAMES
369 return filenamecmp(path1,path2);
372 static String local normPath(s) /* Try, as much as possible, to normalize */
373 String s; { /* a pathname in some appropriate manner. */
374 #if PATH_CANONICALIZATION
375 String path = RealPath(s);
376 #if CASE_INSENSITIVE_FILENAMES
377 strlwr(path); /* and convert to lowercase */
380 #else /* ! PATH_CANONICALIZATION */
382 #endif /* ! PATH_CANONICALIZATION */
386 static String endings[] = { "", ".u_hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
388 static String endings[] = { "", ".u_hi", ".hs", ".lhs", 0 };
390 static char searchBuf[FILENAME_MAX+1];
391 static Int searchPos;
393 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
395 static Void local searchChr(c) /* Add single character to search buffer */
397 if (searchPos<FILENAME_MAX) {
398 searchBuf[searchPos++] = (char)c;
399 searchBuf[searchPos] = '\0';
403 static Void local searchStr(s) /* Add string to search buffer */
405 while (*s && searchPos<FILENAME_MAX)
406 searchBuf[searchPos++] = *s++;
407 searchBuf[searchPos] = '\0';
410 static Bool local tryEndings(s) /* Try each of the listed endings */
414 for (; endings[i]; ++i) {
415 Int save = searchPos;
416 searchStr(endings[i]);
417 if (readable(searchBuf))
428 /* scandir, June 98 Daan Leijen
429 searches the base directory and its direct subdirectories for a file
431 input: searchbuf contains SLASH terminated base directory
432 argument s contains the (base) filename
433 output: TRUE: searchBuf contains the full filename
434 FALSE: searchBuf is garbage, file not found
438 #ifdef HAVE_WINDOWS_H
440 static Bool scanSubDirs(s)
443 struct _finddata_t findInfo;
448 /* is it in the current directory ? */
449 if (tryEndings(s)) return TRUE;
454 /* initiate the search */
455 handle = _findfirst( searchBuf, &findInfo );
456 if (handle==-1) { errno = 0; return FALSE; }
458 /* search all subdirectories */
460 /* if we have a valid sub directory */
461 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
462 (findInfo.name[0] != '.')) {
464 searchStr(findInfo.name);
470 } while (_findnext( handle, &findInfo ) == 0);
472 _findclose( handle );
476 #elif defined(HAVE_FTW_H)
480 static char baseFile[FILENAME_MAX+1];
481 static char basePath[FILENAME_MAX+1];
482 static int basePathLen;
484 static int scanitem( const char* path,
485 const struct stat* statinfo,
488 if (info == FTW_D) { /* is it a directory */
492 if (tryEndings(baseFile)) {
499 static Bool scanSubDirs(s)
504 strcpy(basePath,searchBuf);
505 basePathLen = strlen(basePath);
507 /* is it in the current directory ? */
508 if (tryEndings(s)) return TRUE;
510 /* otherwise scan the subdirectories */
511 r = ftw( basePath, scanitem, 2 );
516 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
517 #endif /* SEARCH_DIR */
519 String findPathname(along,nm) /* Look for a file along specified path */
520 String along; /* Return NULL if file does not exist */
522 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
523 String s = findMPathname(along,nm,hugsPath);
528 s = findMPathname(along,nm,projectPath);
531 #endif /* USE_REGISTRY */
532 return s ? s : normPath(searchBuf);
535 /* AC, 1/21/99: modified to pass in path to search explicitly */
536 String findMPathname(along,nm,path)/* Look for a file along specified path */
537 String along; /* If nonzero, a path prefix from along is */
538 String nm; /* used as the first prefix in the search. */
540 String pathpt = path;
543 if (along) { /* Was a path for an existing file given? */
546 for (; along[i]; i++) {
548 if (isSLASH(along[i]))
554 return normPath(searchBuf);
556 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
559 Bool recurse = FALSE; /* DL: shall we recurse ? */
562 if (*pathpt!=PATHSEP) {
563 /* Pre-define one MPW-style "shell-variable" */
564 if (strncmp(pathpt,"{Hugs}",6)==0) {
565 searchStr(hugsdir());
569 /* And another - we ought to generalise this stuff */
570 else if (strncmp(pathpt,"{HScript}",9)==0) {
571 searchStr(hscriptDir());
576 searchChr(*pathpt++);
577 } while (*pathpt && *pathpt!=PATHSEP);
578 recurse = (pathpt[-1] == SLASH);
583 if (*pathpt==PATHSEP)
591 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
592 return normPath(searchBuf);
595 if (tryEndings(nm)) {
596 return normPath(searchBuf);
602 searchReset(0); /* As a last resort, look for file in the current dir */
603 return (tryEndings(nm) ? normPath(searchBuf) : 0);
606 /* --------------------------------------------------------------------------
607 * New path handling stuff for the Combined System (tm)
608 * ------------------------------------------------------------------------*/
610 char installDir[N_INSTALLDIR];
612 /* Sets installDir to $STGHUGSDIR, and ensures there is a trailing
615 void setInstallDir ( String argv_0 )
618 char* r = getenv("STGHUGSDIR");
621 "%s: installation error: environment variable STGHUGSDIR is not set.\n",
624 "%s: pls set it to be the directory where STGHugs98 is installed.\n\n",
630 if (strlen(r) > N_INSTALLDIR-30 ) {
632 "%s: environment variable STGHUGSDIR is suspiciously long; pls remedy\n\n",
637 strcpy ( installDir, r );
638 i = strlen(installDir);
639 if (installDir[i-1] != SLASH) installDir[i++] = SLASH;
644 Bool findFilesForModule (
648 Bool* sAvail, Time* sTime, Long* sSize,
649 Bool* iAvail, Time* iTime, Long* iSize,
650 Bool* oAvail, Time* oTime, Long* oSize
653 /* Let the module name given be M.
654 For each path entry P,
655 a s(rc) file will be P/M.hs or P/M.lhs
656 an i(nterface) file will be P/M.hi
657 an o(bject) file will be P/M.o
658 If there is a s file or (both i and o files)
659 use P to fill in the path names.
660 Otherwise, move on to the next path entry.
661 If all path entries are exhausted, return False.
665 String peStart, peEnd;
666 String augdPath; /* .:hugsPath:installDir/GhcPrel:installDir/lib */
668 *path = *sExt = NULL;
669 *sAvail = *iAvail = *oAvail = FALSE;
670 *sSize = *iSize = *oSize = 0;
672 augdPath = malloc( 2*(10+3+strlen(installDir))
673 +strlen(hugsPath) +10/*paranoia*/);
675 internal("moduleNameToFileNames: malloc failed(2)");
678 strcat(augdPath, ".");
679 strcat(augdPath, PATHSEP_STR);
681 strcat(augdPath, hugsPath);
682 strcat(augdPath, PATHSEP_STR);
685 strcat(augdPath, installDir);
686 strcat(augdPath, "GhcPrel");
687 strcat(augdPath, PATHSEP_STR);
690 strcat(augdPath, installDir);
691 strcat(augdPath, "lib");
692 strcat(augdPath, PATHSEP_STR);
694 /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */
698 /* Advance peStart and peEnd very paranoically, giving up at
699 the first sign of mutancy in the path string.
701 if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
704 while (*peEnd && *peEnd != PATHSEP) peEnd++;
706 /* Now peStart .. peEnd-1 bracket the next path element. */
707 nPath = peEnd-peStart;
708 if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
709 ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
716 strncpy(searchBuf, peStart, nPath);
717 searchBuf[nPath] = 0;
718 if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
719 searchBuf[nPath++] = SLASH;
721 strcpy(searchBuf+nPath, modName);
722 nPath += strlen(modName);
724 /* searchBuf now holds 'P/M'. Try out the various endings. */
725 *path = *sExt = NULL;
726 *sAvail = *iAvail = *oAvail = FALSE;
727 *sSize = *iSize = *oSize = 0;
729 strcpy(searchBuf+nPath, DLL_ENDING);
730 if (readable(searchBuf)) {
732 getFileInfo(searchBuf, oTime, oSize);
735 strcpy(searchBuf+nPath, ".u_hi");
736 if (readable(searchBuf)) {
738 getFileInfo(searchBuf, iTime, iSize);
741 strcpy(searchBuf+nPath, ".hs");
742 if (readable(searchBuf)) {
745 getFileInfo(searchBuf, sTime, sSize);
748 strcpy(searchBuf+nPath, ".lhs");
749 if (readable(searchBuf)) {
752 getFileInfo(searchBuf, sTime, sSize);
758 if (*sAvail || (*oAvail && *iAvail)) {
759 nPath -= strlen(modName);
760 *path = malloc(nPath+1);
762 internal("moduleNameToFileNames: malloc failed(1)");
763 strncpy(*path, searchBuf, nPath);
774 /* --------------------------------------------------------------------------
775 * Substitute old value of path into empty entries in new path
776 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
777 * ------------------------------------------------------------------------*/
779 static String local substPath Args((String,String));
781 static String local substPath(new,sub) /* substitute sub path into new path*/
784 Bool substituted = FALSE; /* only allow one replacement */
785 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
786 String r = (String) malloc(maxlen+1); /* result string */
787 String t = r; /* pointer into r */
788 String next = new; /* next uncopied char in new */
789 String start = next; /* start of last path component */
791 ERRMSG(0) "String storage space exhausted"
795 if (*next == PATHSEP || *next == '\0') {
796 if (!substituted && next == start) {
798 for(; *s != '\0'; ++s) {
805 } while ((*t++ = *next++) != '\0');
810 /* --------------------------------------------------------------------------
811 * Garbage collection notification:
812 * ------------------------------------------------------------------------*/
814 Bool gcMessages = FALSE; /* TRUE => print GC messages */
816 Void gcStarted() { /* Notify garbage collector start */
818 SaveCursor = SetCursor(GarbageCursor);
826 Void gcScanning() { /* Notify garbage collector scans */
833 Void gcRecovered(recovered) /* Notify garbage collection done */
836 Printf("%d}}",recovered);
840 SetCursor(SaveCursor);
844 Cell *CStackBase; /* Retain start of C control stack */
846 #if RISCOS /* Stack traversal for RISCOS */
848 /* Warning: The following code is specific to the Acorn ARM under RISCOS
849 (and C4). We must explicitly walk back through the stack frames, since
850 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
851 not be modified, since the offset '5' assumes that only v1 is used inside
852 this function. Hence we do all the real work in gcARM.
855 #define spreg 13 /* C3 has SP=R13 */
857 #define previousFrame(fp) ((int *)((fp)[-3]))
858 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
859 #define isSubSPSP(w) (((w)&dontCare) == doCare)
860 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
861 #define dontCare (~0x00100FFF) /* S and # bits */
862 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
864 static void gcARM(int *fp) {
865 int si = *programCounter(fp); /* Save instruction indicates how */
866 /* many registers in this frame */
868 if (si & (1<<0)) markWithoutMove(*regs--);
869 if (si & (1<<1)) markWithoutMove(*regs--);
870 if (si & (1<<2)) markWithoutMove(*regs--);
871 if (si & (1<<3)) markWithoutMove(*regs--);
872 if (si & (1<<4)) markWithoutMove(*regs--);
873 if (si & (1<<5)) markWithoutMove(*regs--);
874 if (si & (1<<6)) markWithoutMove(*regs--);
875 if (si & (1<<7)) markWithoutMove(*regs--);
876 if (si & (1<<8)) markWithoutMove(*regs--);
877 if (si & (1<<9)) markWithoutMove(*regs--);
878 if (previousFrame(fp)) {
879 /* The non-register stack space is for the previous frame is above
880 this fp, and not below the previous fp, because of the way stack
881 extension works. It seems the only way of discovering its size is
882 finding the SUB sp, sp, #? instruction by walking through the code
883 following the entry point.
885 int *oldpc = programCounter(previousFrame(fp));
887 for(i = 1; i < 6; ++i)
888 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
889 for(i=1; i<=fsize; ++i)
890 markWithoutMove(fp[i]);
896 int *fp = 5 + &dummy;
899 fp = previousFrame(fp);
903 #else /* Garbage collection for standard stack machines */
905 Void gcCStack() { /* Garbage collect elements off */
906 Cell stackTop = NIL; /* C stack */
907 Cell *ptr = &stackTop;
909 if (((long)(ptr) - (long)(CStackBase))&1)
911 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
912 if (((long)(ptr) - (long)(CStackBase))&1)
915 if (((long)(ptr) - (long)(CStackBase))&3)
919 #define Blargh markWithoutMove(*ptr);
921 markWithoutMove((*ptr)/sizeof(Cell)); \
922 markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \
923 markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
926 #define StackGrowsDown { while (ptr<=CStackBase) { Blargh; ptr++; }; }
927 #define StackGrowsUp { while (ptr>=CStackBase) { Blargh; ptr--; }; }
928 #define GuessDirection if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
930 #if STACK_DIRECTION > 0
932 #elif STACK_DIRECTION < 0
938 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
939 ptr = (Cell *)((long)(&stackTop) + 2);
943 #undef StackGrowsDown
945 #undef GuessDirection
949 /* --------------------------------------------------------------------------
950 * Terminal dependent stuff:
951 * ------------------------------------------------------------------------*/
953 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
955 /* grab the varargs prototype for ioctl */
957 # include <sys/ioctl.h>
960 /* The order of these three tests is very important because
961 * some systems have more than one of the requisite header file
962 * but only one of them seems to work.
963 * Anyone changing the order of the tests should try enabling each of the
964 * three branches in turn and write down which ones work as well as which
965 * OS/compiler they're using.
967 * OS Compiler sgtty termio termios notes
968 * Linux 2.0.18 gcc 2.7.2 absent works works 1
971 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
972 * implemented using termios.h.
973 * sgtty.h is in /usr/include/bsd which is not on my standard include
974 * path. Adding it does no harm but you might as well use termios.
976 * reid-alastair@cs.yale.edu
981 typedef struct termios TermParams;
982 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
983 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
984 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
991 typedef struct sgttyb TermParams;
992 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
993 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
995 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
997 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
1003 typedef struct termio TermParams;
1004 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
1005 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
1006 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
1007 tp.c_cc[VMIN] = 1; \
1012 static Bool messedWithTerminal = FALSE;
1013 static TermParams originalSettings;
1015 Void normalTerminal() { /* restore terminal initial state */
1016 if (messedWithTerminal)
1017 setTerminal(originalSettings);
1020 Void noechoTerminal() { /* set terminal into noecho mode */
1021 TermParams settings;
1023 if (!messedWithTerminal) {
1024 getTerminal(originalSettings);
1025 messedWithTerminal = TRUE;
1027 getTerminal(settings);
1029 setTerminal(settings);
1032 Int getTerminalWidth() { /* determine width of terminal */
1034 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
1035 #include <sys/stream.h> /* Required by sys/ptem.h */
1036 #include <sys/ptem.h> /* Required to declare winsize */
1038 static struct winsize terminalSize;
1039 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
1040 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
1046 Int readTerminalChar() { /* read character from terminal */
1047 return getchar(); /* without echo, assuming that */
1048 } /* noechoTerminal() is active... */
1052 Int readTerminalChar() { /* read character from terminal */
1053 return getchar(); /* without echo, assuming that */
1054 } /* noechoTerminal() is active... */
1056 Int getTerminalWidth() {
1057 return console_options.ncols;
1060 Void normalTerminal() {
1061 csetmode(C_ECHO, stdin);
1064 Void noechoTerminal() {
1065 csetmode(C_NOECHO, stdin);
1068 #else /* no terminal driver - eg DOS, RISCOS */
1070 static Bool terminalEchoReqd = TRUE;
1072 Int getTerminalWidth() {
1075 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1082 Void normalTerminal() { /* restore terminal initial state */
1083 terminalEchoReqd = TRUE;
1086 Void noechoTerminal() { /* turn terminal echo on/off */
1087 terminalEchoReqd = FALSE;
1090 Int readTerminalChar() { /* read character from terminal */
1091 if (terminalEchoReqd) {
1094 #if IS_WIN32 && !HUGS_FOR_WINDOWS && !__BORLANDC__
1095 /* When reading a character from the console/terminal, we want
1096 * to operate in 'raw' mode (to use old UNIX tty parlance) and have
1097 * it return when a character is available and _not_ wait until
1098 * the next time the user hits carriage return. On Windows platforms,
1099 * this _can_ be done by reading directly from the console, using
1100 * getch(). However, this doesn't sit well with programming
1101 * environments such as Emacs which allow you to create sub-processes
1102 * running Hugs, and then communicate with the running interpreter
1103 * through its standard input and output handles. If you use getch()
1104 * in that setting, you end up trying to read the (unused) console
1105 * of the editor itself, through which not a lot of characters is
1106 * bound to come out, since the editor communicates input to Hugs
1107 * via the standard input handle.
1109 * To avoid this rather unfortunate situation, we use the Win32
1110 * console API and re-jig the input properties of the standard
1111 * input handle before trying to read a character using stdio's
1114 * The 'cost' of this solution is that it is Win32 specific and
1115 * won't work with Windows 3.1 + it is kind of ugly and verbose
1116 * to have to futz around with the console properties on a
1117 * per-char basis. Both of these disadvantages aren't in my
1126 /* I don't quite understand why, but if the FILE*'s underlying file
1127 descriptor is in text mode, we seem to lose the first carriage
1130 setmode(fileno(stdin), _O_BINARY);
1131 hIn = GetStdHandle(STD_INPUT_HANDLE);
1132 GetConsoleMode(hIn, &mo);
1133 SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
1135 * On Win9x, the first time you change the mode (as above) a
1136 * raw '\n' is inserted. Since enter maps to a raw '\r', and we
1137 * map this (below) to '\n', we can just ignore all *raw* '\n's.
1141 } while (c == '\n');
1143 /* Same as it ever was - revert back state of stdin. */
1144 SetConsoleMode(hIn, mo);
1145 setmode(fileno(stdin), _O_TEXT);
1149 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
1153 #endif /* no terminal driver */
1155 /* --------------------------------------------------------------------------
1156 * Interrupt handling:
1157 * ------------------------------------------------------------------------*/
1159 Bool broken = FALSE;
1160 static Bool breakReqd = FALSE;
1161 static sigProto(ignoreBreak);
1162 static Void local installHandlers Args((Void));
1164 Bool breakOn(reqd) /* set break trapping on if reqd, */
1165 Bool reqd; { /* or off otherwise, returning old */
1166 Bool old = breakReqd;
1170 if (broken) { /* repond to break signal received */
1171 broken = FALSE; /* whilst break trap disabled */
1172 sigRaise(breakHandler);
1175 #if HANDLERS_CANT_LONGJMP
1176 ctrlbrk(ignoreBreak);
1178 ctrlbrk(breakHandler);
1181 ctrlbrk(ignoreBreak);
1186 static sigHandler(ignoreBreak) { /* record but don't respond to break*/
1187 ctrlbrk(ignoreBreak); /* reinstall signal handler */
1188 /* redundant on BSD systems but essential */
1189 /* on POSIX and other systems */
1196 static sigProto(panic);
1197 static sigHandler(panic) { /* exit in a panic, on receipt of */
1198 everybody(EXIT); /* an unexpected signal */
1199 fprintf(stderr,"\nUnexpected signal\n");
1201 sigResume;/*NOTREACHED*/
1203 #endif /* !DONT_PANIC */
1206 BOOL WINAPI consoleHandler(DWORD dwCtrlType) {
1207 switch (dwCtrlType) { /* Allows Hugs to be terminated */
1208 case CTRL_CLOSE_EVENT : /* from the window's close menu. */
1215 static Void local installHandlers() { /* Install handlers for all fatal */
1216 /* signals except SIGINT and SIGBREAK*/
1218 SetConsoleCtrlHandler(consoleHandler,TRUE);
1220 #if !DONT_PANIC && !DOS
1222 signal(SIGABRT,panic);
1225 signal(SIGBUS,panic);
1228 signal(SIGFPE,panic);
1231 signal(SIGHUP,panic);
1234 signal(SIGILL,panic);
1237 signal(SIGQUIT,panic);
1240 signal(SIGSEGV,panic);
1243 signal(SIGTERM,panic);
1245 #endif /* !DONT_PANIC && !DOS */
1248 /* --------------------------------------------------------------------------
1250 * ------------------------------------------------------------------------*/
1252 static Bool local startEdit(line,nm) /* Start editor on file name at */
1253 Int line; /* given line. Both name and line */
1254 String nm; { /* or just line may be zero */
1255 static char editorCmd[FILENAME_MAX+1];
1258 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1260 /* On a Mac, files have creator information, telling which program
1261 to launch to, so an editor named to the empty string "" is often
1263 if (hugsEdit) { /* Check that editor configured */
1265 Int n = FILENAME_MAX;
1266 String he = hugsEdit;
1267 String ec = editorCmd;
1268 String rd = NULL; /* Set to nonnull to redo ... */
1270 for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
1271 *ec++ = *he++; /* Copy editor name to buffer */
1272 /* assuming filename ends at space */
1274 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1275 rd = ec; /* save, in case we don't find name*/
1276 while (n>0 && *he) {
1278 if (*++he=='d' && n>10) {
1279 sprintf(ec,"%d",line);
1282 else if (*he=='s' && (size_t)n>strlen(nm)) {
1287 else if (*he=='%' && n>1) {
1291 else /* Ignore % char if not followed */
1292 *ec = '\0'; /* by one of d, s, or %, */
1293 for (; *ec && n>0; n--)
1295 } /* ignore % followed by anything other than d, s, or % */
1296 else { /* Copy other characters across */
1305 if (rd) { /* If file name was not included */
1310 if (nm && line==0 && n>1) { /* Name, but no line ... */
1312 for (; n>0 && *nm; n--) /* ... just copy file name */
1316 *ec = '\0'; /* Add terminating null byte */
1319 ERRMSG(0) "Hugs is not configured to use an editor"
1324 WinExec(editorCmd, SW_SHOW);
1327 if (shellEsc(editorCmd))
1328 Printf("Warning: Editor terminated abnormally\n");
1333 Int shellEsc(s) /* run a shell command (or shell) */
1336 return macsystem(s);
1340 s = fromEnv("SHELL","/bin/sh");
1347 #if RISCOS /* RISCOS also needs a chdir() */
1348 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1349 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1351 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1352 int chdir(const char *s) {
1355 wd.ioCompletion = 0;
1356 str = (char*)malloc(strlen(s) + 1);
1357 if (str == 0) return -1;
1359 wd.ioNamePtr = C2PStr(str);
1362 errno = PBHSetVolSync(&wd);
1373 /*---------------------------------------------------------------------------
1374 * Printf-related operations:
1375 *-------------------------------------------------------------------------*/
1377 #if !defined(HAVE_VSNPRINTF)
1378 int vsnprintf(buffer, count, fmt, ap)
1383 #if defined(HAVE__VSNPRINTF)
1384 return _vsnprintf(buffer, count, fmt, ap);
1389 #endif /* HAVE_VSNPRINTF */
1391 #if !defined(HAVE_SNPRINTF)
1392 int snprintf(char* buffer, int count, const char* fmt, ...) {
1393 #if defined(HAVE__VSNPRINTF)
1395 va_list ap; /* pointer into argument list */
1396 va_start(ap, fmt); /* make ap point to first arg after fmt */
1397 r = vsnprintf(buffer, count, fmt, ap);
1398 va_end(ap); /* clean up */
1404 #endif /* HAVE_SNPRINTF */
1406 /* --------------------------------------------------------------------------
1407 * Read/write values from/to the registry
1409 * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1410 * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
1411 * user entry doesn't exist).
1413 * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1414 * ------------------------------------------------------------------------*/
1418 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1420 static Bool local createKey Args((HKEY, PHKEY, REGSAM));
1421 static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1422 static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD));
1424 static Bool local createKey(hKey, phRootKey, samDesired)
1427 REGSAM samDesired; {
1429 return RegCreateKeyEx(hKey, HugsRoot,
1430 0, "", REG_OPTION_NON_VOLATILE,
1431 samDesired, NULL, phRootKey, &dwDisp)
1435 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1444 if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1447 LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1448 RegCloseKey(hRootKey);
1449 return (res == ERROR_SUCCESS);
1453 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1462 if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1465 LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1466 RegCloseKey(hRootKey);
1467 return (res == ERROR_SUCCESS);
1471 static String local readRegString(key,regPath,var,def) /* read String from registry */
1476 static char buf[300];
1478 if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1479 && type == REG_SZ) {
1486 static Int local readRegInt(var, def) /* read Int from registry */
1492 if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1493 (LPBYTE)&buf, sizeof(buf))
1494 && type == REG_DWORD) {
1496 } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1497 (LPBYTE)&buf, sizeof(buf))
1498 && type == REG_DWORD) {
1505 static Bool local writeRegString(var,val) /* write String to registry */
1511 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1512 REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1515 static Bool local writeRegInt(var,val) /* write String to registry */
1518 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1519 REG_DWORD, (LPBYTE)&val, sizeof(val));
1522 #endif /* USE_REGISTRY */
1524 /* --------------------------------------------------------------------------
1525 * Things to do with the argv/argc and the env
1526 * ------------------------------------------------------------------------*/
1528 int nh_argc ( void )
1533 int nh_argvb ( int argno, int offset )
1535 return (int)(prog_argv[argno][offset]);
1538 /* --------------------------------------------------------------------------
1539 * Machine dependent control:
1540 * ------------------------------------------------------------------------*/
1542 Void machdep(what) /* Handle machine specific */
1543 Int what; { /* initialisation etc.. */
1546 case POSTPREL: break;
1547 case PREPREL : installHandlers();
1551 case EXIT : normalTerminal();
1552 #if HUGS_FOR_WINDOWS
1554 DestroyWindow(hWndMain);
1556 SetCursor(LoadCursor(NULL,IDC_ARROW));
1562 /*-------------------------------------------------------------------------*/