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: 2000/04/12 09:43: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
63 extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */
71 /* Macintosh include files */
94 int allow_break_count = 0;
97 /* --------------------------------------------------------------------------
98 * Find information about a file:
99 * ------------------------------------------------------------------------*/
101 #include "machdep_time.h"
103 static Bool local readable ( String );
104 static Void local getFileInfo ( String, Time *, Long * );
106 static Void local getFileInfo(f,tm,sz) /* find time stamp and size of file*/
110 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
112 if (!stat(f,&scbuf)) {
113 if (tm) *tm = scbuf.st_mtime;
114 *sz = (Long)(scbuf.st_size);
119 #else /* normally just use stat() */
120 os_regset r; /* RISCOS PRM p.850 and p.837 */
121 r.r[0] = 17; /* Read catalogue, no path */
124 if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
125 if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */
126 if (tm) tm->lo = r.r[3]; /* Execution address (low 4 bytes) */
127 } else { /* Not found, or not time-stamped */
128 if (tm) tm->hi = tm->lo = 0;
130 *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
134 Void getFileSize ( String f, Long* sz )
136 getFileInfo ( f, NULL, sz );
139 #if defined HAVE_GETFINFO /* Mac971031 */
140 /* --------------------------------------------------------------------------
141 * Define a MacOS version of access():
142 * If the file is not accessible, -1 is returned and errno is set to
143 * the reason for the failure.
144 * If the file is accessible and the dummy is 0 (existence), 2 (write),
145 * or 4 (read), the return is 0.
146 * If the file is accessible, and the dummy is 1 (executable), then if
147 * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
148 * Warnings: Use with caution. UNIX access do no translate to Macs.
149 * Check of write access is not implemented (same as read).
150 * ------------------------------------------------------------------------*/
152 int access(char *fileName, int dummy) {
156 errno = getfinfo(fileName, 0, &fi);
157 if (errno != 0) return -1; /* Check file accessible. */
159 /* Cases dummy = existence, read, write. */
160 if (dummy == 0 || dummy & 0x6) return 0;
162 /* Case dummy = executable. */
164 if (fi.fdType == 'APPL') return 0;
173 static Bool local readable(f) /* is f a regular, readable file */
175 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
176 return (0 == access(f,4));
177 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
179 /* fprintf(stderr, "readable: %s\n", f ); */
180 return ( !stat(f,&scbuf)
181 && (scbuf.st_mode & S_IREAD) /* readable */
182 && (scbuf.st_mode & S_IFREG) /* regular file */
184 #elif defined HAVE_OS_SWI /* RISCOS specific */
185 os_regset r; /* RISCOS PRM p.850 -- JBS */
187 r.r[0] = 17; /* Read catalogue, no path */
190 return r.r[0] != 1; /* Does this check it's a regular file? ADR */
195 /* --------------------------------------------------------------------------
196 * Search for script files on the HUGS path:
197 * ------------------------------------------------------------------------*/
199 static String local hugsdir ( Void );
201 static String local hscriptDir ( Void );
203 static int local pathCmp ( String, String );
204 static String local normPath ( String );
205 static Void local searchChr ( Int );
206 static Void local searchStr ( String );
207 static Bool local tryEndings ( String );
209 #if (DOS_FILENAMES || __CYGWIN32__)
211 # define SLASH_STR "/"
212 # define isSLASH(c) ((c)=='\\' || (c)=='/')
214 # define PATHSEP_STR ";"
215 # define DLL_ENDING ".u_o"
218 # define isSLASH(c) ((c)==SLASH)
220 # define PATHSEP_STR ";"
221 /* Mac PEF (Preferred Executable Format) file */
222 # define DLL_ENDING ".pef"
225 # define SLASH_STR "/"
226 # define isSLASH(c) ((c)==SLASH)
228 # define PATHSEP_STR ":"
229 # define DLL_ENDING ".u_o"
232 static String local hugsdir() { /* directory containing lib/Prelude.hs */
234 /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
235 static char dir[FILENAME_MAX+1] = "";
236 if (dir[0] == '\0') { /* not initialised yet */
237 String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir",
244 #elif HAVE_GETMODULEFILENAME && !DOS && !__CYGWIN32__
245 /* On Windows, we can find the binary we're running and it's
246 * conventional to put the libraries in the same place.
248 static char dir[FILENAME_MAX+1] = "";
249 if (dir[0] == '\0') { /* not initialised yet */
251 GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
252 if (dir[0] == '\0') { /* GetModuleFileName must have failed */
255 slash = strrchr(dir,SLASH);
256 if (slash) { /* truncate after directory name */
262 /* On Unix systems, we can't find the binary we're running and
263 * the libraries may not be installed near the binary anyway.
264 * This forces us to use a hardwired path which is set at
265 * configuration time (--datadir=...).
272 static String local hscriptDir() { /* Directory containing hscript.dll */
273 static char dir[FILENAME_MAX+1] = "";
274 if (dir[0] == '\0') { /* not initialised yet */
275 String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
284 #if 0 /* apparently unused */
285 static String local RealPath(s) /* Find absolute pathname of file */
287 #if HAVE__FULLPATH /* eg DOS */
288 static char path[FILENAME_MAX+1];
289 _fullpath(path,s,FILENAME_MAX+1);
290 #elif HAVE_REALPATH /* eg Unix */
291 static char path[MAXPATHLEN+1];
294 static char path[FILENAME_MAX+1];
302 static int local pathCmp(p1,p2) /* Compare paths after normalisation */
305 #if HAVE__FULLPATH /* eg DOS */
306 static char path1[FILENAME_MAX+1];
307 static char path2[FILENAME_MAX+1];
308 _fullpath(path1,p1,FILENAME_MAX+1);
309 _fullpath(path2,p2,FILENAME_MAX+1);
310 #elif HAVE_REALPATH /* eg Unix */
311 static char path1[MAXPATHLEN+1];
312 static char path2[MAXPATHLEN+1];
316 static char path1[FILENAME_MAX+1];
317 static char path2[FILENAME_MAX+1];
321 #if CASE_INSENSITIVE_FILENAMES
325 return filenamecmp(path1,path2);
328 static String local normPath(s) /* Try, as much as possible, to normalize */
329 String s; { /* a pathname in some appropriate manner. */
330 #if PATH_CANONICALIZATION
331 String path = RealPath(s);
332 #if CASE_INSENSITIVE_FILENAMES
333 strlwr(path); /* and convert to lowercase */
336 #else /* ! PATH_CANONICALIZATION */
338 #endif /* ! PATH_CANONICALIZATION */
342 static String endings[] = { "", ".u_hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
344 static String endings[] = { "", ".u_hi", ".hs", ".lhs", 0 };
346 static char searchBuf[FILENAME_MAX+1];
347 static Int searchPos;
349 #define searchReset(n) searchBuf[searchPos=(n)]='\0'
351 static Void local searchChr(c) /* Add single character to search buffer */
353 if (searchPos<FILENAME_MAX) {
354 searchBuf[searchPos++] = (char)c;
355 searchBuf[searchPos] = '\0';
359 static Void local searchStr(s) /* Add string to search buffer */
361 while (*s && searchPos<FILENAME_MAX)
362 searchBuf[searchPos++] = *s++;
363 searchBuf[searchPos] = '\0';
366 static Bool local tryEndings(s) /* Try each of the listed endings */
370 for (; endings[i]; ++i) {
371 Int save = searchPos;
372 searchStr(endings[i]);
373 if (readable(searchBuf))
384 /* scandir, June 98 Daan Leijen
385 searches the base directory and its direct subdirectories for a file
387 input: searchbuf contains SLASH terminated base directory
388 argument s contains the (base) filename
389 output: TRUE: searchBuf contains the full filename
390 FALSE: searchBuf is garbage, file not found
394 #ifdef HAVE_WINDOWS_H
396 static Bool scanSubDirs(s)
399 struct _finddata_t findInfo;
404 /* is it in the current directory ? */
405 if (tryEndings(s)) return TRUE;
410 /* initiate the search */
411 handle = _findfirst( searchBuf, &findInfo );
412 if (handle==-1) { errno = 0; return FALSE; }
414 /* search all subdirectories */
416 /* if we have a valid sub directory */
417 if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
418 (findInfo.name[0] != '.')) {
420 searchStr(findInfo.name);
426 } while (_findnext( handle, &findInfo ) == 0);
428 _findclose( handle );
432 #elif defined(HAVE_FTW_H)
436 static char baseFile[FILENAME_MAX+1];
437 static char basePath[FILENAME_MAX+1];
438 static int basePathLen;
440 static int scanitem( const char* path,
441 const struct stat* statinfo,
444 if (info == FTW_D) { /* is it a directory */
448 if (tryEndings(baseFile)) {
455 static Bool scanSubDirs(s)
460 strcpy(basePath,searchBuf);
461 basePathLen = strlen(basePath);
463 /* is it in the current directory ? */
464 if (tryEndings(s)) return TRUE;
466 /* otherwise scan the subdirectories */
467 r = ftw( basePath, scanitem, 2 );
472 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
473 #endif /* SEARCH_DIR */
475 String findPathname(along,nm) /* Look for a file along specified path */
476 String along; /* Return NULL if file does not exist */
478 /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
479 String s = findMPathname(along,nm,hugsPath);
480 return s ? s : normPath(searchBuf);
483 /* AC, 1/21/99: modified to pass in path to search explicitly */
484 String findMPathname(along,nm,path)/* Look for a file along specified path */
485 String along; /* If nonzero, a path prefix from along is */
486 String nm; /* used as the first prefix in the search. */
488 String pathpt = path;
491 if (along) { /* Was a path for an existing file given? */
494 for (; along[i]; i++) {
496 if (isSLASH(along[i]))
502 return normPath(searchBuf);
504 if (pathpt && *pathpt) { /* Otherwise, we look along the HUGSPATH */
507 Bool recurse = FALSE; /* DL: shall we recurse ? */
510 if (*pathpt!=PATHSEP) {
511 /* Pre-define one MPW-style "shell-variable" */
512 if (strncmp(pathpt,"{Hugs}",6)==0) {
513 searchStr(hugsdir());
517 /* And another - we ought to generalise this stuff */
518 else if (strncmp(pathpt,"{HScript}",9)==0) {
519 searchStr(hscriptDir());
524 searchChr(*pathpt++);
525 } while (*pathpt && *pathpt!=PATHSEP);
526 recurse = (pathpt[-1] == SLASH);
531 if (*pathpt==PATHSEP)
539 if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
540 return normPath(searchBuf);
543 if (tryEndings(nm)) {
544 return normPath(searchBuf);
550 searchReset(0); /* As a last resort, look for file in the current dir */
551 return (tryEndings(nm) ? normPath(searchBuf) : 0);
554 /* --------------------------------------------------------------------------
555 * New path handling stuff for the Combined System (tm)
556 * ------------------------------------------------------------------------*/
558 char installDir[N_INSTALLDIR];
560 /* Sets installDir to $STGHUGSDIR, and ensures there is a trailing
563 void setInstallDir ( String argv_0 )
566 char* r = getenv("STGHUGSDIR");
569 "%s: installation error: environment variable STGHUGSDIR is not set.\n",
572 "%s: pls set it to be the directory where STGHugs98 is installed.\n\n",
578 if (strlen(r) > N_INSTALLDIR-30 ) {
580 "%s: environment variable STGHUGSDIR is suspiciously long; pls remedy\n\n",
585 strcpy ( installDir, r );
586 i = strlen(installDir);
587 if (installDir[i-1] != SLASH) installDir[i++] = SLASH;
592 Bool findFilesForModule (
596 Bool* sAvail, Time* sTime, Long* sSize,
597 Bool* oiAvail, Time* oiTime, Long* oSize, Long* iSize
600 /* Let the module name given be M.
601 For each path entry P,
602 a s(rc) file will be P/M.hs or P/M.lhs
603 an i(nterface) file will be P/M.hi
604 an o(bject) file will be P/M.o
605 If there is a s file or (both i and o files)
606 use P to fill in the path names.
607 Otherwise, move on to the next path entry.
608 If all path entries are exhausted, return False.
610 If in standalone, only look for (and succeed for) source modules.
611 Caller free()s path. sExt is statically allocated.
612 srcExt is only set if a valid source file is found.
616 String peStart, peEnd;
617 String augdPath; /* .:hugsPath:installDir/../lib/std:installDir/lib */
621 *path = *sExt = NULL;
622 *sAvail = *oiAvail = oAvail = iAvail = FALSE;
623 *sSize = *oSize = *iSize = 0;
625 augdPath = malloc( 2*(10+3+strlen(installDir))
626 +strlen(hugsPath) +50/*paranoia*/);
628 internal("moduleNameToFileNames: malloc failed(2)");
631 strcat(augdPath, ".");
632 strcat(augdPath, PATHSEP_STR);
634 strcat(augdPath, hugsPath);
635 strcat(augdPath, PATHSEP_STR);
638 strcat(augdPath, installDir);
639 strcat(augdPath, "..");
640 strcat(augdPath, SLASH_STR);
641 strcat(augdPath, "lib");
642 strcat(augdPath, SLASH_STR);
643 strcat(augdPath, "std");
644 strcat(augdPath, PATHSEP_STR);
647 strcat(augdPath, installDir);
648 strcat(augdPath, "lib");
649 strcat(augdPath, PATHSEP_STR);
651 /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */
655 /* Advance peStart and peEnd very paranoically, giving up at
656 the first sign of mutancy in the path string.
658 if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
661 while (*peEnd && *peEnd != PATHSEP) peEnd++;
663 /* Now peStart .. peEnd-1 bracket the next path element. */
664 nPath = peEnd-peStart;
665 if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
666 ERRMSG(0) "Hugs path \"%s\" contains excessively long component",
673 strncpy(searchBuf, peStart, nPath);
674 searchBuf[nPath] = 0;
675 if (nPath > 0 && !isSLASH(searchBuf[nPath-1]))
676 searchBuf[nPath++] = SLASH;
678 strcpy(searchBuf+nPath, modName);
679 nPath += strlen(modName);
681 /* searchBuf now holds 'P/M'. Try out the various endings. */
682 *path = *sExt = NULL;
683 *sAvail = *oiAvail = oAvail = iAvail = FALSE;
684 *sSize = *oSize = *iSize = 0;
687 strcpy(searchBuf+nPath, DLL_ENDING);
688 if (readable(searchBuf)) {
690 getFileInfo(searchBuf, &oTime, oSize);
692 strcpy(searchBuf+nPath, HI_ENDING);
693 if (readable(searchBuf)) {
695 getFileInfo(searchBuf, &iTime, iSize);
697 if (oAvail && iAvail) {
699 *oiTime = whicheverIsLater ( oTime, iTime );
703 strcpy(searchBuf+nPath, ".hs");
704 if (readable(searchBuf)) {
707 getFileInfo(searchBuf, sTime, sSize);
710 strcpy(searchBuf+nPath, ".lhs");
711 if (readable(searchBuf)) {
714 getFileInfo(searchBuf, sTime, sSize);
720 if (*sAvail || *oiAvail) {
721 nPath -= strlen(modName);
722 *path = malloc(nPath+1);
724 internal("moduleNameToFileNames: malloc failed(1)");
725 strncpy(*path, searchBuf, nPath);
736 /* If the primaryObjectName is (eg)
738 and the extraFileName is (eg)
740 and DLL_ENDING is set to .o
742 /foo/bar/swampy_cbits.o
743 and set *extraFileSize to its size, or -1 if not avail
745 String getExtraObjectInfo ( String primaryObjectName,
746 String extraFileName,
753 Int i = strlen(primaryObjectName)-1;
754 while (i >= 0 && primaryObjectName[i] != SLASH) i--;
755 if (i == -1) return extraFileName;
757 xtra = malloc ( i+3+strlen(extraFileName)+strlen(DLL_ENDING) );
758 if (!xtra) internal("deriveExtraObjectName: malloc failed");
759 strncpy ( xtra, primaryObjectName, i );
761 strcat ( xtra, extraFileName );
762 strcat ( xtra, DLL_ENDING );
765 if (readable(xtra)) {
766 getFileInfo ( xtra, &xTime, &xSize );
767 *extraFileSize = xSize;
773 /* --------------------------------------------------------------------------
774 * Substitute old value of path into empty entries in new path
775 * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
776 * ------------------------------------------------------------------------*/
778 static String local substPath ( String,String );
780 static String local substPath(new,sub) /* substitute sub path into new path*/
783 Bool substituted = FALSE; /* only allow one replacement */
784 Int maxlen = strlen(sub) + strlen(new); /* safe upper bound */
785 String r = (String) malloc(maxlen+1); /* result string */
786 String t = r; /* pointer into r */
787 String next = new; /* next uncopied char in new */
788 String start = next; /* start of last path component */
790 ERRMSG(0) "String storage space exhausted"
794 if (*next == PATHSEP || *next == '\0') {
795 if (!substituted && next == start) {
797 for(; *s != '\0'; ++s) {
804 } while ((*t++ = *next++) != '\0');
809 /* --------------------------------------------------------------------------
810 * Garbage collection notification:
811 * ------------------------------------------------------------------------*/
813 Bool gcMessages = FALSE; /* TRUE => print GC messages */
815 Void gcStarted() { /* Notify garbage collector start */
822 Void gcScanning() { /* Notify garbage collector scans */
829 Void gcRecovered(recovered) /* Notify garbage collection done */
832 Printf("%d}}",recovered);
837 Cell *CStackBase; /* Retain start of C control stack */
839 #if RISCOS /* Stack traversal for RISCOS */
841 /* Warning: The following code is specific to the Acorn ARM under RISCOS
842 (and C4). We must explicitly walk back through the stack frames, since
843 the stack is extended from the heap. (see PRM pp. 1757). gcCStack must
844 not be modified, since the offset '5' assumes that only v1 is used inside
845 this function. Hence we do all the real work in gcARM.
848 #define spreg 13 /* C3 has SP=R13 */
850 #define previousFrame(fp) ((int *)((fp)[-3]))
851 #define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003))
852 #define isSubSPSP(w) (((w)&dontCare) == doCare)
853 #define doCare (0xE24DD000) /* SUB r13,r13,#0 */
854 #define dontCare (~0x00100FFF) /* S and # bits */
855 #define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) )
857 static void gcARM(int *fp) {
858 int si = *programCounter(fp); /* Save instruction indicates how */
859 /* many registers in this frame */
861 if (si & (1<<0)) markWithoutMove(*regs--);
862 if (si & (1<<1)) markWithoutMove(*regs--);
863 if (si & (1<<2)) markWithoutMove(*regs--);
864 if (si & (1<<3)) markWithoutMove(*regs--);
865 if (si & (1<<4)) markWithoutMove(*regs--);
866 if (si & (1<<5)) markWithoutMove(*regs--);
867 if (si & (1<<6)) markWithoutMove(*regs--);
868 if (si & (1<<7)) markWithoutMove(*regs--);
869 if (si & (1<<8)) markWithoutMove(*regs--);
870 if (si & (1<<9)) markWithoutMove(*regs--);
871 if (previousFrame(fp)) {
872 /* The non-register stack space is for the previous frame is above
873 this fp, and not below the previous fp, because of the way stack
874 extension works. It seems the only way of discovering its size is
875 finding the SUB sp, sp, #? instruction by walking through the code
876 following the entry point.
878 int *oldpc = programCounter(previousFrame(fp));
880 for(i = 1; i < 6; ++i)
881 if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
882 for(i=1; i<=fsize; ++i)
883 markWithoutMove(fp[i]);
889 int *fp = 5 + &dummy;
892 fp = previousFrame(fp);
896 #else /* Garbage collection for standard stack machines */
898 Void gcCStack() { /* Garbage collect elements off */
899 Cell stackTop = NIL; /* C stack */
900 Cell *ptr = &stackTop;
901 #if SIZEOF_VOID_P == 2
902 if (((long)(ptr) - (long)(CStackBase))&1)
904 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
905 if (((long)(ptr) - (long)(CStackBase))&1)
908 if (((long)(ptr) - (long)(CStackBase))&3)
912 #define Blargh mark(*ptr);
914 markWithoutMove((*ptr)/sizeof(Cell)); \
915 markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \
916 markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
919 #define StackGrowsDown { while (ptr<=CStackBase) { Blargh; ptr++; }; }
920 #define StackGrowsUp { while (ptr>=CStackBase) { Blargh; ptr--; }; }
921 #define GuessDirection if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
923 #if STACK_DIRECTION > 0
925 #elif STACK_DIRECTION < 0
931 #if SIZEOF_VOID_P==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
932 ptr = (Cell *)((long)(&stackTop) + 2);
936 #undef StackGrowsDown
938 #undef GuessDirection
942 /* --------------------------------------------------------------------------
943 * Terminal dependent stuff:
944 * ------------------------------------------------------------------------*/
946 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
948 /* grab the varargs prototype for ioctl */
950 # include <sys/ioctl.h>
953 /* The order of these three tests is very important because
954 * some systems have more than one of the requisite header file
955 * but only one of them seems to work.
956 * Anyone changing the order of the tests should try enabling each of the
957 * three branches in turn and write down which ones work as well as which
958 * OS/compiler they're using.
960 * OS Compiler sgtty termio termios notes
961 * Linux 2.0.18 gcc 2.7.2 absent works works 1
964 * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
965 * implemented using termios.h.
966 * sgtty.h is in /usr/include/bsd which is not on my standard include
967 * path. Adding it does no harm but you might as well use termios.
969 * reid-alastair@cs.yale.edu
974 typedef struct termios TermParams;
975 #define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
976 #define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
977 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
984 typedef struct sgttyb TermParams;
985 #define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
986 #define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
988 #define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
990 #define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
996 typedef struct termio TermParams;
997 #define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
998 #define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
999 #define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
1000 tp.c_cc[VMIN] = 1; \
1005 static Bool messedWithTerminal = FALSE;
1006 static TermParams originalSettings;
1008 Void normalTerminal() { /* restore terminal initial state */
1009 if (messedWithTerminal)
1010 setTerminal(originalSettings);
1013 Void noechoTerminal() { /* set terminal into noecho mode */
1014 TermParams settings;
1016 if (!messedWithTerminal) {
1017 getTerminal(originalSettings);
1018 messedWithTerminal = TRUE;
1020 getTerminal(settings);
1022 setTerminal(settings);
1025 Int getTerminalWidth() { /* determine width of terminal */
1027 #ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
1028 #include <sys/stream.h> /* Required by sys/ptem.h */
1029 #include <sys/ptem.h> /* Required to declare winsize */
1031 static struct winsize terminalSize;
1032 ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
1033 return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
1039 Int readTerminalChar() { /* read character from terminal */
1040 return getchar(); /* without echo, assuming that */
1041 } /* noechoTerminal() is active... */
1045 Int readTerminalChar() { /* read character from terminal */
1046 return getchar(); /* without echo, assuming that */
1047 } /* noechoTerminal() is active... */
1049 Int getTerminalWidth() {
1050 return console_options.ncols;
1053 Void normalTerminal() {
1054 csetmode(C_ECHO, stdin);
1057 Void noechoTerminal() {
1058 csetmode(C_NOECHO, stdin);
1061 #else /* no terminal driver - eg DOS, RISCOS */
1063 static Bool terminalEchoReqd = TRUE;
1065 Int getTerminalWidth() {
1068 (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1075 Void normalTerminal() { /* restore terminal initial state */
1076 terminalEchoReqd = TRUE;
1079 Void noechoTerminal() { /* turn terminal echo on/off */
1080 terminalEchoReqd = FALSE;
1083 Int readTerminalChar() { /* read character from terminal */
1084 if (terminalEchoReqd) {
1087 #if IS_WIN32 && !__BORLANDC__
1088 /* When reading a character from the console/terminal, we want
1089 * to operate in 'raw' mode (to use old UNIX tty parlance) and have
1090 * it return when a character is available and _not_ wait until
1091 * the next time the user hits carriage return. On Windows platforms,
1092 * this _can_ be done by reading directly from the console, using
1093 * getch(). However, this doesn't sit well with programming
1094 * environments such as Emacs which allow you to create sub-processes
1095 * running Hugs, and then communicate with the running interpreter
1096 * through its standard input and output handles. If you use getch()
1097 * in that setting, you end up trying to read the (unused) console
1098 * of the editor itself, through which not a lot of characters is
1099 * bound to come out, since the editor communicates input to Hugs
1100 * via the standard input handle.
1102 * To avoid this rather unfortunate situation, we use the Win32
1103 * console API and re-jig the input properties of the standard
1104 * input handle before trying to read a character using stdio's
1107 * The 'cost' of this solution is that it is Win32 specific and
1108 * won't work with Windows 3.1 + it is kind of ugly and verbose
1109 * to have to futz around with the console properties on a
1110 * per-char basis. Both of these disadvantages aren't in my
1119 /* I don't quite understand why, but if the FILE*'s underlying file
1120 descriptor is in text mode, we seem to lose the first carriage
1123 setmode(fileno(stdin), _O_BINARY);
1124 hIn = GetStdHandle(STD_INPUT_HANDLE);
1125 GetConsoleMode(hIn, &mo);
1126 SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
1128 * On Win9x, the first time you change the mode (as above) a
1129 * raw '\n' is inserted. Since enter maps to a raw '\r', and we
1130 * map this (below) to '\n', we can just ignore all *raw* '\n's.
1134 } while (c == '\n');
1136 /* Same as it ever was - revert back state of stdin. */
1137 SetConsoleMode(hIn, mo);
1138 setmode(fileno(stdin), _O_TEXT);
1142 return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
1146 #endif /* no terminal driver */
1148 /* --------------------------------------------------------------------------
1149 * Interrupt handling:
1150 * ------------------------------------------------------------------------*/
1152 static Void installHandlers ( void ) { /* Install handlers for all fatal */
1153 /* signals except SIGINT and SIGBREAK*/
1155 /* SetConsoleCtrlHandler(consoleHandler,TRUE); */
1157 #if !DONT_PANIC && !DOS
1159 signal(SIGABRT,panic);
1162 signal(SIGBUS,panic);
1165 signal(SIGFPE,panic);
1168 signal(SIGHUP,panic);
1171 signal(SIGILL,panic);
1174 signal(SIGQUIT,panic);
1177 signal(SIGSEGV,panic);
1180 signal(SIGTERM,panic);
1182 #endif /* !DONT_PANIC && !DOS */
1185 /* --------------------------------------------------------------------------
1187 * ------------------------------------------------------------------------*/
1189 static Bool local startEdit(line,nm) /* Start editor on file name at */
1190 Int line; /* given line. Both name and line */
1191 String nm; { /* or just line may be zero */
1192 static char editorCmd[FILENAME_MAX+1];
1195 if (hugsEdit && *hugsEdit) { /* Check that editor configured */
1197 /* On a Mac, files have creator information, telling which program
1198 to launch to, so an editor named to the empty string "" is often
1200 if (hugsEdit) { /* Check that editor configured */
1202 Int n = FILENAME_MAX;
1203 String he = hugsEdit;
1204 String ec = editorCmd;
1205 String rd = NULL; /* Set to nonnull to redo ... */
1207 for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
1208 *ec++ = *he++; /* Copy editor name to buffer */
1209 /* assuming filename ends at space */
1211 if (nm && line && n>1 && *he){ /* Name, line, and enough space */
1212 rd = ec; /* save, in case we don't find name*/
1213 while (n>0 && *he) {
1215 if (*++he=='d' && n>10) {
1216 sprintf(ec,"%d",line);
1219 else if (*he=='s' && (size_t)n>strlen(nm)) {
1224 else if (*he=='%' && n>1) {
1228 else /* Ignore % char if not followed */
1229 *ec = '\0'; /* by one of d, s, or %, */
1230 for (; *ec && n>0; n--)
1232 } /* ignore % followed by anything other than d, s, or % */
1233 else { /* Copy other characters across */
1242 if (rd) { /* If file name was not included */
1247 if (nm && line==0 && n>1) { /* Name, but no line ... */
1249 for (; n>0 && *nm; n--) /* ... just copy file name */
1253 *ec = '\0'; /* Add terminating null byte */
1256 ERRMSG(0) "Hugs is not configured to use an editor"
1261 WinExec(editorCmd, SW_SHOW);
1264 if (shellEsc(editorCmd))
1265 Printf("Warning: Editor terminated abnormally\n");
1270 Int shellEsc(s) /* run a shell command (or shell) */
1273 return macsystem(s);
1277 s = fromEnv("SHELL","/bin/sh");
1284 #if RISCOS /* RISCOS also needs a chdir() */
1285 int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */
1286 return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1288 #elif defined HAVE_PBHSETVOLSYNC /* Macintosh */
1289 int chdir(const char *s) {
1292 wd.ioCompletion = 0;
1293 str = (char*)malloc(strlen(s) + 1);
1294 if (str == 0) return -1;
1296 wd.ioNamePtr = C2PStr(str);
1299 errno = PBHSetVolSync(&wd);
1310 /*---------------------------------------------------------------------------
1311 * Printf-related operations:
1312 *-------------------------------------------------------------------------*/
1314 #if !defined(HAVE_VSNPRINTF)
1315 int vsnprintf(buffer, count, fmt, ap)
1320 #if defined(HAVE__VSNPRINTF)
1321 return _vsnprintf(buffer, count, fmt, ap);
1326 #endif /* HAVE_VSNPRINTF */
1328 #if !defined(HAVE_SNPRINTF)
1329 int snprintf(char* buffer, int count, const char* fmt, ...) {
1330 #if defined(HAVE__VSNPRINTF)
1332 va_list ap; /* pointer into argument list */
1333 va_start(ap, fmt); /* make ap point to first arg after fmt */
1334 r = vsnprintf(buffer, count, fmt, ap);
1335 va_end(ap); /* clean up */
1341 #endif /* HAVE_SNPRINTF */
1343 /* --------------------------------------------------------------------------
1344 * Things to do with the argv/argc and the env
1345 * ------------------------------------------------------------------------*/
1347 int nh_argc ( void )
1352 int nh_argvb ( int argno, int offset )
1354 return (int)(prog_argv[argno][offset]);
1357 /* --------------------------------------------------------------------------
1358 * Machine dependent control:
1359 * ------------------------------------------------------------------------*/
1361 Void machdep(what) /* Handle machine specific */
1362 Int what; { /* initialisation etc.. */
1365 case POSTPREL: break;
1366 case PREPREL : installHandlers();
1370 case EXIT : normalTerminal();
1375 /*-------------------------------------------------------------------------*/