1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 #include "ux.h"
28 #include "uxtop.h"
29 #include "osctty.h"
30 #include "osenv.h"
31 #include "uxutil.h"
32 #include "errors.h"
33 #include "option.h"
34 #include "config.h"
35 #include "object.h"
36 #include "extern.h"
37
38 #ifdef __APPLE__
39 # include <CoreServices/CoreServices.h>
40 extern const char * OS_current_user_home_directory (void);
41 static CFURLRef macosx_default_band_url (void);
42 #endif
43
44 extern void UX_initialize_channels (void);
45 extern void UX_initialize_ctty (int interactive);
46 extern void UX_initialize_directory_reader (void);
47 extern void UX_initialize_environment (void);
48 extern void UX_initialize_processes (void);
49 extern void UX_initialize_signals (void);
50 extern void UX_initialize_terminals (void);
51 extern void UX_initialize_trap_recovery (void);
52 extern void UX_initialize_tty (void);
53 extern void UX_initialize_userio (void);
54
55 extern void UX_reset_channels (void);
56 extern void UX_reset_processes (void);
57 extern void UX_reset_terminals (void);
58
59 extern cc_t OS_ctty_quit_char (void);
60 extern void UX_ctty_save_external_state (void);
61 extern void UX_ctty_save_internal_state (void);
62 extern void UX_ctty_restore_internal_state (void);
63 extern void UX_ctty_restore_external_state (void);
64
65 static int interactive;
66
67 int
OS_under_emacs_p(void)68 OS_under_emacs_p (void)
69 {
70 return (option_emacs_subprocess);
71 }
72
73 void
OS_initialize(void)74 OS_initialize (void)
75 {
76 initialize_interruptable_extent ();
77 {
78 interactive =
79 (option_force_interactive
80 || (isatty (STDIN_FILENO))
81 || (isatty (STDOUT_FILENO))
82 || (isatty (STDERR_FILENO)));
83 if (option_batch_mode)
84 interactive = false;
85 /* The argument passed to `UX_ctty_initialize' says whether to
86 permit interrupt control, i.e. whether to attempt to setup the
87 keyboard interrupt characters. */
88 UX_initialize_ctty (interactive);
89 }
90 UX_initialize_channels ();
91 UX_initialize_terminals ();
92 UX_initialize_environment ();
93 UX_initialize_tty ();
94 UX_initialize_userio ();
95 UX_initialize_signals ();
96 UX_initialize_processes ();
97 UX_initialize_trap_recovery ();
98 UX_initialize_directory_reader ();
99 OS_Name = SYSTEM_NAME;
100 OS_Variant = SYSTEM_VARIANT;
101 #if defined(_SUNOS) || defined(_SUNOS3) || defined(_SUNOS4)
102 vadvise (VA_ANOM); /* Anomalous paging, don't try to guess. */
103 #endif
104 #ifdef __APPLE__
105 /* If in MacOS X application bundle, force working directory to
106 user's home directory. */
107 if (macosx_in_app_p ())
108 {
109 const char * home_dir = OS_current_user_home_directory ();
110 if (home_dir != 0)
111 OS_set_working_dir_pathname (home_dir);
112 }
113 #endif
114 }
115
116 void
OS_announcement(void)117 OS_announcement (void)
118 {
119 if ((!option_emacs_subprocess) && (OS_ctty_interrupt_control ()))
120 fprintf
121 (stdout,
122 "Type %s followed by `H' to obtain information about interrupts.\n",
123 (char_description ((OS_ctty_quit_char ()), 1)));
124 }
125
126 void
OS_reset(void)127 OS_reset (void)
128 {
129 /* There should really be a reset for each initialize above, but the
130 rest seem innocuous. */
131 UX_reset_channels ();
132 UX_reset_terminals ();
133 UX_reset_processes ();
134 execute_reload_cleanups ();
135 }
136
137 void
OS_quit(int code,int abnormal_p)138 OS_quit (int code, int abnormal_p)
139 {
140 fflush (stdout);
141 if (abnormal_p
142 && interactive
143 && (! ((code == TERM_SIGNAL) || (code == TERM_EOF))))
144 {
145 fputs ("\nScheme has terminated abnormally!\n", stdout);
146 {
147 int dump_core =
148 ((!option_disable_core_dump)
149 && (userio_confirm ("Would you like a core dump? [Y or N] "))
150 && (userio_confirm ("Do you really want a core dump? [Y or N] ")));
151 putc ('\n', stdout);
152 fflush (stdout);
153 if (dump_core)
154 UX_dump_core ();
155 }
156 }
157 OS_restore_external_state ();
158 }
159
160 void
UX_dump_core(void)161 UX_dump_core (void)
162 {
163 OS_restore_external_state ();
164 /* Unmask this too? */
165 UX_signal (SIGABRT, SIG_DFL);
166 UX_abort ();
167 }
168
169 void
OS_save_external_state(void)170 OS_save_external_state (void)
171 {
172 UX_ctty_save_external_state ();
173 }
174
175 void
OS_save_internal_state(void)176 OS_save_internal_state (void)
177 {
178 UX_ctty_save_internal_state ();
179 }
180
181 void
OS_restore_internal_state(void)182 OS_restore_internal_state (void)
183 {
184 UX_ctty_restore_internal_state ();
185 }
186
187 void
OS_restore_external_state(void)188 OS_restore_external_state (void)
189 {
190 UX_ctty_restore_external_state ();
191 }
192
193 #ifdef __APPLE__
194
195 const char *
macosx_main_bundle_dir(void)196 macosx_main_bundle_dir (void)
197 {
198 CFURLRef url = (macosx_default_band_url ());
199 UInt8 buffer [4096];
200 char * bp;
201 char * result;
202
203 if (url == 0)
204 return (0);
205
206 if (!CFURLGetFileSystemRepresentation (url, true, buffer, (sizeof (buffer))))
207 {
208 CFRelease (url);
209 return (0);
210 }
211 CFRelease (url);
212 bp = ((char *) buffer);
213
214 /* Discard everything after the final slash. */
215 {
216 char * slash = (strrchr (bp, '/'));
217 if (slash != 0)
218 (*slash) = '\0';
219 }
220
221 result = (UX_malloc ((strlen (bp)) + 1));
222 if (result != 0)
223 strcpy (result, bp);
224
225 return (result);
226 }
227
228 bool
macosx_in_app_p(void)229 macosx_in_app_p (void)
230 {
231 if (!option_macosx_application)
232 return (false);
233 CFURLRef url = (macosx_default_band_url ());
234 if (url == 0)
235 return (false);
236 CFRelease (url);
237 return (true);
238 }
239
240 static CFURLRef
macosx_default_band_url(void)241 macosx_default_band_url (void)
242 {
243 CFBundleRef bundle = (CFBundleGetMainBundle());
244 return
245 ((bundle != 0)
246 ? (CFBundleCopyResourceURL (bundle, (CFSTR ("all")), (CFSTR ("com")), 0))
247 : 0);
248 }
249
250 #endif
251
252 enum syserr_names
OS_error_code_to_syserr(int code)253 OS_error_code_to_syserr (int code)
254 {
255 switch (code)
256 {
257 case E2BIG: return (syserr_arg_list_too_long);
258 case EACCES: return (syserr_permission_denied);
259 #ifdef EADDRINUSE
260 case EADDRINUSE: return (syserr_address_in_use);
261 #endif
262 #ifdef EADDRNOTAVAIL
263 case EADDRNOTAVAIL: return (syserr_address_not_available);
264 #endif
265 #ifdef EAFNOSUPPORT
266 case EAFNOSUPPORT: return (syserr_address_family_not_supported);
267 #endif
268 case EAGAIN: return (syserr_resource_temporarily_unavailable);
269 case EBADF: return (syserr_bad_file_descriptor);
270 case EBUSY: return (syserr_resource_busy);
271 case ECHILD: return (syserr_no_child_processes);
272 #ifdef ECONNREFUSED
273 case ECONNREFUSED: return (syserr_connection_refused);
274 #endif
275 #ifdef ECONNRESET
276 case ECONNRESET: return (syserr_connection_reset);
277 #endif
278 case EDEADLK: return (syserr_resource_deadlock_avoided);
279 case EDOM: return (syserr_domain_error);
280 case EEXIST: return (syserr_file_exists);
281 case EFAULT: return (syserr_bad_address);
282 case EFBIG: return (syserr_file_too_large);
283 #ifdef EHOSTUNREACH
284 case EHOSTUNREACH: return (syserr_host_is_unreachable);
285 #endif
286 case EINTR: return (syserr_interrupted_function_call);
287 case EINVAL: return (syserr_invalid_argument);
288 case EIO: return (syserr_io_error);
289 case EISDIR: return (syserr_is_a_directory);
290 case EMFILE: return (syserr_too_many_open_files);
291 case EMLINK: return (syserr_too_many_links);
292 #ifdef ENAMETOOLONG
293 case ENAMETOOLONG: return (syserr_filename_too_long);
294 #endif
295 case ENFILE: return (syserr_too_many_open_files_in_system);
296 case ENODEV: return (syserr_no_such_device);
297 case ENOENT: return (syserr_no_such_file_or_directory);
298 case ENOEXEC: return (syserr_exec_format_error);
299 #ifdef ENOLCK
300 case ENOLCK: return (syserr_no_locks_available);
301 #endif
302 case ENOMEM: return (syserr_not_enough_space);
303 case ENOSPC: return (syserr_no_space_left_on_device);
304 case ENOSYS: return (syserr_function_not_implemented);
305 case ENOTDIR: return (syserr_not_a_directory);
306 #if defined(ENOTEMPTY) && (ENOTEMPTY != EEXIST)
307 case ENOTEMPTY: return (syserr_directory_not_empty);
308 #endif
309 case ENOTTY: return (syserr_inappropriate_io_control_operation);
310 case ENXIO: return (syserr_no_such_device_or_address);
311 case EPERM: return (syserr_operation_not_permitted);
312 case EPIPE: return (syserr_broken_pipe);
313 case ERANGE: return (syserr_result_too_large);
314 case EROFS: return (syserr_read_only_file_system);
315 case ESPIPE: return (syserr_invalid_seek);
316 case ESRCH: return (syserr_no_such_process);
317 case EXDEV: return (syserr_improper_link);
318 default: return (syserr_unknown);
319 }
320 }
321
322 static int
syserr_to_error_code(enum syserr_names syserr)323 syserr_to_error_code (enum syserr_names syserr)
324 {
325 switch (syserr)
326 {
327 #ifdef EAFNOSUPPORT
328 case syserr_address_family_not_supported: return (EAFNOSUPPORT);
329 #endif
330 #ifdef EADDRINUSE
331 case syserr_address_in_use: return (EADDRINUSE);
332 #endif
333 #ifdef EADDRNOTAVAIL
334 case syserr_address_not_available: return (EADDRNOTAVAIL);
335 #endif
336 case syserr_arg_list_too_long: return (E2BIG);
337 case syserr_bad_address: return (EFAULT);
338 case syserr_bad_file_descriptor: return (EBADF);
339 case syserr_broken_pipe: return (EPIPE);
340 #ifdef ECONNREFUSED
341 case syserr_connection_refused: return (ECONNREFUSED);
342 #endif
343 #ifdef ECONNRESET
344 case syserr_connection_reset: return (ECONNRESET);
345 #endif
346 #ifdef ENOTEMPTY
347 case syserr_directory_not_empty: return (ENOTEMPTY);
348 #endif
349 case syserr_domain_error: return (EDOM);
350 case syserr_exec_format_error: return (ENOEXEC);
351 case syserr_file_exists: return (EEXIST);
352 case syserr_file_too_large: return (EFBIG);
353 #ifdef ENAMETOOLONG
354 case syserr_filename_too_long: return (ENAMETOOLONG);
355 #endif
356 case syserr_function_not_implemented: return (ENOSYS);
357 #ifdef EHOSTUNREACH
358 case syserr_host_is_unreachable: return (EHOSTUNREACH);
359 #endif
360 case syserr_improper_link: return (EXDEV);
361 case syserr_inappropriate_io_control_operation: return (ENOTTY);
362 case syserr_interrupted_function_call: return (EINTR);
363 case syserr_invalid_argument: return (EINVAL);
364 case syserr_invalid_seek: return (ESPIPE);
365 case syserr_io_error: return (EIO);
366 case syserr_is_a_directory: return (EISDIR);
367 case syserr_no_child_processes: return (ECHILD);
368 #ifdef ENOLCK
369 case syserr_no_locks_available: return (ENOLCK);
370 #endif
371 case syserr_no_space_left_on_device: return (ENOSPC);
372 case syserr_no_such_device: return (ENODEV);
373 case syserr_no_such_device_or_address: return (ENXIO);
374 case syserr_no_such_file_or_directory: return (ENOENT);
375 case syserr_no_such_process: return (ESRCH);
376 case syserr_not_a_directory: return (ENOTDIR);
377 case syserr_not_enough_space: return (ENOMEM);
378 case syserr_operation_not_permitted: return (EPERM);
379 case syserr_permission_denied: return (EACCES);
380 case syserr_read_only_file_system: return (EROFS);
381 case syserr_resource_busy: return (EBUSY);
382 case syserr_resource_deadlock_avoided: return (EDEADLK);
383 case syserr_resource_temporarily_unavailable: return (EAGAIN);
384 case syserr_result_too_large: return (ERANGE);
385 case syserr_too_many_links: return (EMLINK);
386 case syserr_too_many_open_files: return (EMFILE);
387 case syserr_too_many_open_files_in_system: return (ENFILE);
388 default: return (0);
389 }
390 }
391
392 #ifdef HAVE_STRERROR
393
394 const char *
OS_error_code_to_message(unsigned int syserr)395 OS_error_code_to_message (unsigned int syserr)
396 {
397 return
398 ((syserr == 0)
399 ? 0
400 : (strerror (syserr_to_error_code ((enum syserr_names) syserr))));
401 }
402
403 #else /* not HAVE_STRERROR */
404
405 #ifdef __HPUX__
406 # define NEED_ERRLIST_DEFINITIONS
407 #endif
408
409 #ifdef NEED_ERRLIST_DEFINITIONS
410 extern char * sys_errlist [];
411 extern int sys_nerr;
412 #endif
413
414 const char *
OS_error_code_to_message(unsigned int syserr)415 OS_error_code_to_message (unsigned int syserr)
416 {
417 int code = (syserr_to_error_code ((enum syserr_names) syserr));
418 return (((code > 0) && (code <= sys_nerr)) ? (sys_errlist [code]) : 0);
419 }
420
421 #endif /* not HAVE_STRERROR */
422
423 static const char * syscall_names_table [] =
424 {
425 "accept",
426 "bind",
427 "chdir",
428 "chmod",
429 "clock_gettime",
430 "close",
431 "connect",
432 "fcntl-getfl",
433 "fcntl-fullfsync",
434 "fcntl-setfl",
435 "fdatasync",
436 "fork",
437 "fstat",
438 "fstatfs",
439 "fsync",
440 "fsync_range",
441 "ftruncate",
442 "getcwd",
443 "gethostname",
444 "gettimeofday",
445 "gmtime",
446 "ioctl-tiocgpgrp",
447 "ioctl-tiocsigsend",
448 "kill",
449 "link",
450 "listen",
451 "localtime",
452 "lseek",
453 "lstat",
454 "malloc",
455 "mkdir",
456 "mktime",
457 "ntp_adjtime",
458 "ntp_gettime",
459 "open",
460 "opendir",
461 "pause",
462 "pipe",
463 "read",
464 "readlink",
465 "realloc",
466 "rename",
467 "rmdir",
468 "select",
469 "setitimer",
470 "setpgid",
471 "setsockopt",
472 "shutdown",
473 "sighold",
474 "sigprocmask",
475 "sigsuspend",
476 "sleep",
477 "socket",
478 "stat",
479 "statfs",
480 "symlink",
481 "sync_file_range",
482 "tcdrain",
483 "tcflush",
484 "tcgetpgrp",
485 "tcsetpgrp",
486 "terminal-get-state",
487 "terminal-set-state",
488 "time",
489 "times",
490 "unlink",
491 "utime",
492 "vfork",
493 "write",
494 };
495
496 void
OS_syscall_names(unsigned long * length,const char *** names)497 OS_syscall_names (unsigned long * length, const char *** names)
498 {
499 (*length) = ((sizeof (syscall_names_table)) / (sizeof (char *)));
500 (*names) = syscall_names_table;
501 }
502
503 static const char * syserr_names_table [] =
504 {
505 "unknown",
506 "address-family-not-supported",
507 "address-in-use",
508 "address-not-available",
509 "arg-list-too-long",
510 "bad-address",
511 "bad-file-descriptor",
512 "broken-pipe",
513 "connection-refused",
514 "connection-reset",
515 "directory-not-empty",
516 "domain-error",
517 "exec-format-error",
518 "file-exists",
519 "file-too-large",
520 "filename-too-long",
521 "function-not-implemented",
522 "host-is-unreachable",
523 "improper-link",
524 "inappropriate-io-control-operation",
525 "interrupted-function-call",
526 "invalid-argument",
527 "invalid-seek",
528 "io-error",
529 "is-a-directory",
530 "no-child-processes",
531 "no-locks-available",
532 "no-space-left-on-device",
533 "no-such-device",
534 "no-such-device-or-address",
535 "no-such-file-or-directory",
536 "no-such-process",
537 "not-a-directory",
538 "not-enough-space",
539 "operation-not-permitted",
540 "permission-denied",
541 "read-only-file-system",
542 "resource-busy",
543 "resource-deadlock-avoided",
544 "resource-temporarily-unavailable",
545 "result-too-large",
546 "too-many-links",
547 "too-many-open-files",
548 "too-many-open-files"
549 };
550
551 void
OS_syserr_names(unsigned long * length,const char *** names)552 OS_syserr_names (unsigned long * length, const char *** names)
553 {
554 (*length) = ((sizeof (syserr_names_table)) / (sizeof (char *)));
555 (*names) = syserr_names_table;
556 }
557
558 static unsigned long
round_up(unsigned long n,unsigned long factor)559 round_up (unsigned long n, unsigned long factor)
560 {
561 return (((n + (factor - 1)) / factor) * factor);
562 }
563
564 static unsigned long
round_down(unsigned long n,unsigned long factor)565 round_down (unsigned long n, unsigned long factor)
566 {
567 return ((n / factor) * factor);
568 }
569
570 static void
estimate_pages(void * start,void * end,unsigned long (* round_start)(unsigned long,unsigned long),unsigned long (* round_end)(unsigned long,unsigned long),void ** addr,size_t * len)571 estimate_pages (void *start, void *end,
572 unsigned long (*round_start) (unsigned long, unsigned long),
573 unsigned long (*round_end) (unsigned long, unsigned long),
574 void **addr, size_t *len)
575 {
576 if (end <= start)
577 {
578 (*addr) = start;
579 (*len) = 0;
580 return;
581 }
582
583 {
584 unsigned long page_size = (UX_getpagesize ());
585 char *page_start
586 = ((char *) ((*round_start) (((unsigned long) start), page_size)));
587 char *page_end
588 = ((char *) ((*round_end) (((unsigned long) end), page_size)));
589 (*addr) = ((void *) page_start);
590 (*len) = ((page_start < page_end) ? (page_end - page_start) : 0);
591 }
592 }
593
594 static void
underestimate_pages(void * start,void * end,void ** addr,size_t * len)595 underestimate_pages (void *start, void *end, void **addr, size_t *len)
596 {
597 estimate_pages (start, end, (&round_up), (&round_down), addr, len);
598 }
599
600 static void
overestimate_pages(void * start,void * end,void ** addr,size_t * len)601 overestimate_pages (void *start, void *end, void **addr, size_t *len)
602 {
603 estimate_pages (start, end, (&round_down), (&round_up), addr, len);
604 }
605
606 void
OS_expect_sequential_access(void * start,void * end)607 OS_expect_sequential_access (void *start, void *end)
608 {
609 void *addr;
610 size_t len;
611 overestimate_pages (start, end, (&addr), (&len));
612 #if ((defined (HAVE_POSIX_MADVISE)) && (defined (POSIX_MADV_SEQUENTIAL)))
613 (void) posix_madvise (addr, len, POSIX_MADV_SEQUENTIAL);
614 #elif ((defined (HAVE_MADVISE)) && (defined (MADV_SEQUENTIAL)))
615 (void) madvise (addr, len, MADV_SEQUENTIAL);
616 #endif
617 }
618
619 void
OS_expect_normal_access(void * start,void * end)620 OS_expect_normal_access (void *start, void *end)
621 {
622 void *addr;
623 size_t len;
624 overestimate_pages (start, end, (&addr), (&len));
625 #if ((defined (HAVE_POSIX_MADVISE)) && (defined (POSIX_MADV_NORMAL)))
626 (void) posix_madvise (addr, len, POSIX_MADV_NORMAL);
627 #elif ((defined (HAVE_MADVISE)) && (defined (MADV_NORMAL)))
628 (void) madvise (addr, len, MADV_NORMAL);
629 #endif
630 }
631
632 /* Brain-damaged Linux uses MADV_DONTNEED to mean the destructive
633 operation that everyone else means by MADV_FREE. Everywhere else,
634 (POSIX_)MADV_DONTNEED is a nondestructive operation which is useless
635 here. Fortunately, if Linux ever changes its meaning of
636 MADV_DONTNEED to match the rest of the world, the consequences here
637 are harmless, and if Linux additionally defines MADV_FREE like
638 everyone else in the world, then everything here will be
639 hunky-dory. */
640
641 #if ((defined (__linux__)) && (defined (HAVE_MADVISE)))
642 # if ((! (defined (MADV_FREE))) && (defined (MADV_DONTNEED)))
643 # define MADV_FREE MADV_DONTNEED
644 # endif
645 #endif
646
647 void
OS_free_pages(void * start,void * end)648 OS_free_pages (void *start, void *end)
649 {
650 void *addr;
651 size_t len;
652 underestimate_pages (start, end, (&addr), (&len));
653 #if ((defined (HAVE_MADVISE)) && (defined (MADV_FREE)))
654 (void) madvise (addr, len, MADV_FREE);
655 #endif
656 }
657