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/11/24 10:38:10 $
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 DLL_ENDING ".dll"
262 # define isSLASH(c) ((c)==SLASH)
264 /* Mac PEF (Preferred Executable Format) file */
265 # define DLL_ENDING ".pef"
268 # define isSLASH(c) ((c)==SLASH)
270 # define DLL_ENDING ".o"
273 static String local hugsdir() { /* directory containing lib/Prelude.hs */
275 /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
276 static char dir[FILENAME_MAX+1] = "";
277 if (dir[0] == '\0') { /* not initialised yet */
278 String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
285 #elif HAVE_GETMODULEFILENAME && !DOS && !__CYGWIN32__
286 /* On Windows, we can find the binary we're running and it's
287 * conventional to put the libraries in the same place.
289 static char dir[FILENAME_MAX+1] = "";
290 if (dir[0] == '\0') { /* not initialised yet */
292 GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
293 if (dir[0] == '\0') { /* GetModuleFileName must have failed */
296 slash = strrchr(dir,SLASH);
297 if (slash) { /* truncate after directory name */
303 /* On Unix systems, we can't find the binary we're running and
304 * the libraries may not be installed near the binary anyway.
305 * This forces us to use a hardwired path which is set at
306 * configuration time (--datadir=...).
313 static String local hscriptDir() { /* Directory containing hscript.dll */
314 static char dir[FILENAME_MAX+1] = "";
315 if (dir[0] == '\0') { /* not initialised yet */
316 String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
325 #if 0 /* apparently unused */
326 static String local RealPath(s) /* Find absolute pathname of file */
328 #if HAVE__FULLPATH /* eg DOS */
329 static char path[FILENAME_MAX+1];
330 _fullpath(path,s,FILENAME_MAX+1);
331 #elif HAVE_REALPATH /* eg Unix */
332 static char path[MAXPATHLEN+1];
335 static char path[FILENAME_MAX+1];
343 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
346 #if HAVE__FULLPATH /* eg DOS */
347 static char path1[FILENAME_MAX+1];
348 static char path2[FILENAME_MAX+1];
349 _fullpath(path1,p1,FILENAME_MAX+1);
350 _fullpath(path2,p2,FILENAME_MAX+1);
351 #elif HAVE_REALPATH /* eg Unix */
352 static char path1[MAXPATHLEN+1];
353 static char path2[MAXPATHLEN+1];
357 static char path1[FILENAME_MAX+1];
358 static char path2[FILENAME_MAX+1];
362 #if CASE_INSENSITIVE_FILENAMES
366 return filenamecmp(path1,path2);
369 static String local normPath(s) /* Try, as much as possible, to normalize */
370 String s; { /* a pathname in some appropriate manner. */
371 #if PATH_CANONICALIZATION
372 String path = RealPath(s);
373 #if CASE_INSENSITIVE_FILENAMES
374 strlwr(path); /* and convert to lowercase */
377 #else /* ! PATH_CANONICALIZATION */
379 #endif /* ! PATH_CANONICALIZATION */
383 static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
385 static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
387 static char searchBuf[FILENAME_MAX+1];
388 static Int searchPos;
390 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
392 static Void local searchChr(c) /* Add single character to search buffer */
394 if (searchPos<FILENAME_MAX) {
395 searchBuf[searchPos++] = (char)c;
396 searchBuf[searchPos] = '\0';
400 static Void local searchStr(s) /* Add string to search buffer */
402 while (*s && searchPos<FILENAME_MAX)
403 searchBuf[searchPos++] = *s++;
404 searchBuf[searchPos] = '\0';
407 static Bool local tryEndings(s) /* Try each of the listed endings */
411 for (; endings[i]; ++i) {
412 Int save = searchPos;
413 searchStr(endings[i]);
414 if (readable(searchBuf))
425 /* scandir, June 98 Daan Leijen
426 searches the base directory and its direct subdirectories for a file
428 input: searchbuf contains SLASH terminated base directory
429 argument s contains the (base) filename
430 output: TRUE: searchBuf contains the full filename
431 FALSE: searchBuf is garbage, file not found
435 #ifdef HAVE_WINDOWS_H
437 static Bool scanSubDirs(s)
440 struct _finddata_t findInfo;
445 /* is it in the current directory ? */
446 if (tryEndings(s)) return TRUE;
451 /* initiate the search */
452 handle = _findfirst( searchBuf, &findInfo );
453 if (handle==-1) { errno = 0; return FALSE; }
455 /* search all subdirectories */
457 /* if we have a valid sub directory */
458 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
459 (findInfo.name[0] != '.')) {
461 searchStr(findInfo.name);
467 } while (_findnext( handle, &findInfo ) == 0);
469 _findclose( handle );
473 #elif defined(HAVE_FTW_H)
477 static char baseFile[FILENAME_MAX+1];
478 static char basePath[FILENAME_MAX+1];
479 static int basePathLen;
481 static int scanitem( const char* path,
482 const struct stat* statinfo,
485 if (info == FTW_D) { /* is it a directory */
489 if (tryEndings(baseFile)) {
496 static Bool scanSubDirs(s)
501 strcpy(basePath,searchBuf);
502 basePathLen = strlen(basePath);
504 /* is it in the current directory ? */
505 if (tryEndings(s)) return TRUE;
507 /* otherwise scan the subdirectories */
508 r = ftw( basePath, scanitem, 2 );
513 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
514 #endif /* SEARCH_DIR */
516 String findPathname(along,nm) /* Look for a file along specified path */
517 String along; /* Return NULL if file does not exist */
519 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
520 String s = findMPathname(along,nm,hugsPath);
525 s = findMPathname(along,nm,projectPath);
528 #endif /* USE_REGISTRY */
529 return s ? s : normPath(searchBuf);
532 /* AC, 1/21/99: modified to pass in path to search explicitly */
533 String findMPathname(along,nm,path)/* Look for a file along specified path */
534 String along; /* If nonzero, a path prefix from along is */
535 String nm; /* used as the first prefix in the search. */
537 String pathpt = path;
540 if (along) { /* Was a path for an existing file given? */
543 for (; along[i]; i++) {
545 if (isSLASH(along[i]))
551 return normPath(searchBuf);
553 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
556 Bool recurse = FALSE; /* DL: shall we recurse ? */
559 if (*pathpt!=PATHSEP) {
560 /* Pre-define one MPW-style "shell-variable" */
561 if (strncmp(pathpt,"{Hugs}",6)==0) {
562 searchStr(hugsdir());
566 /* And another - we ought to generalise this stuff */
567 else if (strncmp(pathpt,"{HScript}",9)==0) {
568 searchStr(hscriptDir());
573 searchChr(*pathpt++);
574 } while (*pathpt && *pathpt!=PATHSEP);
575 recurse = (pathpt[-1] == SLASH);
580 if (*pathpt==PATHSEP)
588 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
589 return normPath(searchBuf);
592 if (tryEndings(nm)) {
593 return normPath(searchBuf);
599 searchReset(0); /* As a last resort, look for file in the current dir */
600 return (tryEndings(nm) ? normPath(searchBuf) : 0);
603 /* --------------------------------------------------------------------------
604 * New path handling stuff for the Combined System (tm)
605 * ------------------------------------------------------------------------*/
607 #define N_DEFAULT_LIBDIR 1000
608 char defaultLibDir[N_DEFAULT_LIBDIR];
610 /* Assumes that getcwd()++argv[0] is the absolute path to the
611 executable. Basically wrong.
613 void setDefaultLibDir ( String argv_0 )
616 if (argv_0[0] != SLASH) {
617 if (!getcwd(defaultLibDir,N_DEFAULT_LIBDIR-strlen(argv_0)-10)) {
618 ERRMSG(0) "Can't get current working directory"
621 i = strlen(defaultLibDir);
622 if (defaultLibDir[i-1] != SLASH) defaultLibDir[i++] = SLASH;
626 strcpy(&defaultLibDir[i],argv_0);
628 while (defaultLibDir[i] != SLASH) i--;
630 strcpy(&defaultLibDir[i], "lib");
631 fprintf ( stderr, "default lib dir = %s\n", defaultLibDir );
634 Bool findFilesForModule (
638 Bool* sAvail, Time* sTime, Long* sSize,
639 Bool* iAvail, Time* iTime, Long* iSize,
640 Bool* oAvail, Time* oTime, Long* oSize
643 /* Let the module name given be M.
644 For each path entry P,
645 a s(rc) file will be P/M.hs or P/M.lhs
646 an i(nterface) file will be P/M.hi
647 an o(bject) file will be P/M.o
648 If there is a s file or (both i and o files)
649 use P to fill in the path names.
650 Otherwise, move on to the next path entry.
651 If all path entries are exhausted, return False.
655 String peStart, peEnd;
656 String augdPath; /* .:hugsPath:defaultLibDir */
658 *path = *sExt = NULL;
659 *sAvail = *iAvail = *oAvail = FALSE;
660 *sSize = *iSize = *oSize = 0;
662 augdPath = malloc(4+strlen(defaultLibDir)+strlen(hugsPath));
664 internal("moduleNameToFileNames: malloc failed(2)");
666 augdPath[1] = PATHSEP;
668 strcat ( augdPath, hugsPath );
669 augdPath[2+strlen(hugsPath)] = PATHSEP;
670 augdPath[3+strlen(hugsPath)] = 0;
671 strcat(augdPath,defaultLibDir);
675 /* Advance peStart and peEnd very paranoically, giving up at
676 the first sign of mutancy in the path string.
678 if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
681 while (*peEnd && *peEnd != PATHSEP) peEnd++;
683 /* Now peStart .. peEnd-1 bracket the next path element. */
684 nPath = peEnd-peStart;
685 if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
686 ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
693 strncpy(searchBuf, peStart, nPath);
694 searchBuf[nPath] = 0;
695 if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
696 searchBuf[nPath++] = SLASH;
698 strcpy(searchBuf+nPath, modName);
699 nPath += strlen(modName);
701 /* searchBuf now holds 'P/M'. Try out the various endings. */
702 *path = *sExt = NULL;
703 *sAvail = *iAvail = *oAvail = FALSE;
704 *sSize = *iSize = *oSize = 0;
706 strcpy(searchBuf+nPath, DLL_ENDING);
707 if (readable(searchBuf)) {
709 getFileInfo(searchBuf, oTime, oSize);
712 strcpy(searchBuf+nPath, ".hi");
713 if (readable(searchBuf)) {
715 getFileInfo(searchBuf, iTime, iSize);
718 strcpy(searchBuf+nPath, ".hs");
719 if (readable(searchBuf)) {
722 getFileInfo(searchBuf, sTime, sSize);
725 strcpy(searchBuf+nPath, ".lhs");
726 if (readable(searchBuf)) {
729 getFileInfo(searchBuf, sTime, sSize);
735 if (*sAvail || (*oAvail && *iAvail)) {
736 nPath -= strlen(modName);
737 *path = malloc(nPath+1);
739 internal("moduleNameToFileNames: malloc failed(1)");
740 strncpy(*path, searchBuf, nPath);
751 /* --------------------------------------------------------------------------
752 * Substitute old value of path into empty entries in new path
753 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
754 * ------------------------------------------------------------------------*/
756 static String local substPath Args((String,String));
758 static String local substPath(new,sub) /* substitute sub path into new path*/
761 Bool substituted = FALSE; /* only allow one replacement */
762 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
763 String r = (String) malloc(maxlen+1); /* result string */
764 String t = r; /* pointer into r */
765 String next = new; /* next uncopied char in new */
766 String start = next; /* start of last path component */
768 ERRMSG(0) "String storage space exhausted"
772 if (*next == PATHSEP || *next == '\0') {
773 if (!substituted && next == start) {
775 for(; *s != '\0'; ++s) {
782 } while ((*t++ = *next++) != '\0');
787 /* --------------------------------------------------------------------------
788 * Garbage collection notification:
789 * ------------------------------------------------------------------------*/
791 Bool gcMessages = FALSE; /* TRUE => print GC messages */
793 Void gcStarted() { /* Notify garbage collector start */
795 SaveCursor = SetCursor(GarbageCursor);
803 Void gcScanning() { /* Notify garbage collector scans */
810 Void gcRecovered(recovered) /* Notify garbage collection done */
813 Printf("%d}}",recovered);
817 SetCursor(SaveCursor);
821 Cell *CStackBase; /* Retain start of C control stack */
823 #if RISCOS /* Stack traversal for RISCOS */
825 /* Warning: The following code is specific to the Acorn ARM under RISCOS
826 (and C4). We must explicitly walk back through the stack frames, since
827 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
828 not be modified, since the offset '5' assumes that only v1 is used inside
829 this function. Hence we do all the real work in gcARM.
832 #define spreg 13 /* C3 has SP=R13 */
834 #define previousFrame(fp) ((int *)((fp)[-3]))
835 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
836 #define isSubSPSP(w) (((w)&dontCare) == doCare)
837 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
838 #define dontCare (~0x00100FFF) /* S and # bits */
839 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
841 static void gcARM(int *fp) {
842 int si = *programCounter(fp); /* Save instruction indicates how */
843 /* many registers in this frame */
845 if (si & (1<<0)) markWithoutMove(*regs--);
846 if (si & (1<<1)) markWithoutMove(*regs--);
847 if (si & (1<<2)) markWithoutMove(*regs--);
848 if (si & (1<<3)) markWithoutMove(*regs--);
849 if (si & (1<<4)) markWithoutMove(*regs--);
850 if (si & (1<<5)) markWithoutMove(*regs--);
851 if (si & (1<<6)) markWithoutMove(*regs--);
852 if (si & (1<<7)) markWithoutMove(*regs--);
853 if (si & (1<<8)) markWithoutMove(*regs--);
854 if (si & (1<<9)) markWithoutMove(*regs--);
855 if (previousFrame(fp)) {
856 /* The non-register stack space is for the previous frame is above
857 this fp, and not below the previous fp, because of the way stack
858 extension works. It seems the only way of discovering its size is
859 finding the SUB sp, sp, #? instruction by walking through the code
860 following the entry point.
862 int *oldpc = programCounter(previousFrame(fp));
864 for(i = 1; i < 6; ++i)
865 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
866 for(i=1; i<=fsize; ++i)
867 markWithoutMove(fp[i]);
873 int *fp = 5 + &dummy;
876 fp = previousFrame(fp);
880 #else /* Garbage collection for standard stack machines */
882 Void gcCStack() { /* Garbage collect elements off */
883 Cell stackTop = NIL; /* C stack */
884 Cell *ptr = &stackTop;
886 if (((long)(ptr) - (long)(CStackBase))&1)
888 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
889 if (((long)(ptr) - (long)(CStackBase))&1)
892 if (((long)(ptr) - (long)(CStackBase))&3)
896 #define Blargh markWithoutMove(*ptr);
898 markWithoutMove((*ptr)/sizeof(Cell)); \
899 markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \
900 markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
903 #define StackGrowsDown { while (ptr<=CStackBase) { Blargh; ptr++; }; }
904 #define StackGrowsUp { while (ptr>=CStackBase) { Blargh; ptr--; }; }
905 #define GuessDirection if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
907 #if STACK_DIRECTION > 0
909 #elif STACK_DIRECTION < 0
915 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
916 ptr = (Cell *)((long)(&stackTop) + 2);
920 #undef StackGrowsDown
922 #undef GuessDirection
926 /* --------------------------------------------------------------------------
927 * Terminal dependent stuff:
928 * ------------------------------------------------------------------------*/
930 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
932 /* grab the varargs prototype for ioctl */
934 # include <sys/ioctl.h>
937 /* The order of these three tests is very important because
938 * some systems have more than one of the requisite header file
939 * but only one of them seems to work.
940 * Anyone changing the order of the tests should try enabling each of the
941 * three branches in turn and write down which ones work as well as which
942 * OS/compiler they're using.
944 * OS Compiler sgtty termio termios notes
945 * Linux 2.0.18 gcc 2.7.2 absent works works 1
948 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
949 * implemented using termios.h.
950 * sgtty.h is in /usr/include/bsd which is not on my standard include
951 * path. Adding it does no harm but you might as well use termios.
953 * reid-alastair@cs.yale.edu
958 typedef struct termios TermParams;
959 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
960 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
961 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
968 typedef struct sgttyb TermParams;
969 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
970 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
972 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
974 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
980 typedef struct termio TermParams;
981 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
982 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
983 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
989 static Bool messedWithTerminal = FALSE;
990 static TermParams originalSettings;
992 Void normalTerminal() { /* restore terminal initial state */
993 if (messedWithTerminal)
994 setTerminal(originalSettings);
997 Void noechoTerminal() { /* set terminal into noecho mode */
1000 if (!messedWithTerminal) {
1001 getTerminal(originalSettings);
1002 messedWithTerminal = TRUE;
1004 getTerminal(settings);
1006 setTerminal(settings);
1009 Int getTerminalWidth() { /* determine width of terminal */
1011 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
1012 #include <sys/stream.h> /* Required by sys/ptem.h */
1013 #include <sys/ptem.h> /* Required to declare winsize */
1015 static struct winsize terminalSize;
1016 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
1017 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
1023 Int readTerminalChar() { /* read character from terminal */
1024 return getchar(); /* without echo, assuming that */
1025 } /* noechoTerminal() is active... */
1029 Int readTerminalChar() { /* read character from terminal */
1030 return getchar(); /* without echo, assuming that */
1031 } /* noechoTerminal() is active... */
1033 Int getTerminalWidth() {
1034 return console_options.ncols;
1037 Void normalTerminal() {
1038 csetmode(C_ECHO, stdin);
1041 Void noechoTerminal() {
1042 csetmode(C_NOECHO, stdin);
1045 #else /* no terminal driver - eg DOS, RISCOS */
1047 static Bool terminalEchoReqd = TRUE;
1049 Int getTerminalWidth() {
1052 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1059 Void normalTerminal() { /* restore terminal initial state */
1060 terminalEchoReqd = TRUE;
1063 Void noechoTerminal() { /* turn terminal echo on/off */
1064 terminalEchoReqd = FALSE;
1067 Int readTerminalChar() { /* read character from terminal */
1068 if (terminalEchoReqd) {
1071 #if IS_WIN32 && !HUGS_FOR_WINDOWS && !__BORLANDC__
1072 /* When reading a character from the console/terminal, we want
1073 * to operate in 'raw' mode (to use old UNIX tty parlance) and have
1074 * it return when a character is available and _not_ wait until
1075 * the next time the user hits carriage return. On Windows platforms,
1076 * this _can_ be done by reading directly from the console, using
1077 * getch(). However, this doesn't sit well with programming
1078 * environments such as Emacs which allow you to create sub-processes
1079 * running Hugs, and then communicate with the running interpreter
1080 * through its standard input and output handles. If you use getch()
1081 * in that setting, you end up trying to read the (unused) console
1082 * of the editor itself, through which not a lot of characters is
1083 * bound to come out, since the editor communicates input to Hugs
1084 * via the standard input handle.
1086 * To avoid this rather unfortunate situation, we use the Win32
1087 * console API and re-jig the input properties of the standard
1088 * input handle before trying to read a character using stdio's
1091 * The 'cost' of this solution is that it is Win32 specific and
1092 * won't work with Windows 3.1 + it is kind of ugly and verbose
1093 * to have to futz around with the console properties on a
1094 * per-char basis. Both of these disadvantages aren't in my
1103 /* I don't quite understand why, but if the FILE*'s underlying file
1104 descriptor is in text mode, we seem to lose the first carriage
1107 setmode(fileno(stdin), _O_BINARY);
1108 hIn = GetStdHandle(STD_INPUT_HANDLE);
1109 GetConsoleMode(hIn, &mo);
1110 SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
1112 * On Win9x, the first time you change the mode (as above) a
1113 * raw '\n' is inserted. Since enter maps to a raw '\r', and we
1114 * map this (below) to '\n', we can just ignore all *raw* '\n's.
1118 } while (c == '\n');
1120 /* Same as it ever was - revert back state of stdin. */
1121 SetConsoleMode(hIn, mo);
1122 setmode(fileno(stdin), _O_TEXT);
1126 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
1130 #endif /* no terminal driver */
1132 /* --------------------------------------------------------------------------
1133 * Interrupt handling:
1134 * ------------------------------------------------------------------------*/
1136 Bool broken = FALSE;
1137 static Bool breakReqd = FALSE;
1138 static sigProto(ignoreBreak);
1139 static Void local installHandlers Args((Void));
1141 Bool breakOn(reqd) /* set break trapping on if reqd, */
1142 Bool reqd; { /* or off otherwise, returning old */
1143 Bool old = breakReqd;
1147 if (broken) { /* repond to break signal received */
1148 broken = FALSE; /* whilst break trap disabled */
1149 sigRaise(breakHandler);
1152 #if HANDLERS_CANT_LONGJMP
1153 ctrlbrk(ignoreBreak);
1155 ctrlbrk(breakHandler);
1158 ctrlbrk(ignoreBreak);
1163 static sigHandler(ignoreBreak) { /* record but don't respond to break*/
1164 ctrlbrk(ignoreBreak); /* reinstall signal handler */
1165 /* redundant on BSD systems but essential */
1166 /* on POSIX and other systems */
1173 static sigProto(panic);
1174 static sigHandler(panic) { /* exit in a panic, on receipt of */
1175 everybody(EXIT); /* an unexpected signal */
1176 fprintf(stderr,"\nUnexpected signal\n");
1178 sigResume;/*NOTREACHED*/
1180 #endif /* !DONT_PANIC */
1183 BOOL WINAPI consoleHandler(DWORD dwCtrlType) {
1184 switch (dwCtrlType) { /* Allows Hugs to be terminated */
1185 case CTRL_CLOSE_EVENT : /* from the window's close menu. */
1192 static Void local installHandlers() { /* Install handlers for all fatal */
1193 /* signals except SIGINT and SIGBREAK*/
1195 SetConsoleCtrlHandler(consoleHandler,TRUE);
1197 #if !DONT_PANIC && !DOS
1199 signal(SIGABRT,panic);
1202 signal(SIGBUS,panic);
1205 signal(SIGFPE,panic);
1208 signal(SIGHUP,panic);
1211 signal(SIGILL,panic);
1214 signal(SIGQUIT,panic);
1217 signal(SIGSEGV,panic);
1220 signal(SIGTERM,panic);
1222 #endif /* !DONT_PANIC && !DOS */
1225 /* --------------------------------------------------------------------------
1227 * ------------------------------------------------------------------------*/
1229 static Bool local startEdit(line,nm) /* Start editor on file name at */
1230 Int line; /* given line. Both name and line */
1231 String nm; { /* or just line may be zero */
1232 static char editorCmd[FILENAME_MAX+1];
1235 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1237 /* On a Mac, files have creator information, telling which program
1238 to launch to, so an editor named to the empty string "" is often
1240 if (hugsEdit) { /* Check that editor configured */
1242 Int n = FILENAME_MAX;
1243 String he = hugsEdit;
1244 String ec = editorCmd;
1245 String rd = NULL; /* Set to nonnull to redo ... */
1247 for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
1248 *ec++ = *he++; /* Copy editor name to buffer */
1249 /* assuming filename ends at space */
1251 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1252 rd = ec; /* save, in case we don't find name*/
1253 while (n>0 && *he) {
1255 if (*++he=='d' && n>10) {
1256 sprintf(ec,"%d",line);
1259 else if (*he=='s' && (size_t)n>strlen(nm)) {
1264 else if (*he=='%' && n>1) {
1268 else /* Ignore % char if not followed */
1269 *ec = '\0'; /* by one of d, s, or %, */
1270 for (; *ec && n>0; n--)
1272 } /* ignore % followed by anything other than d, s, or % */
1273 else { /* Copy other characters across */
1282 if (rd) { /* If file name was not included */
1287 if (nm && line==0 && n>1) { /* Name, but no line ... */
1289 for (; n>0 && *nm; n--) /* ... just copy file name */
1293 *ec = '\0'; /* Add terminating null byte */
1296 ERRMSG(0) "Hugs is not configured to use an editor"
1301 WinExec(editorCmd, SW_SHOW);
1304 if (shellEsc(editorCmd))
1305 Printf("Warning: Editor terminated abnormally\n");
1310 Int shellEsc(s) /* run a shell command (or shell) */
1313 return macsystem(s);
1317 s = fromEnv("SHELL","/bin/sh");
1324 #if RISCOS /* RISCOS also needs a chdir() */
1325 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1326 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1328 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1329 int chdir(const char *s) {
1332 wd.ioCompletion = 0;
1333 str = (char*)malloc(strlen(s) + 1);
1334 if (str == 0) return -1;
1336 wd.ioNamePtr = C2PStr(str);
1339 errno = PBHSetVolSync(&wd);
1350 /*---------------------------------------------------------------------------
1351 * Printf-related operations:
1352 *-------------------------------------------------------------------------*/
1354 #if !defined(HAVE_VSNPRINTF)
1355 int vsnprintf(buffer, count, fmt, ap)
1360 #if defined(HAVE__VSNPRINTF)
1361 return _vsnprintf(buffer, count, fmt, ap);
1366 #endif /* HAVE_VSNPRINTF */
1368 #if !defined(HAVE_SNPRINTF)
1369 int snprintf(char* buffer, int count, const char* fmt, ...) {
1370 #if defined(HAVE__VSNPRINTF)
1372 va_list ap; /* pointer into argument list */
1373 va_start(ap, fmt); /* make ap point to first arg after fmt */
1374 r = vsnprintf(buffer, count, fmt, ap);
1375 va_end(ap); /* clean up */
1381 #endif /* HAVE_SNPRINTF */
1383 /* --------------------------------------------------------------------------
1384 * Read/write values from/to the registry
1386 * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or
1387 * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key. (Machine entry is only used if
1388 * user entry doesn't exist).
1390 * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1391 * ------------------------------------------------------------------------*/
1395 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1397 static Bool local createKey Args((HKEY, PHKEY, REGSAM));
1398 static Bool local queryValue Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1399 static Bool local setValue Args((HKEY, String, DWORD, LPBYTE, DWORD));
1401 static Bool local createKey(hKey, phRootKey, samDesired)
1404 REGSAM samDesired; {
1406 return RegCreateKeyEx(hKey, HugsRoot,
1407 0, "", REG_OPTION_NON_VOLATILE,
1408 samDesired, NULL, phRootKey, &dwDisp)
1412 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1421 if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1424 LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1425 RegCloseKey(hRootKey);
1426 return (res == ERROR_SUCCESS);
1430 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1439 if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1442 LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1443 RegCloseKey(hRootKey);
1444 return (res == ERROR_SUCCESS);
1448 static String local readRegString(key,regPath,var,def) /* read String from registry */
1453 static char buf[300];
1455 if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1456 && type == REG_SZ) {
1463 static Int local readRegInt(var, def) /* read Int from registry */
1469 if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type,
1470 (LPBYTE)&buf, sizeof(buf))
1471 && type == REG_DWORD) {
1473 } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type,
1474 (LPBYTE)&buf, sizeof(buf))
1475 && type == REG_DWORD) {
1482 static Bool local writeRegString(var,val) /* write String to registry */
1488 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1489 REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1492 static Bool local writeRegInt(var,val) /* write String to registry */
1495 return setValue(HKEY_CURRENT_USER, HugsRoot, var,
1496 REG_DWORD, (LPBYTE)&val, sizeof(val));
1499 #endif /* USE_REGISTRY */
1501 /* --------------------------------------------------------------------------
1502 * Things to do with the argv/argc and the env
1503 * ------------------------------------------------------------------------*/
1505 int nh_argc ( void )
1510 int nh_argvb ( int argno, int offset )
1512 return (int)(prog_argv[argno][offset]);
1515 /* --------------------------------------------------------------------------
1516 * Machine dependent control:
1517 * ------------------------------------------------------------------------*/
1519 Void machdep(what) /* Handle machine specific */
1520 Int what; { /* initialisation etc.. */
1523 case INSTALL : installHandlers();
1527 case EXIT : normalTerminal();
1528 #if HUGS_FOR_WINDOWS
1530 DestroyWindow(hWndMain);
1532 SetCursor(LoadCursor(NULL,IDC_ARROW));
1538 /*-------------------------------------------------------------------------*/