[project @ 1999-06-07 17:22:31 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / machdep.c
1
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)
8  *
9  * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
10  * Haskell Group 1994-99, and is distributed as Open Source software
11  * under the Artistic License; see the file "Artistic" that is included
12  * in the distribution for details.
13  *
14  * $RCSfile: machdep.c,v $
15  * $Revision: 1.6 $
16  * $Date: 1999/06/07 17:22:37 $
17  * ------------------------------------------------------------------------*/
18
19 #ifdef HAVE_SIGNAL_H
20 # include <signal.h>
21 #endif
22 #ifdef HAVE_SYS_TYPES_H
23 # include <sys/types.h>
24 #else
25 # ifdef HAVE_TYPES_H
26 #  include <types.h>
27 # endif
28 #endif
29 #if HAVE_SYS_PARAM_H
30 # include <sys/param.h>
31 #endif
32 #ifdef HAVE_SYS_STAT_H
33 # include <sys/stat.h>
34 #else
35 # ifdef HAVE_STAT_H
36 #  include <stat.h>
37 # endif
38 #endif
39 #ifdef HAVE_TIME_H
40 # include <time.h>
41 #endif
42
43 /* Windows/DOS include files */
44 #ifdef HAVE_DOS_H
45 # include <dos.h>
46 #endif
47 #if defined HAVE_CONIO_H && ! HUGS_FOR_WINDOWS
48 # include <conio.h>
49 #endif
50 #ifdef HAVE_IO_H
51 # include <io.h>
52 #endif
53 #ifdef HAVE_STD_H
54 # include <std.h>
55 #endif
56 #ifdef HAVE_WINDOWS_H
57 # include <windows.h>
58 #endif
59
60 #if HUGS_FOR_WINDOWS
61 #include <dir.h>
62 #include <mem.h>
63
64 extern HCURSOR HandCursor;            /* Forward references to cursors   */
65 extern HCURSOR GarbageCursor;
66 extern HCURSOR SaveCursor;
67 static void    local DrawStatusLine     Args((HWND));
68 #endif
69
70 #if DOS
71 #include <mem.h>
72 extern unsigned _stklen = 8000;         /* Allocate an 8k stack segment    */
73 #endif
74
75 #if RISCOS
76 #include "swis.h"
77 #include "os.h"
78 #endif
79
80 /* Macintosh include files */
81 #ifdef HAVE_CONSOLE_H
82 # include <console.h>
83 #endif
84 #ifdef HAVE_PASCAL_H
85 # include <pascal.h>
86 #endif
87 #ifdef HAVE_FILES_H
88 # include <Files.h>
89 #endif
90 #ifdef HAVE_FCNTL_H
91 # include <fcntl.h>
92 #endif
93 #ifdef HAVE_ERRNO_H
94 # include <errno.h>
95 #endif
96 #ifdef HAVE_STDLIB_H
97 # include <stdlib.h>
98 #endif
99 #ifdef HAVE_UNIX_H
100 #include <unix.h>
101 #endif
102
103 /* --------------------------------------------------------------------------
104  * Prototypes for registry reading
105  * ------------------------------------------------------------------------*/
106
107 #if USE_REGISTRY
108
109 /* where have we hidden things in the registry? */
110 #if HSCRIPT
111 #define HScriptRoot ("SOFTWARE\\Haskell\\HaskellScript\\")
112 #endif
113
114 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
115 #define ProjectRoot ("SOFTWARE\\Haskell\\Hugs\\Projects\\")
116
117 static Bool   local createKey      Args((HKEY, String, PHKEY, REGSAM));
118 static Bool   local queryValue     Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD));
119 static Bool   local setValue       Args((HKEY, String, String, DWORD, LPBYTE, DWORD));
120 static String local readRegString  Args((HKEY, String, String, String));
121 static Int    local readRegInt     Args((String,Int));
122 static Bool   local writeRegString Args((String,String));
123 static Bool   local writeRegInt    Args((String,Int));
124
125 static String local readRegChildStrings Args((HKEY, String, String, Char, String));
126 #endif /* USE_REGISTRY */
127
128 /* --------------------------------------------------------------------------
129  * Find information about a file:
130  * ------------------------------------------------------------------------*/
131
132 #if RISCOS
133 typedef struct { unsigned hi, lo; } Time;
134 #define timeChanged(now,thn)    (now.hi!=thn.hi || now.lo!=thn.lo)
135 #define timeSet(var,tm)         var.hi = tm.hi; var.lo = tm.lo
136 error  timeEarlier not defined
137 #else
138 typedef time_t Time;
139 #define timeChanged(now,thn)      (now!=thn)
140 #define timeSet(var,tm)           var = tm
141 #define timeEarlier(earlier,now)  (earlier < now)
142 #endif
143
144 static Bool local readable      Args((String));
145 static Void local getFileInfo   Args((String, Time *, Long *));
146
147 static Void local getFileInfo(f,tm,sz)  /* find time stamp and size of file*/
148 String f;
149 Time   *tm;
150 Long   *sz; {
151 #if defined HAVE_SYS_STAT_H || defined HAVE_STAT_H || defined HAVE_UNIX_H
152     struct stat scbuf;
153     if (!stat(f,&scbuf)) {
154         if (tm) *tm = scbuf.st_mtime;
155         *sz = (Long)(scbuf.st_size);
156     } else {
157         if (tm) *tm = 0;
158         *sz = 0;
159     }
160 #else                                   /* normally just use stat()        */
161     os_regset r;                        /* RISCOS PRM p.850 and p.837      */
162     r.r[0] = 17;                        /* Read catalogue, no path         */
163     r.r[1] = (int)s;
164     os_swi(OS_File, &r);
165     if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) {
166         if (tm) tm->hi = r.r[2] & 0xFF; /* Load address (high byte)        */
167         if (tm) tm->lo = r.r[3];        /* Execution address (low 4 bytes) */
168     } else {                            /* Not found, or not time-stamped  */
169         if (tm) tm->hi = tm->lo = 0;
170     }
171     *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0);
172 #endif
173 }
174
175 Void getFileSize ( String f, Long* sz )
176 {
177    getFileInfo ( f, NULL, sz );
178 }
179
180 #if defined HAVE_GETFINFO               /* Mac971031 */
181 /* --------------------------------------------------------------------------
182  * Define a MacOS version of access():
183  *   If the file is not accessible, -1 is returned and errno is set to
184  * the reason for the failure.
185  *   If the file is accessible and the dummy is 0 (existence), 2 (write), 
186  * or 4 (read), the return is 0.
187  *   If the file is accessible, and the dummy is 1 (executable), then if
188  * the file is a program (of type 'APPL'), the return is 0, otherwise -1.
189  *   Warnings: Use with caution. UNIX access do no translate to Macs.
190  * Check of write access is not implemented (same as read).
191  * ------------------------------------------------------------------------*/
192
193 int access(char *fileName, int dummy) { 
194         FInfo   fi;
195         short   rc;
196         
197         errno = getfinfo(fileName, 0, &fi);
198         if (errno != 0)  return -1;             /* Check file accessible. */
199         
200         /* Cases dummy = existence, read, write. */
201         if (dummy == 0 || dummy & 0x6)  return 0;
202         
203         /* Case dummy = executable. */
204         if (dummy == 1) { 
205                 if (fi.fdType == 'APPL')  return 0;
206                 errno = fi.fdType;
207                 return -1;
208         }
209         
210         return 0;
211 }
212 #endif
213
214 static Bool local readable(f)           /* is f a regular, readable file   */
215 String f; {
216 #if DJGPP2 || defined HAVE_GETFINFO /* stat returns bogus mode bits on djgpp2 */
217     return (0 == access(f,4));
218 #elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
219     struct stat scbuf;
220     //fprintf(stderr, "readable: %s\n", f );
221     return (  !stat(f,&scbuf) 
222            && (scbuf.st_mode & S_IREAD) /* readable     */
223            && (scbuf.st_mode & S_IFREG) /* regular file */
224            );
225 #elif defined HAVE_OS_SWI /* RISCOS specific */
226     os_regset r;                        /* RISCOS PRM p.850     -- JBS     */
227     assert(dummy == 0);
228     r.r[0] = 17; /* Read catalogue, no path */
229     r.r[1] = (int)f;
230     os_swi(OS_File, &r);
231     return r.r[0] != 1; /* Does this check it's a regular file? ADR */
232 #endif
233 }
234
235
236 /* --------------------------------------------------------------------------
237  * Search for script files on the HUGS path:
238  * ------------------------------------------------------------------------*/
239
240 static String local hugsdir       Args((Void));
241 #if HSCRIPT
242 static String local hscriptDir    Args((Void));
243 #endif
244 //static String local RealPath      Args((String));
245 static int    local pathCmp       Args((String, String));
246 static String local normPath      Args((String));
247 static Void   local searchChr     Args((Int));
248 static Void   local searchStr     Args((String));
249 static Bool   local tryEndings    Args((String));
250
251 #if DOS_FILENAMES
252 # define SLASH                   '\\'
253 # define isSLASH(c)              ((c)=='\\' || (c)=='/')
254 # define PATHSEP                 ';'
255 # define DLL_ENDING              ".dll"
256 #elif MAC_FILENAMES
257 # define SLASH                   ':'
258 # define isSLASH(c)              ((c)==SLASH)
259 # define PATHSEP                 ';'
260 /* Mac PEF (Preferred Executable Format) file */
261 # define DLL_ENDING              ".pef" 
262 #else
263 # define SLASH                   '/'
264 # define isSLASH(c)              ((c)==SLASH)
265 # define PATHSEP                 ':'
266 # define DLL_ENDING              ".o"
267 #endif
268
269 static String local hugsdir() {     /* directory containing lib/Prelude.hs */
270 #if HSCRIPT
271     /* In HaskellScript (Win32 only), we lookup InstallDir in the registry. */
272     static char dir[FILENAME_MAX+1] = "";
273     if (dir[0] == '\0') { /* not initialised yet */
274         String s = readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"InstallDir", 
275                                  HUGSDIR);
276         if (s) { 
277             strcpy(dir,s); 
278         }
279     }
280     return dir;
281 #elif HAVE_GETMODULEFILENAME && !DOS
282     /* On Windows, we can find the binary we're running and it's
283      * conventional to put the libraries in the same place.
284      */
285     static char dir[FILENAME_MAX+1] = "";
286     if (dir[0] == '\0') { /* not initialised yet */
287         String slash = 0;
288         GetModuleFileName((HMODULE)0,dir,FILENAME_MAX+1);
289         if (dir[0] == '\0') { /* GetModuleFileName must have failed */
290             return HUGSDIR;
291         }
292         if (slash = strrchr(dir,SLASH)) { /* truncate after directory name */
293             *slash = '\0';
294         }
295     }
296     return dir;
297 #else
298     /* On Unix systems, we can't find the binary we're running and
299      * the libraries may not be installed near the binary anyway.
300      * This forces us to use a hardwired path which is set at 
301      * configuration time (--datadir=...).
302      */
303     return HUGSDIR;
304 #endif
305 }
306
307 #if HSCRIPT    
308 static String local hscriptDir() {  /* directory containing ?? what Daan?  */
309     static char dir[FILENAME_MAX+1] = "";
310     if (dir[0] == '\0') { /* not initialised yet */
311         String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
312         if (s) {
313             strcpy(dir,s);
314         }
315     }
316     return dir;
317 }
318 #endif
319
320 #if 0  /* apparently unused */
321 static String local RealPath(s)         /* Find absolute pathname of file  */
322 String s; {
323 #if HAVE__FULLPATH  /* eg DOS */
324     static char path[FILENAME_MAX+1];
325     _fullpath(path,s,FILENAME_MAX+1);
326 #elif HAVE_REALPATH /* eg Unix */
327     static char path[MAXPATHLEN+1];
328     realpath(s,path);                
329 #else
330     static char path[FILENAME_MAX+1];
331     strcpy(path,s);
332 #endif
333     return path;
334 }
335 #endif
336
337
338 static int local pathCmp(p1,p2)       /* Compare paths after normalisation */
339 String p1;
340 String p2; {
341 #if HAVE__FULLPATH  /* eg DOS */
342     static char path1[FILENAME_MAX+1];
343     static char path2[FILENAME_MAX+1];
344     _fullpath(path1,p1,FILENAME_MAX+1);
345     _fullpath(path2,p2,FILENAME_MAX+1);
346 #elif HAVE_REALPATH /* eg Unix */
347     static char path1[MAXPATHLEN+1];
348     static char path2[MAXPATHLEN+1];
349     realpath(p1,path1);                
350     realpath(p2,path2);                
351 #else
352     static char path1[FILENAME_MAX+1];
353     static char path2[FILENAME_MAX+1];
354     strcpy(path1,p1);
355     strcpy(path2,p2);
356 #endif
357 #if CASE_INSENSITIVE_FILENAMES
358     strlwr(path1);
359     strlwr(path2);
360 #endif
361     return filenamecmp(path1,path2);
362 }
363
364 static String local normPath(s) /* Try, as much as possible, to normalize  */
365 String s; {                     /* a pathname in some appropriate manner.  */
366 #if PATH_CANONICALIZATION
367     String path = RealPath(s);
368 #if CASE_INSENSITIVE_FILENAMES
369     strlwr(path);                       /* and convert to lowercase        */
370 #endif
371     return path;
372 #else /* ! PATH_CANONICALIZATION */
373     return s;
374 #endif /* ! PATH_CANONICALIZATION */
375 }
376
377 #if HSCRIPT
378 static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
379 #else
380 static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
381 #endif
382 static char   searchBuf[FILENAME_MAX+1];
383 static Int    searchPos;
384
385 #define searchReset(n)          searchBuf[searchPos=(n)]='\0'
386
387 static Void local searchChr(c)  /* Add single character to search buffer   */
388 Int c; {
389     if (searchPos<FILENAME_MAX) {
390         searchBuf[searchPos++] = (char)c;
391         searchBuf[searchPos]   = '\0';
392     }
393 }
394
395 static Void local searchStr(s)  /* Add string to search buffer             */
396 String s; {
397     while (*s && searchPos<FILENAME_MAX)
398         searchBuf[searchPos++] = *s++;
399     searchBuf[searchPos] = '\0';
400 }
401
402 static Bool local tryEndings(s) /* Try each of the listed endings          */
403 String s; {
404     Int i = 0;
405     searchStr(s);
406     for (; endings[i]; ++i) {
407         Int save = searchPos;
408         searchStr(endings[i]);
409         if (readable(searchBuf))
410             return TRUE;
411         searchReset(save);
412     }
413     return FALSE;
414 }
415
416
417
418 #if SEARCH_DIR
419
420 /* scandir, June 98 Daan Leijen
421    searches the base directory and its direct subdirectories for a file
422
423    input: searchbuf contains SLASH terminated base directory
424           argument s contains the (base) filename
425    output: TRUE: searchBuf contains the full filename
426            FALSE: searchBuf is garbage, file not found
427 */
428           
429
430 #ifdef HAVE_WINDOWS_H
431
432 static Bool scanSubDirs(s)
433 String s;
434 {
435     struct _finddata_t findInfo;
436     long handle;
437     int  save;
438     
439     save = searchPos;
440     /* is it in the current directory ? */
441     if (tryEndings(s)) return TRUE;
442
443     searchReset(save);
444     searchStr("*");
445     
446     /* initiate the search */
447     handle = _findfirst( searchBuf, &findInfo );
448     if (handle==-1) { errno = 0; return FALSE; }
449     
450     /* search all subdirectories */
451     do {
452         /* if we have a valid sub directory */
453         if (((findInfo.attrib & _A_SUBDIR) == _A_SUBDIR) &&
454             (findInfo.name[0] != '.')) {
455             searchReset(save);
456             searchStr(findInfo.name);
457             searchChr(SLASH);
458             if (tryEndings(s)) {
459                 return TRUE;
460             }
461         }
462     } while (_findnext( handle, &findInfo ) == 0);
463     
464     _findclose( handle );
465     return FALSE;
466 }
467
468 #elif defined(HAVE_FTW_H)
469
470 #include <ftw.h>
471
472 static char baseFile[FILENAME_MAX+1];
473 static char basePath[FILENAME_MAX+1];
474 static int  basePathLen;
475
476 static int scanitem( const char* path, 
477                      const struct stat* statinfo, 
478                      int info )
479 {
480     if (info == FTW_D) { /* is it a directory */
481         searchReset(0);
482         searchStr(path);
483         searchChr(SLASH);
484         if (tryEndings(baseFile)) {
485             return 1;
486         }
487     }
488     return 0;
489 }
490
491 static Bool scanSubDirs(s)
492 String s;
493 {
494     int r;
495     strcpy(baseFile,s);
496     strcpy(basePath,searchBuf);
497     basePathLen = strlen(basePath);
498
499     /* is it in the current directory ? */
500     if (tryEndings(s)) return TRUE;
501     
502     /* otherwise scan the subdirectories */
503     r = ftw( basePath, scanitem, 2 );
504     errno = 0;
505     return (r > 0);
506 }
507
508 #endif /* HAVE_WINDOWS_H || HAVE_FTW_H */
509 #endif /* SEARCH_DIR */
510
511 String findPathname(along,nm)   /* Look for a file along specified path    */
512 String along;                   /* Return NULL if file does not exist      */ 
513 String nm; {
514     /* AC, 1/21/99: modified to search hugsPath first, then projectPath */
515     String s = findMPathname(along,nm,hugsPath);
516 #if USE_REGISTRY
517 #if 0
518  ToDo:
519     if (s==NULL) {
520         s = findMPathname(along,nm,projectPath);
521     }
522 #endif /* 0 */
523 #endif /* USE_REGISTRY */
524     return s ? s : normPath(searchBuf);
525 }
526
527 /* AC, 1/21/99: modified to pass in path to search explicitly */
528 String findMPathname(along,nm,path)/* Look for a file along specified path   */
529 String along;                   /* If nonzero, a path prefix from along is */
530 String nm;                      /* used as the first prefix in the search. */
531 String path; {
532     String pathpt = path;
533
534     searchReset(0);
535     if (along) {                /* Was a path for an existing file given?  */
536         Int last = (-1);
537         Int i    = 0;
538         for (; along[i]; i++) {
539             searchChr(along[i]);
540             if (isSLASH(along[i]))
541                 last = i;
542         }
543         searchReset(last+1);
544     }
545     if (tryEndings(nm))
546         return normPath(searchBuf);
547
548     if (pathpt && *pathpt) {    /* Otherwise, we look along the HUGSPATH   */
549         Bool more = TRUE;
550         do {
551             Bool recurse = FALSE;   /* DL: shall we recurse ? */
552             searchReset(0);
553             if (*pathpt) {
554                 if (*pathpt!=PATHSEP) {
555                     /* Pre-define one MPW-style "shell-variable" */
556                     if (strncmp(pathpt,"{Hugs}",6)==0) {
557                         searchStr(hugsdir());
558                         pathpt += 6;
559                     }
560 #if HSCRIPT
561                     /* And another - we ought to generalise this stuff */
562                     else if (strncmp(pathpt,"{HScript}",9)==0) {
563                         searchStr(hscriptDir());
564                         pathpt += 9;
565                     }
566 #endif
567                     do {
568                         searchChr(*pathpt++);
569                     } while (*pathpt && *pathpt!=PATHSEP);
570                     recurse = (pathpt[-1] == SLASH);
571                     if (!recurse) {
572                         searchChr(SLASH);
573                     }
574                 }
575                 if (*pathpt==PATHSEP)
576                     pathpt++;
577                 else
578                     more = FALSE;
579             } else {
580                 more = FALSE;
581             }
582 #if SEARCH_DIR
583             if (recurse ? scanSubDirs(nm) : tryEndings(nm)) {
584                 return normPath(searchBuf);
585             }
586 #else   
587             if (tryEndings(nm)) {
588                 return normPath(searchBuf);
589             }
590 #endif
591         } while (more);
592     }
593
594     searchReset(0);  /* As a last resort, look for file in the current dir */
595     return (tryEndings(nm) ? normPath(searchBuf) : 0);
596 }
597
598 /* --------------------------------------------------------------------------
599  * New path handling stuff for the Combined System (tm)
600  * ------------------------------------------------------------------------*/
601
602 Bool findFilesForModule ( 
603         String  modName,
604         String* path,
605         String* sExt,
606         Bool* sAvail, Time* sTime, Long* sSize,
607         Bool* iAvail, Time* iTime, Long* iSize,
608         Bool* oAvail, Time* oTime, Long* oSize
609      )
610 {
611    /* Let the module name given be M.
612       For each path entry P,
613         a  s(rc)       file will be P/M.hs or P/M.lhs
614         an i(nterface) file will be P/M.hi
615         an o(bject)    file will be P/M.o
616       If there is a s file or (both i and o files)
617         use P to fill in the path names.
618       Otherwise, move on to the next path entry.
619       If all path entries are exhausted, return False.
620    */
621    Int    nPath;
622    Bool   literate;
623    String peStart, peEnd;
624    String augdPath;       /* . and then hugsPath */
625
626    *path = *sExt = NULL;
627    *sAvail = *iAvail = *oAvail = FALSE;
628    *sSize  = *iSize  = *oSize  = 0;
629
630    augdPath = malloc(3+strlen(hugsPath));
631    if (!augdPath)
632       internal("moduleNameToFileNames: malloc failed(2)");
633    augdPath[0] = '.';
634    augdPath[1] = PATHSEP;
635    augdPath[2] = 0;
636    strcat(augdPath,hugsPath);
637
638    peEnd = augdPath-1;
639    while (1) {
640       /* Advance peStart and peEnd very paranoically, giving up at
641          the first sign of mutancy in the path string.
642       */
643       if (peEnd >= augdPath && !(*peEnd)) { free(augdPath); return FALSE; }
644       peStart = peEnd+1;
645       peEnd = peStart;
646       while (*peEnd && *peEnd != PATHSEP) peEnd++;
647       
648       /* Now peStart .. peEnd-1 bracket the next path element. */
649       nPath = peEnd-peStart;
650       if (nPath + strlen(modName) + 10 /*slush*/ > FILENAME_MAX) {
651          ERRMSG(0) "Hugs path \"%s\" contains excessively long component", 
652                    hugsPath
653          EEND;
654          free(augdPath); 
655          return FALSE;
656       }
657
658       strncpy(searchBuf, peStart, nPath); 
659       searchBuf[nPath] = 0;
660       if (nPath > 0 && !isSLASH(searchBuf[nPath-1])) 
661          searchBuf[nPath++] = SLASH;
662
663       strcpy(searchBuf+nPath, modName);
664       nPath += strlen(modName);
665
666       /* searchBuf now holds 'P/M'.  Try out the various endings. */
667       *path = *sExt = NULL;
668       *sAvail = *iAvail = *oAvail = FALSE;
669       *sSize  = *iSize  = *oSize  = 0;
670
671       strcpy(searchBuf+nPath, DLL_ENDING);
672       if (readable(searchBuf)) {
673          *oAvail = TRUE;
674          getFileInfo(searchBuf, oTime, oSize);
675       }
676
677       strcpy(searchBuf+nPath, ".hi");
678       if (readable(searchBuf)) {
679          *iAvail = TRUE;
680          getFileInfo(searchBuf, iTime, iSize);
681       }
682
683       strcpy(searchBuf+nPath, ".hs");
684       if (readable(searchBuf)) {
685          *sAvail = TRUE;
686          literate = FALSE;
687          getFileInfo(searchBuf, sTime, sSize);
688          *sExt = ".hs";
689       } else {
690          strcpy(searchBuf+nPath, ".lhs");
691          if (readable(searchBuf)) {
692             *sAvail = TRUE;
693             literate = TRUE;
694             getFileInfo(searchBuf, sTime, sSize);
695             *sExt = ".lhs";
696          }
697       }
698
699       /* Success? */
700       if (*sAvail || (*oAvail && *iAvail)) {
701          nPath -= strlen(modName);
702          *path = malloc(nPath+1);
703          if (!(*path))
704             internal("moduleNameToFileNames: malloc failed(1)");
705          strncpy(*path, searchBuf, nPath);
706          (*path)[nPath] = 0;
707          free(augdPath); 
708          return TRUE;
709       }
710
711    }
712    
713 }
714
715
716 /* --------------------------------------------------------------------------
717  * Substitute old value of path into empty entries in new path
718  * eg substPath("a:b:c::d:e","x:y:z") = "a:b:c:x:y:z:d:e"
719  * ------------------------------------------------------------------------*/
720
721 static String local substPath Args((String,String));
722
723 static String local substPath(new,sub) /* substitute sub path into new path*/
724 String new;
725 String sub; {
726     Bool   substituted = FALSE;            /*   only allow one replacement */
727     Int    maxlen      = strlen(sub) + strlen(new);    /* safe upper bound */
728     String r = (String) malloc(maxlen+1);  /* result string                */
729     String t = r;                          /* pointer into r               */
730     String next = new;                     /* next uncopied char in new    */
731     String start = next;                   /* start of last path component */
732     if (r == 0) {
733         ERRMSG(0) "String storage space exhausted"
734         EEND;
735     }
736     do {
737         if (*next == PATHSEP || *next == '\0') {
738             if (!substituted && next == start) {
739                 String s = sub;
740                 for(; *s != '\0'; ++s) {
741                     *t++ = *s;
742                 }
743                 substituted = TRUE;
744             }
745             start = next+1;
746         }
747     } while ((*t++ = *next++) != '\0');
748     return r;
749 }
750
751
752 /* --------------------------------------------------------------------------
753  * Garbage collection notification:
754  * ------------------------------------------------------------------------*/
755
756 Bool gcMessages = FALSE;                /* TRUE => print GC messages       */
757
758 Void gcStarted() {                      /* Notify garbage collector start  */
759 #if HUGS_FOR_WINDOWS
760     SaveCursor = SetCursor(GarbageCursor);
761 #endif
762     if (gcMessages) {
763         Printf("{{Gc");
764         FlushStdout();
765     }
766 }
767
768 Void gcScanning() {                     /* Notify garbage collector scans  */
769     if (gcMessages) {
770         Putchar(':');
771         FlushStdout();
772     }
773 }
774
775 Void gcRecovered(recovered)             /* Notify garbage collection done  */
776 Int recovered; {
777     if (gcMessages) {
778         Printf("%d}}",recovered);
779         FlushStdout();
780     }
781 #if HUGS_FOR_WINDOWS
782     SetCursor(SaveCursor);
783 #endif
784 }
785
786 Cell *CStackBase;                       /* Retain start of C control stack */
787
788 #if RISCOS                              /* Stack traversal for RISCOS      */
789
790 /* Warning: The following code is specific to the Acorn ARM under RISCOS
791    (and C4).  We must explicitly walk back through the stack frames, since
792    the stack is extended from the heap. (see PRM pp. 1757).  gcCStack must
793    not be modified, since the offset '5' assumes that only v1 is used inside
794    this function. Hence we do all the real work in gcARM.
795 */
796                   
797 #define spreg 13 /* C3 has SP=R13 */
798
799 #define previousFrame(fp)       ((int *)((fp)[-3]))
800 #define programCounter(fp)      ((int *)((*(fp)-12) & ~0xFC000003))
801 #define isSubSPSP(w)            (((w)&dontCare) == doCare)
802 #define doCare                  (0xE24DD000)  /* SUB r13,r13,#0 */
803 #define dontCare                (~0x00100FFF) /* S and # bits   */
804 #define immediateArg(x)         ( ((x)&0xFF) << (((x)&0xF00)>>7) )
805
806 static void gcARM(int *fp) {
807     int si = *programCounter(fp);       /* Save instruction indicates how */
808                                         /* many registers in this frame   */
809     int *regs = fp - 4;
810     if (si & (1<<0)) markWithoutMove(*regs--);
811     if (si & (1<<1)) markWithoutMove(*regs--);
812     if (si & (1<<2)) markWithoutMove(*regs--);
813     if (si & (1<<3)) markWithoutMove(*regs--);
814     if (si & (1<<4)) markWithoutMove(*regs--);
815     if (si & (1<<5)) markWithoutMove(*regs--);
816     if (si & (1<<6)) markWithoutMove(*regs--);
817     if (si & (1<<7)) markWithoutMove(*regs--);
818     if (si & (1<<8)) markWithoutMove(*regs--);
819     if (si & (1<<9)) markWithoutMove(*regs--);
820     if (previousFrame(fp)) {
821         /* The non-register stack space is for the previous frame is above
822            this fp, and not below the previous fp, because of the way stack
823            extension works. It seems the only way of discovering its size is
824            finding the SUB sp, sp, #? instruction by walking through the code
825            following the entry point.
826         */
827         int *oldpc = programCounter(previousFrame(fp));
828         int fsize = 0, i;
829         for(i = 1; i < 6; ++i)
830             if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4;
831         for(i=1; i<=fsize; ++i)
832             markWithoutMove(fp[i]);
833     }
834 }
835
836 void gcCStack() {
837     int dummy;
838     int *fp = 5 + &dummy;
839     while (fp) {
840         gcARM(fp);
841         fp = previousFrame(fp);
842     }
843 }
844
845 #else                   /* Garbage collection for standard stack machines  */
846
847 Void gcCStack() {                       /* Garbage collect elements off    */
848     Cell stackTop = NIL;                /* C stack                         */
849     Cell *ptr = &stackTop;
850 #if SIZEOF_INTP == 2
851     if (((long)(ptr) - (long)(CStackBase))&1)
852         fatal("gcCStack");
853 #elif STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
854     if (((long)(ptr) - (long)(CStackBase))&1)
855         fatal("gcCStack");
856 #else 
857     if (((long)(ptr) - (long)(CStackBase))&3)
858         fatal("gcCStack");
859 #endif
860
861 #define Blargh markWithoutMove(*ptr);
862 #if 0
863                markWithoutMove((*ptr)/sizeof(Cell)); \
864                markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell));  \
865                markWithoutMove(( (void*)(*ptr)-(void*)heapTopSnd)/sizeof(Cell))
866 #endif
867
868 #define StackGrowsDown  { while (ptr<=CStackBase) { Blargh; ptr++; }; }
869 #define StackGrowsUp    { while (ptr>=CStackBase) { Blargh; ptr--; }; }
870 #define GuessDirection  if (ptr>CStackBase) StackGrowsUp else StackGrowsDown
871
872 #if STACK_DIRECTION > 0
873     StackGrowsUp;
874 #elif STACK_DIRECTION < 0
875     StackGrowsDown;
876 #else
877     GuessDirection;
878 #endif
879
880 #if SIZEOF_INTP==4 && STACK_ALIGNMENT == 2 /* eg Macintosh 68000 */
881     ptr = (Cell *)((long)(&stackTop) + 2);
882     StackGrowsDown;
883 #endif
884
885 #undef  StackGrowsDown
886 #undef  StackGrowsUp
887 #undef  GuessDirection
888 }
889 #endif
890
891 /* --------------------------------------------------------------------------
892  * Terminal dependent stuff:
893  * ------------------------------------------------------------------------*/
894
895 #if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
896
897 /* grab the varargs prototype for ioctl */
898 #if HAVE_SYS_IOCTL_H
899 # include <sys/ioctl.h>
900 #endif
901
902 /* The order of these three tests is very important because
903  * some systems have more than one of the requisite header file
904  * but only one of them seems to work.
905  * Anyone changing the order of the tests should try enabling each of the
906  * three branches in turn and write down which ones work as well as which
907  * OS/compiler they're using.
908  *
909  * OS            Compiler      sgtty     termio  termios   notes
910  * Linux 2.0.18  gcc 2.7.2     absent    works   works     1
911  *
912  * Notes:
913  * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
914  *    implemented using termios.h.
915  *    sgtty.h is in /usr/include/bsd which is not on my standard include
916  *    path.  Adding it does no harm but you might as well use termios.
917  *    --
918  *    reid-alastair@cs.yale.edu
919  */
920 #if HAVE_TERMIOS_H
921
922 #include <termios.h>
923 typedef  struct termios  TermParams;
924 #define  getTerminal(tp) tcgetattr(fileno(stdin), &tp)
925 #define  setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
926 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
927                          tp.c_cc[VMIN]  = 1;                \
928                          tp.c_cc[VTIME] = 0;
929
930 #elif HAVE_SGTTY_H
931
932 #include <sgtty.h>
933 typedef  struct sgttyb   TermParams;
934 #define  getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
935 #define  setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
936 #if HPUX
937 #define  noEcho(tp)      tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
938 #else
939 #define  noEcho(tp)      tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
940 #endif
941
942 #elif HAVE_TERMIO_H
943
944 #include <termio.h>
945 typedef  struct termio   TermParams;
946 #define  getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
947 #define  setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
948 #define  noEcho(tp)      tp.c_lflag    &= ~(ICANON | ECHO); \
949                          tp.c_cc[VMIN]  = 1;                \
950                          tp.c_cc[VTIME] = 0;
951
952 #endif
953
954 static Bool messedWithTerminal = FALSE;
955 static TermParams originalSettings;
956
957 Void normalTerminal() {                 /* restore terminal initial state  */
958     if (messedWithTerminal)
959         setTerminal(originalSettings);
960 }
961
962 Void noechoTerminal() {                 /* set terminal into noecho mode   */
963     TermParams settings;
964
965     if (!messedWithTerminal) {
966         getTerminal(originalSettings);
967         messedWithTerminal = TRUE;
968     }
969     getTerminal(settings);
970     noEcho(settings);
971     setTerminal(settings);
972 }
973
974 Int getTerminalWidth() {                /* determine width of terminal     */
975 #ifdef TIOCGWINSZ
976 #ifdef _M_UNIX                          /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
977 #include <sys/stream.h>                 /* Required by sys/ptem.h          */
978 #include <sys/ptem.h>                   /* Required to declare winsize     */
979 #endif
980     static struct winsize terminalSize;
981     ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
982     return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
983 #else
984     return 80;
985 #endif
986 }
987
988 Int readTerminalChar() {                /* read character from terminal    */
989     return getchar();                   /* without echo, assuming that     */
990 }                                       /* noechoTerminal() is active...   */
991
992 #elif SYMANTEC_C
993
994 Int readTerminalChar() {                /* read character from terminal    */
995     return getchar();                   /* without echo, assuming that     */
996 }                                       /* noechoTerminal() is active...   */
997  
998 Int getTerminalWidth() {
999     return console_options.ncols;
1000 }
1001
1002 Void normalTerminal() {
1003     csetmode(C_ECHO, stdin);
1004 }
1005
1006 Void noechoTerminal() {
1007     csetmode(C_NOECHO, stdin);
1008 }
1009
1010 #else /* no terminal driver - eg DOS, RISCOS */
1011
1012 static Bool terminalEchoReqd = TRUE;
1013
1014 Int getTerminalWidth() {
1015 #if RISCOS
1016     int dummy, width;
1017     (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
1018     return width+1;
1019 #else
1020     return 80;
1021 #endif
1022 }
1023
1024 Void normalTerminal() {                 /* restore terminal initial state  */
1025     terminalEchoReqd = TRUE;
1026 }
1027
1028 Void noechoTerminal() {                 /* turn terminal echo on/off       */
1029     terminalEchoReqd = FALSE;
1030 }
1031
1032 Int readTerminalChar() {                /* read character from terminal    */
1033     if (terminalEchoReqd) {
1034         return getchar();
1035     } else {
1036         Int c = getch();
1037         return c=='\r' ? '\n' : c;      /* slight paranoia about CR-LF    */
1038     }
1039 }
1040
1041 #endif /* no terminal driver */
1042
1043 /* --------------------------------------------------------------------------
1044  * Interrupt handling:
1045  * ------------------------------------------------------------------------*/
1046
1047 Bool    broken         = FALSE;
1048 static  Bool breakReqd = FALSE;
1049 static  sigProto(ignoreBreak);
1050 static  Void local installHandlers Args((Void));
1051
1052 Bool breakOn(reqd)                      /* set break trapping on if reqd,  */
1053 Bool reqd; {                            /* or off otherwise, returning old */
1054     Bool old  = breakReqd;
1055
1056     breakReqd = reqd;
1057     if (reqd) {
1058         if (broken) {                   /* repond to break signal received */
1059             broken = FALSE;             /* whilst break trap disabled      */
1060             sigRaise(breakHandler);
1061             /* not reached */
1062         }
1063 #if HANDLERS_CANT_LONGJMP
1064         ctrlbrk(ignoreBreak);
1065 #else
1066         ctrlbrk(breakHandler);
1067 #endif
1068     } else {
1069         ctrlbrk(ignoreBreak);
1070     }
1071     return old;
1072 }
1073
1074 static sigHandler(ignoreBreak) {        /* record but don't respond to break*/
1075     ctrlbrk(ignoreBreak);         /* reinstall signal handler               */
1076                                   /* redundant on BSD systems but essential */
1077                                   /* on POSIX and other systems             */
1078     broken = TRUE;
1079     interruptStgRts();
1080     sigResume;
1081 }
1082
1083 #if !DONT_PANIC
1084 static sigProto(panic);
1085 static sigHandler(panic) {              /* exit in a panic, on receipt of  */
1086     everybody(EXIT);                    /* an unexpected signal            */
1087     fprintf(stderr,"\nUnexpected signal\n");
1088     exit(1);
1089     sigResume;/*NOTREACHED*/
1090 }
1091 #endif /* !DONT_PANIC */
1092
1093 static Void local installHandlers() { /* Install handlers for all fatal    */ 
1094                                       /* signals except SIGINT and SIGBREAK*/
1095 #if !DONT_PANIC && !DOS
1096 # ifdef SIGABRT
1097     signal(SIGABRT,panic);
1098 # endif
1099 # ifdef SIGBUS
1100     signal(SIGBUS,panic);
1101 # endif
1102 # ifdef SIGFPE
1103     signal(SIGFPE,panic);
1104 # endif
1105 # ifdef SIGHUP
1106     signal(SIGHUP,panic);
1107 # endif
1108 # ifdef SIGILL
1109     signal(SIGILL,panic);
1110 # endif
1111 # ifdef SIGQUIT
1112     signal(SIGQUIT,panic);
1113 # endif
1114 # ifdef SIGSEGV
1115     signal(SIGSEGV,panic);
1116 # endif
1117 # ifdef SIGTERM
1118     signal(SIGTERM,panic);
1119 # endif
1120 #endif /* !DONT_PANIC && !DOS */
1121 }
1122
1123 /* --------------------------------------------------------------------------
1124  * Shell escapes:
1125  * ------------------------------------------------------------------------*/
1126
1127 static Bool local startEdit(line,nm)    /* Start editor on file name at    */
1128 Int    line;                            /* given line.  Both name and line */
1129 String nm; {                            /* or just line may be zero        */
1130     static char editorCmd[FILENAME_MAX+1];
1131
1132 #if !SYMANTEC_C
1133     if (hugsEdit && *hugsEdit) {        /* Check that editor configured    */
1134 #else
1135     /* On a Mac, files have creator information, telling which program
1136        to launch to, so an editor named to the empty string "" is often
1137        desirable. */
1138     if (hugsEdit) {        /* Check that editor configured    */
1139 #endif
1140         Int n     = FILENAME_MAX;
1141         String he = hugsEdit;
1142         String ec = editorCmd;
1143         String rd = NULL;               /* Set to nonnull to redo ...      */
1144
1145         for (; n>0 && *he && *he!=' '; n--)
1146             *ec++ = *he++;              /* Copy editor name to buffer      */
1147                                         /* assuming filename ends at space */
1148
1149         if (nm && line && n>1 && *he){  /* Name, line, and enough space    */
1150             rd = ec;                    /* save, in case we don't find name*/
1151             while (n>0 && *he) {
1152                 if (*he=='%') {
1153                     if (*++he=='d' && n>10) {
1154                         sprintf(ec,"%d",line);
1155                         he++;
1156                     }
1157                     else if (*he=='s' && (size_t)n>strlen(nm)) {
1158                         strcpy(ec,nm);
1159                         rd = NULL;
1160                         he++;
1161                     }
1162                     else if (*he=='%' && n>1) {
1163                         strcpy(ec,"%");
1164                         he++;
1165                     }
1166                     else                /* Ignore % char if not followed   */
1167                         *ec = '\0';     /* by one of d, s, or %,           */
1168                     for (; *ec && n>0; n--)
1169                         ec++;
1170                 }   /* ignore % followed by anything other than d, s, or % */
1171                 else {                  /* Copy other characters across    */
1172                     *ec++ = *he++;
1173                     n--;
1174                 }
1175             }
1176         }
1177         else
1178             line = 0;
1179
1180         if (rd) {                       /* If file name was not included   */
1181             ec   = rd;
1182             line = 0;
1183         }
1184
1185         if (nm && line==0 && n>1) {     /* Name, but no line ...           */
1186             *ec++ = ' ';
1187             for (; n>0 && *nm; n--)     /* ... just copy file name         */
1188                 *ec++ = *nm++;
1189         }
1190
1191         *ec = '\0';                     /* Add terminating null byte       */
1192     }
1193     else {
1194         ERRMSG(0) "Hugs is not configured to use an editor"
1195         EEND;
1196     }
1197
1198 #if HAVE_WINEXEC
1199     WinExec(editorCmd, SW_SHOW);
1200     return FALSE;
1201 #else
1202     if (shellEsc(editorCmd))
1203         Printf("Warning: Editor terminated abnormally\n");
1204     return TRUE;
1205 #endif
1206 }
1207
1208 Int shellEsc(s)                         /* run a shell command (or shell)  */
1209 String s; {
1210 #if HAVE_MACSYSTEM
1211     return macsystem(s);
1212 #else
1213 #if HAVE_BIN_SH
1214     if (s[0]=='\0') {
1215         s = fromEnv("SHELL","/bin/sh");
1216     }
1217 #endif
1218     return system(s);
1219 #endif
1220 }
1221
1222 #if RISCOS                              /* RISCOS also needs a chdir()     */
1223 int chdir(char *s) {                    /* RISCOS PRM p. 885    -- JBS     */
1224     return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL;
1225 }
1226 #elif defined HAVE_PBHSETVOLSYNC        /* Macintosh */
1227 int chdir(const char *s) {      
1228     char* str;
1229     WDPBRec wd;
1230     wd.ioCompletion = 0;
1231     str = (char*)malloc(strlen(s) + 1);
1232     if (str == 0) return -1;
1233     strcpy(str, s);
1234     wd.ioNamePtr = C2PStr(str);
1235     wd.ioVRefNum = 0;
1236     wd.ioWDDirID = 0;
1237     errno = PBHSetVolSync(&wd);
1238     free(str);
1239     if (errno == 0) {
1240         return 0;
1241     } else {
1242         return -1;
1243     }
1244 }
1245 #endif
1246
1247
1248 /*---------------------------------------------------------------------------
1249  * Printf-related operations:
1250  *-------------------------------------------------------------------------*/
1251
1252 #if !defined(HAVE_VSNPRINTF)
1253 int vsnprintf(buffer, count, fmt, ap)
1254 char*       buffer;
1255 int         count;
1256 const char* fmt;
1257 va_list     ap; {
1258 #if defined(HAVE__VSNPRINTF)
1259     return _vsnprintf(buffer, count, fmt, ap);
1260 #else
1261     return 0;
1262 #endif
1263 }
1264 #endif /* HAVE_VSNPRINTF */
1265
1266 #if !defined(HAVE_SNPRINTF)
1267 int snprintf(char* buffer, int count, const char* fmt, ...) {
1268 #if defined(HAVE__VSNPRINTF)
1269     int r;
1270     va_list ap;                    /* pointer into argument list           */
1271     va_start(ap, fmt);             /* make ap point to first arg after fmt */
1272     r = vsnprintf(buffer, count, fmt, ap);
1273     va_end(ap);                    /* clean up                             */
1274     return r;
1275 #else
1276     return 0;
1277 #endif
1278 }
1279 #endif /* HAVE_SNPRINTF */
1280
1281 /* --------------------------------------------------------------------------
1282  * Read/write values from/to the registry
1283  *
1284  * All reads are from either HUGS_CURRENT_USER\\hugs_ROOT\\key or 
1285  * HUGS_LOCAL_MACHINE\\hugs_ROOT\\key.  (Machine entry is only used if
1286  * user entry doesn't exist).
1287  *
1288  * All writes are to HUGS_CURRENT_USER\\HugsRoot\\key
1289  * ------------------------------------------------------------------------*/
1290
1291 #if USE_REGISTRY
1292
1293 #define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
1294
1295 static Bool   local createKey      Args((HKEY, PHKEY, REGSAM));
1296 static Bool   local queryValue     Args((HKEY, String, LPDWORD, LPBYTE, DWORD));
1297 static Bool   local setValue       Args((HKEY, String, DWORD, LPBYTE, DWORD));
1298
1299 static Bool local createKey(hKey, phRootKey, samDesired)
1300 HKEY    hKey;
1301 PHKEY   phRootKey; 
1302 REGSAM  samDesired; {
1303     DWORD  dwDisp;
1304     return RegCreateKeyEx(hKey, HugsRoot,
1305                           0, "", REG_OPTION_NON_VOLATILE,
1306                           samDesired, NULL, phRootKey, &dwDisp) 
1307            == ERROR_SUCCESS;
1308 }
1309
1310 static Bool local queryValue(hKey, regPath, var, type, buf, bufSize)
1311 HKEY    hKey;
1312 String  regPath;
1313 String  var;
1314 LPDWORD type;
1315 LPBYTE  buf;
1316 DWORD   bufSize; {
1317     HKEY hRootKey;
1318
1319     if (!createKey(hKey, regPath, &hRootKey, KEY_READ)) {
1320         return FALSE;
1321     } else {
1322         LONG res = RegQueryValueEx(hRootKey, var, NULL, type, buf, &bufSize);
1323         RegCloseKey(hRootKey);
1324         return (res == ERROR_SUCCESS);
1325     }
1326 }
1327
1328 static Bool local setValue(hKey, regPath, var, type, buf, bufSize)
1329 HKEY   hKey;
1330 String regPath;
1331 String var;
1332 DWORD  type;
1333 LPBYTE buf;
1334 DWORD  bufSize; {
1335     HKEY hRootKey;
1336
1337     if (!createKey(hKey, regPath, &hRootKey, KEY_WRITE)) {
1338         return FALSE;
1339     } else {
1340         LONG res = RegSetValueEx(hRootKey, var, 0, type, buf, bufSize);
1341         RegCloseKey(hRootKey);
1342         return (res == ERROR_SUCCESS);
1343     }
1344 }
1345
1346 static String local readRegString(key,regPath,var,def) /* read String from registry */
1347 HKEY   key;
1348 String regPath;
1349 String var; 
1350 String def; {
1351     static char  buf[300];
1352     DWORD type;
1353     if (queryValue(key, regPath,var, &type, buf, sizeof(buf))
1354         && type == REG_SZ) {
1355         return (String)buf;
1356     } else {
1357         return def;
1358     }
1359 }
1360
1361 static Int local readRegInt(var, def)            /* read Int from registry */
1362 String var;
1363 Int    def; {
1364     DWORD buf;
1365     DWORD type;
1366
1367     if (queryValue(HKEY_CURRENT_USER, HugsRoot, var, &type, 
1368                    (LPBYTE)&buf, sizeof(buf))
1369         && type == REG_DWORD) {
1370         return (Int)buf;
1371     } else if (queryValue(HKEY_LOCAL_MACHINE, HugsRoot, var, &type, 
1372                           (LPBYTE)&buf, sizeof(buf))
1373                && type == REG_DWORD) {
1374         return (Int)buf;
1375     } else {
1376         return def;
1377     }
1378 }
1379
1380 static Bool local writeRegString(var,val)      /* write String to registry */
1381 String var;                        
1382 String val; {
1383     if (NULL == val) {
1384         val = "";
1385     }
1386     return setValue(HKEY_CURRENT_USER, HugsRoot, var, 
1387                     REG_SZ, (LPBYTE)val, lstrlen(val)+1);
1388 }
1389
1390 static Bool local writeRegInt(var,val)         /* write String to registry */
1391 String var;                        
1392 Int    val; {
1393     return setValue(HKEY_CURRENT_USER, HugsRoot, var, 
1394                     REG_DWORD, (LPBYTE)&val, sizeof(val));
1395 }
1396
1397 #endif /* USE_REGISTRY */
1398
1399 /* --------------------------------------------------------------------------
1400  * Machine dependent control:
1401  * ------------------------------------------------------------------------*/
1402
1403 Void machdep(what)                      /* Handle machine specific         */
1404 Int what; {                             /* initialisation etc..            */
1405     switch (what) {
1406         case MARK    : break;
1407         case INSTALL : installHandlers();
1408                        break;
1409         case RESET   :
1410         case BREAK   :
1411         case EXIT    : normalTerminal();
1412 #if HUGS_FOR_WINDOWS
1413                        if (what==EXIT)
1414                            DestroyWindow(hWndMain);
1415                        else
1416                            SetCursor(LoadCursor(NULL,IDC_ARROW));
1417 #endif
1418                        break;
1419     }
1420 }
1421
1422 /*-------------------------------------------------------------------------*/