X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/08b3caa982199bd7939d9d6877203ada5d0083b5..ac203e0177bcd99126c3b0b42d99401a2c4f7c3b:/src/sysdep.c diff --git a/src/sysdep.c b/src/sysdep.c index 1721172e0d..dfefed7679 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1,6 +1,6 @@ /* Interfaces to system-dependent kernel and library entries. Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, - 2002, 2003, 2004, 2005, 2006, 2007, 2008 + 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -25,9 +25,20 @@ along with GNU Emacs. If not, see . */ #include #include #include +#ifdef HAVE_PWD_H +#include +#include +#endif /* HAVE_PWD_H */ +#ifdef HAVE_LIMITS_H +#include +#endif /* HAVE_LIMITS_H */ #ifdef HAVE_UNISTD_H #include #endif +#ifdef HAVE_ALLOCA_H +#include +#endif /* HAVE_ALLOCA_H */ + #include "lisp.h" /* Including stdlib.h isn't necessarily enough to get srandom declared, e.g. without __USE_XOPEN_EXTENDED with glibc 2. */ @@ -90,32 +101,7 @@ extern int errno; #endif #endif -#ifdef VMS -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef __GNUC__ -#include -#else -#include -#endif -#undef F_SETFL -#ifndef RAB$C_BID -#include -#endif -#define MAXIOSIZE (32 * PAGESIZE) /* Don't I/O more than 32 blocks at a time */ -#endif /* VMS */ - -#ifndef VMS #include -#endif /* not VMS */ #ifdef HAVE_FCNTL_H #include @@ -159,10 +145,6 @@ int _cdecl _getpid (void); extern char *getwd (char *); #endif -#ifdef NONSYSTEM_DIR_LIBRARY -#include "ndir.h" -#endif /* NONSYSTEM_DIR_LIBRARY */ - #include "syssignal.h" #include "systime.h" #ifdef HAVE_UTIME_H @@ -297,12 +279,6 @@ discard_tty_input () if (noninteractive) return; -#ifdef VMS - end_kbd_input (); - SYS$QIOW (0, fileno (CURTTY()->input), IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0, - &buf.main, 0, 0, terminator_mask, 0, 0); - queue_kbd_input (); -#else /* not VMS */ #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ while (dos_keyread () != -1) ; @@ -319,7 +295,6 @@ discard_tty_input () } } #endif /* not MSDOS */ -#endif /* not VMS */ #endif /* not WINDOWSNT */ } @@ -357,20 +332,13 @@ init_baud_rate (int fd) #ifdef DOS_NT emacs_ospeed = 15; #else /* not DOS_NT */ -#ifdef VMS - struct sensemode sg; - - SYS$QIOW (0, fd, IO$_SENSEMODE, &sg, 0, 0, - &sg.class, 12, 0, 0, 0, 0 ); - emacs_ospeed = sg.xmit_baud; -#else /* not VMS */ #ifdef HAVE_TERMIOS struct termios sg; sg.c_cflag = B9600; tcgetattr (fd, &sg); emacs_ospeed = cfgetospeed (&sg); -#else /* neither VMS nor TERMIOS */ +#else /* not TERMIOS */ #ifdef HAVE_TERMIO struct termio sg; @@ -381,7 +349,7 @@ init_baud_rate (int fd) ioctl (fd, TCGETA, &sg); #endif emacs_ospeed = sg.c_cflag & CBAUD; -#else /* neither VMS nor TERMIOS nor TERMIO */ +#else /* neither TERMIOS nor TERMIO */ struct sgttyb sg; sg.sg_ospeed = B9600; @@ -390,7 +358,6 @@ init_baud_rate (int fd) emacs_ospeed = sg.sg_ospeed; #endif /* not HAVE_TERMIO */ #endif /* not HAVE_TERMIOS */ -#endif /* not VMS */ #endif /* not DOS_NT */ } @@ -443,12 +410,6 @@ wait_for_termination (pid) while (1) { #ifdef subprocesses -#ifdef VMS - int status; - - status = SYS$FORCEX (&pid, 0, 0); - break; -#else /* not VMS */ #if defined (BSD_SYSTEM) || defined (HPUX) /* Note that kill returns -1 even if the process is just a zombie now. But inevitably a SIGCHLD interrupt should be generated @@ -503,7 +464,6 @@ wait_for_termination (pid) #endif /* not HAVE_SYSV_SIGPAUSE */ #endif /* not POSIX_SIGNALS */ #endif /* not BSD_SYSTEM, and not HPUX version >= 6 */ -#endif /* not VMS */ #else /* not subprocesses */ #if __DJGPP__ > 1 break; @@ -545,7 +505,6 @@ flush_pending_output (channel) #endif } -#ifndef VMS /* Set up the terminal at the other end of a pseudo-terminal that we will be controlling an inferior through. It should not echo or do line-editing, since that is done @@ -643,7 +602,6 @@ child_setup_tty (out) #endif /* not DOS_NT */ } -#endif /* not VMS */ #endif /* subprocesses */ @@ -662,47 +620,6 @@ static void restore_signal_handlers P_ ((struct save_signal *)); void sys_suspend () { -#ifdef VMS - /* "Foster" parentage allows emacs to return to a subprocess that attached - to the current emacs as a cheaper than starting a whole new process. This - is set up by KEPTEDITOR.COM. */ - unsigned long parent_id, foster_parent_id; - char *fpid_string; - - fpid_string = getenv ("EMACS_PARENT_PID"); - if (fpid_string != NULL) - { - sscanf (fpid_string, "%x", &foster_parent_id); - if (foster_parent_id != 0) - parent_id = foster_parent_id; - else - parent_id = getppid (); - } - else - parent_id = getppid (); - - xfree (fpid_string); /* On VMS, this was malloc'd */ - - if (parent_id && parent_id != 0xffffffff) - { - SIGTYPE (*oldsig)() = (int) signal (SIGINT, SIG_IGN); - int status = LIB$ATTACH (&parent_id) & 1; - signal (SIGINT, oldsig); - return status; - } - else - { - struct { - int l; - char *a; - } d_prompt; - d_prompt.l = sizeof ("Emacs: "); /* Our special prompt */ - d_prompt.a = "Emacs: "; /* Just a reminder */ - LIB$SPAWN (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, &d_prompt, 0); - return 1; - } - return -1; -#else #if defined (SIGTSTP) && !defined (MSDOS) { @@ -724,7 +641,6 @@ sys_suspend () #endif /* no USG_JOBCTRL */ #endif /* no SIGTSTP */ -#endif /* not VMS */ } /* Fork a subshell. */ @@ -732,7 +648,6 @@ sys_suspend () void sys_subshell () { -#ifndef VMS #ifdef DOS_NT /* Demacs 1.1.2 91/10/20 Manabu Higashida */ int st; char oldwd[MAXPATHLEN+1]; /* Fixed length is safe on MSDOS. */ @@ -858,7 +773,6 @@ sys_subshell () #endif restore_signal_handlers (saved_handlers); synch_process_alive = 0; -#endif /* !VMS */ } static void @@ -1075,14 +989,6 @@ emacs_get_tty (fd, settings) if (ioctl (fd, TCGETA, &settings->main) < 0) return -1; -#else -#ifdef VMS - /* Vehemently Monstrous System? :-) */ - if (! (SYS$QIOW (0, fd, IO$_SENSEMODE, settings, 0, 0, - &settings->main.class, 12, 0, 0, 0, 0) - & 1)) - return -1; - #else #ifndef DOS_NT /* I give up - I hope you have the BSD ioctls. */ @@ -1090,7 +996,6 @@ emacs_get_tty (fd, settings) return -1; #endif /* not DOS_NT */ #endif -#endif #endif /* Suivant - Do we have to get struct ltchars data? */ @@ -1167,14 +1072,6 @@ emacs_set_tty (fd, settings, flushp) if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0) return -1; -#else -#ifdef VMS - /* Vehemently Monstrous System? :-) */ - if (! (SYS$QIOW (0, fd, IO$_SETMODE, &input_iosb, 0, 0, - &settings->main.class, 12, 0, 0, 0, 0) - & 1)) - return -1; - #else #ifndef DOS_NT /* I give up - I hope you have the BSD ioctls. */ @@ -1182,7 +1079,6 @@ emacs_set_tty (fd, settings, flushp) return -1; #endif /* not DOS_NT */ -#endif #endif #endif @@ -1213,7 +1109,7 @@ int old_fcntl_owner[MAXDESC]; but if so, this does no harm, and using the same name avoids wasting the other one's space. */ -#if defined (USG) || defined (DGUX) +#if defined (USG) unsigned char _sobuf[BUFSIZ+8]; #else char _sobuf[BUFSIZ]; @@ -1253,25 +1149,6 @@ init_sys_modes (tty_out) if (!tty_out->output) return; /* The tty is suspended. */ -#ifdef VMS - if (!input_ef) - input_ef = get_kbd_event_flag (); - /* LIB$GET_EF (&input_ef); */ - SYS$CLREF (input_ef); - waiting_for_ast = 0; - if (!timer_ef) - timer_ef = get_timer_event_flag (); - /* LIB$GET_EF (&timer_ef); */ - SYS$CLREF (timer_ef); - if (input_ef / 32 != timer_ef / 32) - croak ("Input and timer event flags in different clusters."); - timer_eflist = ((unsigned) 1 << (input_ef % 32)) | - ((unsigned) 1 << (timer_ef % 32)); -#ifndef VMS4_4 - sys_access_reinit (); -#endif -#endif /* VMS */ - #ifdef BSD_PGRPS #if 0 /* read_socket_hook is not global anymore. I think doing this @@ -1360,7 +1237,7 @@ init_sys_modes (tty_out) of C-z */ #endif /* VSWTCH */ -#if defined (mips) || defined (HAVE_TCATTR) +#if defined (__mips__) || defined (HAVE_TCATTR) #ifdef VSUSP tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off mips handling of C-z. */ #endif /* VSUSP */ @@ -1431,16 +1308,6 @@ init_sys_modes (tty_out) tty.main.c_iflag &= ~BRKINT; #endif #else /* if not HAVE_TERMIO */ -#ifdef VMS - tty.main.tt_char |= TT$M_NOECHO; - if (meta_key) - tty.main.tt_char |= TT$M_EIGHTBIT; - if (tty_out->flow_control) - tty.main.tt_char |= TT$M_TTSYNC; - else - tty.main.tt_char &= ~TT$M_TTSYNC; - tty.main.tt2_char |= TT2$M_PASTHRU | TT2$M_XON; -#else /* not VMS (BSD, that is) */ #ifndef DOS_NT XSETINT (Vtty_erase_char, tty.main.sg_erase); tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS); @@ -1448,7 +1315,6 @@ init_sys_modes (tty_out) tty.main.sg_flags |= ANYP; tty.main.sg_flags |= interrupt_input ? RAW : CBREAK; #endif /* not DOS_NT */ -#endif /* not VMS (BSD, that is) */ #endif /* not HAVE_TERMIO */ /* If going to use CBREAK mode, we must request C-g to interrupt @@ -1479,7 +1345,7 @@ init_sys_modes (tty_out) #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ if (!tty_out->term_initted) internal_terminal_init (); - dos_ttraw (); + dos_ttraw (tty_out); #endif EMACS_SET_TTY (fileno (tty_out->input), &tty, 0); @@ -1500,14 +1366,6 @@ init_sys_modes (tty_out) #endif #endif -#ifdef VMS -/* Appears to do nothing when in PASTHRU mode. - SYS$QIOW (0, fileno (tty_out->input), IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0, - interrupt_signal, oob_chars, 0, 0, 0, 0); -*/ - queue_kbd_input (0); -#endif /* VMS */ - #ifdef F_SETFL #ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */ if (interrupt_input) @@ -1529,9 +1387,6 @@ init_sys_modes (tty_out) #endif /* F_GETOWN */ #endif /* F_SETFL */ -#ifdef VMS /* VMS sometimes has this symbol but lacks setvbuf. */ -#undef _IOFBF -#endif #ifdef _IOFBF /* This symbol is defined on recent USG systems. Someone says without this call USG won't really buffer the file @@ -1568,7 +1423,8 @@ init_sys_modes (tty_out) frame_garbaged = 1; FOR_EACH_FRAME (tail, frame) { - if (FRAME_TERMCAP_P (XFRAME (frame)) + if ((FRAME_TERMCAP_P (XFRAME (frame)) + || FRAME_MSDOS_P (XFRAME (frame))) && FRAME_TTY (XFRAME (frame)) == tty_out) FRAME_GARBAGED_P (XFRAME (frame)) = 1; } @@ -1624,22 +1480,6 @@ get_tty_size (int fd, int *widthp, int *heightp) *heightp = size.ts_lines; } -#else -#ifdef VMS - - /* Use a fresh channel since the current one may have stale info - (for example, from prior to a suspend); and to avoid a dependency - in the init sequence. */ - int chan; - struct sensemode tty; - - SYS$ASSIGN (&input_dsc, &chan, 0, 0); - SYS$QIOW (0, chan, IO$_SENSEMODE, &tty, 0, 0, - &tty.class, 12, 0, 0, 0, 0); - SYS$DASSGN (chan); - *widthp = tty.scr_wid; - *heightp = tty.scr_len; - #else #ifdef MSDOS *widthp = ScreenCols (); @@ -1648,7 +1488,6 @@ get_tty_size (int fd, int *widthp, int *heightp) *widthp = 0; *heightp = 0; #endif -#endif /* not VMS */ #endif /* not SunOS-style */ #endif /* not BSD-style */ } @@ -1822,270 +1661,7 @@ setup_pty (fd) } #endif /* HAVE_PTYS */ -#ifdef VMS - -/* Assigning an input channel is done at the start of Emacs execution. - This is called each time Emacs is resumed, also, but does nothing - because input_chain is no longer zero. */ - -void -init_vms_input () -{ - int status; - - if (fileno (CURTTY ()->input)) == 0) - { - status = SYS$ASSIGN (&input_dsc, &fileno (CURTTY ()->input)), 0, 0); - if (! (status & 1)) - LIB$STOP (status); - } -} - -/* Deassigning the input channel is done before exiting. */ - -void -stop_vms_input () -{ - return SYS$DASSGN (fileno (CURTTY ()->input))); -} - -short input_buffer; - -/* Request reading one character into the keyboard buffer. - This is done as soon as the buffer becomes empty. */ - -void -queue_kbd_input () -{ - int status; - extern kbd_input_ast (); - - waiting_for_ast = 0; - stop_input = 0; - status = SYS$QIO (0, fileno (CURTTY()->input), IO$_READVBLK, - &input_iosb, kbd_input_ast, 1, - &input_buffer, 1, 0, terminator_mask, 0, 0); -} - -int input_count; - -/* Ast routine that is called when keyboard input comes in - in accord with the SYS$QIO above. */ - -void -kbd_input_ast () -{ - register int c = -1; - int old_errno = errno; - extern EMACS_TIME *input_available_clear_time; - - if (waiting_for_ast) - SYS$SETEF (input_ef); - waiting_for_ast = 0; - input_count++; -#ifdef ASTDEBUG - if (input_count == 25) - exit (1); - printf ("Ast # %d,", input_count); - printf (" iosb = %x, %x, %x, %x", - input_iosb.offset, input_iosb.status, input_iosb.termlen, - input_iosb.term); -#endif - if (input_iosb.offset) - { - c = input_buffer; -#ifdef ASTDEBUG - printf (", char = 0%o", c); -#endif - } -#ifdef ASTDEBUG - printf ("\n"); - fflush (stdout); - sleep (1); -#endif - if (! stop_input) - queue_kbd_input (); - if (c >= 0) - { - struct input_event e; - EVENT_INIT (e); - - e.kind = ASCII_KEYSTROKE_EVENT; - XSETINT (e.code, c); - e.frame_or_window = selected_frame; - kbd_buffer_store_event (&e); - } - if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); - errno = old_errno; -} - -/* Wait until there is something in kbd_buffer. */ - -void -wait_for_kbd_input () -{ - extern int have_process_input, process_exited; - - /* If already something, avoid doing system calls. */ - if (detect_input_pending ()) - { - return; - } - /* Clear a flag, and tell ast routine above to set it. */ - SYS$CLREF (input_ef); - waiting_for_ast = 1; - /* Check for timing error: ast happened while we were doing that. */ - if (!detect_input_pending ()) - { - /* No timing error: wait for flag to be set. */ - set_waiting_for_input (0); - SYS$WFLOR (input_ef, input_eflist); - clear_waiting_for_input (); - if (!detect_input_pending ()) - /* Check for subprocess input availability */ - { - int dsp = have_process_input || process_exited; - - SYS$CLREF (process_ef); - if (have_process_input) - process_command_input (); - if (process_exited) - process_exit (); - if (dsp) - { - update_mode_lines++; - prepare_menu_bars (); - redisplay_preserve_echo_area (18); - } - } - } - waiting_for_ast = 0; -} - -/* Get rid of any pending QIO, when we are about to suspend - or when we want to throw away pending input. - We wait for a positive sign that the AST routine has run - and therefore there is no I/O request queued when we return. - SYS$SETAST is used to avoid a timing error. */ - -void -end_kbd_input () -{ -#ifdef ASTDEBUG - printf ("At end_kbd_input.\n"); - fflush (stdout); - sleep (1); -#endif - if (LIB$AST_IN_PROG ()) /* Don't wait if suspending from kbd_buffer_store_event! */ - { - SYS$CANCEL (fileno (CURTTY()->input)); - return; - } - - SYS$SETAST (0); - /* Clear a flag, and tell ast routine above to set it. */ - SYS$CLREF (input_ef); - waiting_for_ast = 1; - stop_input = 1; - SYS$CANCEL (fileno (CURTTY()->input)); - SYS$SETAST (1); - SYS$WAITFR (input_ef); - waiting_for_ast = 0; -} - -/* Wait for either input available or time interval expiry. */ - -void -input_wait_timeout (timeval) - int timeval; /* Time to wait, in seconds */ -{ - int time [2]; - static int zero = 0; - static int large = -10000000; - - LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */ - - /* If already something, avoid doing system calls. */ - if (detect_input_pending ()) - { - return; - } - /* Clear a flag, and tell ast routine above to set it. */ - SYS$CLREF (input_ef); - waiting_for_ast = 1; - /* Check for timing error: ast happened while we were doing that. */ - if (!detect_input_pending ()) - { - /* No timing error: wait for flag to be set. */ - SYS$CANTIM (1, 0); - if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */ - SYS$WFLOR (timer_ef, timer_eflist); /* Wait for timer expiry or input */ - } - waiting_for_ast = 0; -} - -/* The standard `sleep' routine works some other way - and it stops working if you have ever quit out of it. - This one continues to work. */ - -sys_sleep (timeval) - int timeval; -{ - int time [2]; - static int zero = 0; - static int large = -10000000; - - LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */ - - SYS$CANTIM (1, 0); - if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */ - SYS$WAITFR (timer_ef); /* Wait for timer expiry only */ -} - -void -init_sigio (fd) - int fd; -{ - request_sigio (); -} - -reset_sigio (fd) - int fd; -{ - unrequest_sigio (); -} - -void -request_sigio () -{ - if (noninteractive) - return; - croak ("request sigio"); -} - -void -unrequest_sigio () -{ - if (noninteractive) - return; - croak ("unrequest sigio"); -} - -#endif /* VMS */ - -/* Note that VMS compiler won't accept defined (CANNOT_DUMP). */ -#ifndef CANNOT_DUMP -#define NEED_STARTS -#endif - -#ifndef SYSTEM_MALLOC -#ifndef NEED_STARTS -#define NEED_STARTS -#endif -#endif - -#ifdef NEED_STARTS +#if !defined(CANNOT_DUMP) || !defined(SYSTEM_MALLOC) /* Some systems that cannot dump also cannot implement these. */ /* @@ -2167,12 +1743,10 @@ start_of_data () extern Lisp_Object Vsystem_name; -#ifndef VMS #ifdef HAVE_SOCKETS #include #include #endif /* HAVE_SOCKETS */ -#endif /* not VMS */ #ifdef TRY_AGAIN #ifndef HAVE_H_ERRNO @@ -2183,15 +1757,6 @@ extern int h_errno; void init_system_name () { -#ifdef VMS - char *sp, *end; - if ((sp = egetenv ("SYS$NODE")) == 0) - Vsystem_name = build_string ("vax-vms"); - else if ((end = index (sp, ':')) == 0) - Vsystem_name = build_string (sp); - else - Vsystem_name = make_string (sp, end - sp); -#else #ifndef HAVE_GETHOSTNAME struct utsname uts; uname (&uts); @@ -2307,7 +1872,6 @@ init_system_name () #endif /* HAVE_SOCKETS */ Vsystem_name = build_string (hostname); #endif /* HAVE_GETHOSTNAME */ -#endif /* VMS */ { unsigned char *p; for (p = SDATA (Vsystem_name); *p; p++) @@ -2317,7 +1881,6 @@ init_system_name () } #ifndef MSDOS -#ifndef VMS #if !defined (HAVE_SELECT) #include "sysselect.h" @@ -2557,7 +2120,6 @@ read_input_waiting () #endif #endif /* not HAVE_SELECT */ -#endif /* not VMS */ #endif /* not MSDOS */ /* POSIX signals support - DJB */ @@ -2573,7 +2135,8 @@ sys_signal (int signal_number, signal_handler_t action) struct sigaction new_action, old_action; sigemptyset (&new_action.sa_mask); new_action.sa_handler = action; -#if defined (SA_RESTART) && ! defined (BROKEN_SA_RESTART) && !defined(SYNC_INPUT) + new_action.sa_flags = 0; +#if defined (SA_RESTART) /* Emacs mostly works better with restartable system services. If this flag exists, we probably want to turn it on here. However, on some systems this resets the timeout of `select' @@ -2583,9 +2146,12 @@ sys_signal (int signal_number, signal_handler_t action) When SYNC_INPUT is set, we don't want SA_RESTART because we need to poll for pending input so we need long-running syscalls to be interrupted after a signal that sets the interrupt_input_pending flag. */ - new_action.sa_flags = SA_RESTART; -#else - new_action.sa_flags = 0; + /* Non-interactive keyboard input goes through stdio, where we always + want restartable system calls. */ +# if defined (BROKEN_SA_RESTART) || defined(SYNC_INPUT) + if (noninteractive) +# endif + new_action.sa_flags = SA_RESTART; #endif sigaction (signal_number, &new_action, &old_action); return (old_action.sa_handler); @@ -2888,112 +2454,6 @@ get_random () #endif /* need at least 2 */ return val & ((1L << VALBITS) - 1); } - -#ifdef VMS - -#ifdef getenv -/* If any place else asks for the TERM variable, - allow it to be overridden with the EMACS_TERM variable - before attempting to translate the logical name TERM. As a last - resort, ask for VAX C's special idea of the TERM variable. */ -#undef getenv -char * -sys_getenv (name) - char *name; -{ - register char *val; - static char buf[256]; - static struct dsc$descriptor_s equiv - = {sizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf}; - static struct dsc$descriptor_s d_name - = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; - short eqlen; - - if (!strcmp (name, "TERM")) - { - val = (char *) getenv ("EMACS_TERM"); - if (val) - return val; - } - - d_name.dsc$w_length = strlen (name); - d_name.dsc$a_pointer = name; - if (LIB$SYS_TRNLOG (&d_name, &eqlen, &equiv) == 1) - { - char *str = (char *) xmalloc (eqlen + 1); - bcopy (buf, str, eqlen); - str[eqlen] = '\0'; - /* This is a storage leak, but a pain to fix. With luck, - no one will ever notice. */ - return str; - } - return (char *) getenv (name); -} -#endif /* getenv */ - -#ifdef abort -/* Since VMS doesn't believe in core dumps, the only way to debug this beast is - to force a call on the debugger from within the image. */ -#undef abort -sys_abort () -{ - reset_all_sys_modes (); - LIB$SIGNAL (SS$_DEBUG); -} -#endif /* abort */ -#endif /* VMS */ - -#ifdef VMS -#ifdef LINK_CRTL_SHARE -#ifdef SHARABLE_LIB_BUG -/* Variables declared noshare and initialized in sharable libraries - cannot be shared. The VMS linker incorrectly forces you to use a private - version which is uninitialized... If not for this "feature", we - could use the C library definition of sys_nerr and sys_errlist. */ -int sys_nerr = 35; -char *sys_errlist[] = - { - "error 0", - "not owner", - "no such file or directory", - "no such process", - "interrupted system call", - "i/o error", - "no such device or address", - "argument list too long", - "exec format error", - "bad file number", - "no child process", - "no more processes", - "not enough memory", - "permission denied", - "bad address", - "block device required", - "mount devices busy", - "file exists", - "cross-device link", - "no such device", - "not a directory", - "is a directory", - "invalid argument", - "file table overflow", - "too many open files", - "not a typewriter", - "text file busy", - "file too big", - "no space left on device", - "illegal seek", - "read-only file system", - "too many links", - "broken pipe", - "math argument", - "result too large", - "I/O stream empty", - "vax/vms specific error code nontranslatable error" - }; -#endif /* SHARABLE_LIB_BUG */ -#endif /* LINK_CRTL_SHARE */ -#endif /* VMS */ #ifndef HAVE_STRERROR #ifndef WINDOWSNT @@ -3031,15 +2491,6 @@ emacs_close (fd) int did_retry = 0; register int rtnval; -#if defined (MAC_OSX) && defined (HAVE_CARBON) - { - extern int mac_try_close_socket P_ ((int)); - - if (mac_try_close_socket (fd)) - return 0; - } -#endif - while ((rtnval = close (fd)) == -1 && (errno == EINTR)) did_retry = 1; @@ -3088,10 +2539,7 @@ emacs_write (fildes, buf, nbyte) #ifdef SYNC_INPUT /* I originally used `QUIT' but that might causes files to be truncated if you hit C-g in the middle of it. --Stef */ - if (interrupt_input_pending) - handle_async_input (); - if (pending_atimers) - do_pending_atimers (); + process_pending_signals (); #endif continue; } @@ -3185,8 +2633,7 @@ rename (from, to) #endif -#ifdef HPUX -#ifndef HAVE_PERROR +#if defined(HPUX) && !defined(HAVE_PERROR) /* HPUX curses library references perror, but as far as we know it won't be called. Anyway this definition will do for now. */ @@ -3194,9 +2641,7 @@ rename (from, to) perror () { } - -#endif /* not HAVE_PERROR */ -#endif /* HPUX */ +#endif /* HPUX and not HAVE_PERROR */ #ifndef HAVE_DUP2 @@ -3237,7 +2682,6 @@ dup2 (oldd, newd) */ #ifdef subprocesses -#ifndef VMS #ifndef HAVE_GETTIMEOFDAY #ifdef HAVE_TIMEVAL @@ -3258,8 +2702,7 @@ gettimeofday (tp, tzp) #endif #endif -#endif -#endif /* subprocess && !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL && !VMS */ +#endif /* subprocess && !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL */ /* * This function will go away as soon as all the stubs fixed. (fnf) @@ -3282,11 +2725,10 @@ croak (badfunc) #include -#if defined (BROKEN_CLOSEDIR) || !defined (HAVE_CLOSEDIR) +#if !defined (HAVE_CLOSEDIR) int -closedir (dirp) - register DIR *dirp; /* stream from opendir */ +closedir (DIR *dirp /* stream from opendir */) { int rtnval; @@ -3295,160 +2737,16 @@ closedir (dirp) /* Some systems (like Solaris) allocate the buffer and the DIR all in one block. Why in the world are we freeing this ourselves anyway? */ -#if ! (defined (sun) && defined (USG5_4)) +#if ! defined (SOLARIS2) xfree ((char *) dirp->dd_buf); /* directory block defined in */ #endif xfree ((char *) dirp); return rtnval; } -#endif /* BROKEN_CLOSEDIR or not HAVE_CLOSEDIR */ +#endif /* not HAVE_CLOSEDIR */ #endif /* SYSV_SYSTEM_DIR */ -#ifdef NONSYSTEM_DIR_LIBRARY - -DIR * -opendir (filename) - char *filename; /* name of directory */ -{ - register DIR *dirp; /* -> malloc'ed storage */ - register int fd; /* file descriptor for read */ - struct stat sbuf; /* result of fstat */ - - fd = emacs_open (filename, O_RDONLY, 0); - if (fd < 0) - return 0; - - BLOCK_INPUT; - if (fstat (fd, &sbuf) < 0 - || (sbuf.st_mode & S_IFMT) != S_IFDIR - || (dirp = (DIR *) xmalloc (sizeof (DIR))) == 0) - { - emacs_close (fd); - UNBLOCK_INPUT; - return 0; /* bad luck today */ - } - UNBLOCK_INPUT; - - dirp->dd_fd = fd; - dirp->dd_loc = dirp->dd_size = 0; /* refill needed */ - - return dirp; -} - -void -closedir (dirp) - register DIR *dirp; /* stream from opendir */ -{ - emacs_close (dirp->dd_fd); - xfree ((char *) dirp); -} - - -#ifndef VMS -#define DIRSIZ 14 -struct olddir - { - ino_t od_ino; /* inode */ - char od_name[DIRSIZ]; /* filename */ - }; -#endif /* not VMS */ - -struct direct dir_static; /* simulated directory contents */ - -/* ARGUSED */ -struct direct * -readdir (dirp) - register DIR *dirp; /* stream from opendir */ -{ -#ifndef VMS - register struct olddir *dp; /* -> directory data */ -#else /* VMS */ - register struct dir$_name *dp; /* -> directory data */ - register struct dir$_version *dv; /* -> version data */ -#endif /* VMS */ - - for (; ;) - { - if (dirp->dd_loc >= dirp->dd_size) - dirp->dd_loc = dirp->dd_size = 0; - - if (dirp->dd_size == 0 /* refill buffer */ - && (dirp->dd_size = emacs_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) - return 0; - -#ifndef VMS - dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc]; - dirp->dd_loc += sizeof (struct olddir); - - if (dp->od_ino != 0) /* not deleted entry */ - { - dir_static.d_ino = dp->od_ino; - strncpy (dir_static.d_name, dp->od_name, DIRSIZ); - dir_static.d_name[DIRSIZ] = '\0'; - dir_static.d_namlen = strlen (dir_static.d_name); - dir_static.d_reclen = sizeof (struct direct) - - MAXNAMLEN + 3 - + dir_static.d_namlen - dir_static.d_namlen % 4; - return &dir_static; /* -> simulated structure */ - } -#else /* VMS */ - dp = (struct dir$_name *) dirp->dd_buf; - if (dirp->dd_loc == 0) - dirp->dd_loc = (dp->dir$b_namecount&1) ? dp->dir$b_namecount + 1 - : dp->dir$b_namecount; - dv = (struct dir$_version *)&dp->dir$t_name[dirp->dd_loc]; - dir_static.d_ino = dv->dir$w_fid_num; - dir_static.d_namlen = dp->dir$b_namecount; - dir_static.d_reclen = sizeof (struct direct) - - MAXNAMLEN + 3 - + dir_static.d_namlen - dir_static.d_namlen % 4; - strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount); - dir_static.d_name[dir_static.d_namlen] = '\0'; - dirp->dd_loc = dirp->dd_size; /* only one record at a time */ - return &dir_static; -#endif /* VMS */ - } -} - -#ifdef VMS -/* readdirver is just like readdir except it returns all versions of a file - as separate entries. */ - -/* ARGUSED */ -struct direct * -readdirver (dirp) - register DIR *dirp; /* stream from opendir */ -{ - register struct dir$_name *dp; /* -> directory data */ - register struct dir$_version *dv; /* -> version data */ - - if (dirp->dd_loc >= dirp->dd_size - sizeof (struct dir$_name)) - dirp->dd_loc = dirp->dd_size = 0; - - if (dirp->dd_size == 0 /* refill buffer */ - && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) - return 0; - - dp = (struct dir$_name *) dirp->dd_buf; - if (dirp->dd_loc == 0) - dirp->dd_loc = (dp->dir$b_namecount & 1) ? dp->dir$b_namecount + 1 - : dp->dir$b_namecount; - dv = (struct dir$_version *) &dp->dir$t_name[dirp->dd_loc]; - strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount); - sprintf (&dir_static.d_name[dp->dir$b_namecount], ";%d", dv->dir$w_version); - dir_static.d_namlen = strlen (dir_static.d_name); - dir_static.d_ino = dv->dir$w_fid_num; - dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 - + dir_static.d_namlen - dir_static.d_namlen % 4; - dirp->dd_loc = ((char *) (++dv) - dp->dir$t_name); - return &dir_static; -} - -#endif /* VMS */ - -#endif /* NONSYSTEM_DIR_LIBRARY */ - int set_file_times (filename, atime, mtime) @@ -3599,1291 +2897,25 @@ rmdir (dpath) } #endif /* !HAVE_RMDIR */ - -/* Functions for VMS */ -#ifdef VMS -#include -#include -#include +#ifndef BSTRING -/* Return as a string the VMS error string pertaining to STATUS. - Reuses the same static buffer each time it is called. */ +#ifndef bzero -char * -vmserrstr (status) - int status; /* VMS status code */ +void +bzero (b, length) + register char *b; + register int length; { - int bufadr[2]; - short len; - static char buf[257]; - - bufadr[0] = sizeof buf - 1; - bufadr[1] = (int) buf; - if (! (SYS$GETMSG (status, &len, bufadr, 0x1, 0) & 1)) - return "untranslatable VMS error status"; - buf[len] = '\0'; - return buf; + while (length-- > 0) + *b++ = 0; } -#ifdef access -#undef access - -/* The following is necessary because 'access' emulation by VMS C (2.0) does - * not work correctly. (It also doesn't work well in version 2.3.) - */ +#endif /* no bzero */ +#endif /* BSTRING */ -#ifdef VMS4_4 - -#define DESCRIPTOR(name,string) struct dsc$descriptor_s name = \ - { strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string } - -typedef union { - struct { - unsigned short s_buflen; - unsigned short s_code; - char *s_bufadr; - unsigned short *s_retlenadr; - } s; - int end; -} item; -#define buflen s.s_buflen -#define code s.s_code -#define bufadr s.s_bufadr -#define retlenadr s.s_retlenadr - -#define R_OK 4 /* test for read permission */ -#define W_OK 2 /* test for write permission */ -#define X_OK 1 /* test for execute (search) permission */ -#define F_OK 0 /* test for presence of file */ - -int -sys_access (path, mode) - char *path; - int mode; -{ - static char *user = NULL; - char dir_fn[512]; - - /* translate possible directory spec into .DIR file name, so brain-dead - * access can treat the directory like a file. */ - if (directory_file_name (path, dir_fn)) - path = dir_fn; - - if (mode == F_OK) - return access (path, mode); - if (user == NULL && (user = (char *) getenv ("USER")) == NULL) - return -1; - { - int stat; - int flags; - int acces; - unsigned short int dummy; - item itemlst[3]; - static int constant = ACL$C_FILE; - DESCRIPTOR (path_desc, path); - DESCRIPTOR (user_desc, user); - - flags = 0; - acces = 0; - if ((mode & X_OK) && ((stat = access (path, mode)) < 0 || mode == X_OK)) - return stat; - if (mode & R_OK) - acces |= CHP$M_READ; - if (mode & W_OK) - acces |= CHP$M_WRITE; - itemlst[0].buflen = sizeof (int); - itemlst[0].code = CHP$_FLAGS; - itemlst[0].bufadr = (char *) &flags; - itemlst[0].retlenadr = &dummy; - itemlst[1].buflen = sizeof (int); - itemlst[1].code = CHP$_ACCESS; - itemlst[1].bufadr = (char *) &acces; - itemlst[1].retlenadr = &dummy; - itemlst[2].end = CHP$_END; - stat = SYS$CHECK_ACCESS (&constant, &path_desc, &user_desc, itemlst); - return stat == SS$_NORMAL ? 0 : -1; - } -} - -#else /* not VMS4_4 */ - -#include -#define ACE$M_WRITE 2 -#define ACE$C_KEYID 1 - -static unsigned short memid, grpid; -static unsigned int uic; - -/* Called from init_sys_modes, so it happens not very often - but at least each time Emacs is loaded. */ -void -sys_access_reinit () -{ - uic = 0; -} - -int -sys_access (filename, type) - char * filename; - int type; -{ - struct FAB fab; - struct XABPRO xab; - int status, size, i, typecode, acl_controlled; - unsigned int *aclptr, *aclend, aclbuf[60]; - union prvdef prvmask; - - /* Get UIC and GRP values for protection checking. */ - if (uic == 0) - { - status = LIB$GETJPI (&JPI$_UIC, 0, 0, &uic, 0, 0); - if (! (status & 1)) - return -1; - memid = uic & 0xFFFF; - grpid = uic >> 16; - } - - if (type != 2) /* not checking write access */ - return access (filename, type); - - /* Check write protection. */ - -#define CHECKPRIV(bit) (prvmask.bit) -#define WRITABLE(field) (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE)) - - /* Find privilege bits */ - status = SYS$SETPRV (0, 0, 0, prvmask); - if (! (status & 1)) - error ("Unable to find privileges: %s", vmserrstr (status)); - if (CHECKPRIV (PRV$V_BYPASS)) - return 0; /* BYPASS enabled */ - fab = cc$rms_fab; - fab.fab$b_fac = FAB$M_GET; - fab.fab$l_fna = filename; - fab.fab$b_fns = strlen (filename); - fab.fab$l_xab = &xab; - xab = cc$rms_xabpro; - xab.xab$l_aclbuf = aclbuf; - xab.xab$w_aclsiz = sizeof (aclbuf); - status = SYS$OPEN (&fab, 0, 0); - if (! (status & 1)) - return -1; - SYS$CLOSE (&fab, 0, 0); - /* Check system access */ - if (CHECKPRIV (PRV$V_SYSPRV) && WRITABLE (XAB$V_SYS)) - return 0; - /* Check ACL entries, if any */ - acl_controlled = 0; - if (xab.xab$w_acllen > 0) - { - aclptr = aclbuf; - aclend = &aclbuf[xab.xab$w_acllen / 4]; - while (*aclptr && aclptr < aclend) - { - size = (*aclptr & 0xff) / 4; - typecode = (*aclptr >> 8) & 0xff; - if (typecode == ACE$C_KEYID) - for (i = size - 1; i > 1; i--) - if (aclptr[i] == uic) - { - acl_controlled = 1; - if (aclptr[1] & ACE$M_WRITE) - return 0; /* Write access through ACL */ - } - aclptr = &aclptr[size]; - } - if (acl_controlled) /* ACL specified, prohibits write access */ - return -1; - } - /* No ACL entries specified, check normal protection */ - if (WRITABLE (XAB$V_WLD)) /* World writable */ - return 0; - if (WRITABLE (XAB$V_GRP) && - (unsigned short) (xab.xab$l_uic >> 16) == grpid) - return 0; /* Group writable */ - if (WRITABLE (XAB$V_OWN) && - (xab.xab$l_uic & 0xFFFF) == memid) - return 0; /* Owner writable */ - - return -1; /* Not writable */ -} -#endif /* not VMS4_4 */ -#endif /* access */ - -static char vtbuf[NAM$C_MAXRSS+1]; - -/* translate a vms file spec to a unix path */ -char * -sys_translate_vms (vfile) - char * vfile; -{ - char * p; - char * targ; - - if (!vfile) - return 0; - - targ = vtbuf; - - /* leading device or logical name is a root directory */ - if (p = strchr (vfile, ':')) - { - *targ++ = '/'; - while (vfile < p) - *targ++ = *vfile++; - vfile++; - *targ++ = '/'; - } - p = vfile; - if (*p == '[' || *p == '<') - { - while (*++vfile != *p + 2) - switch (*vfile) - { - case '.': - if (vfile[-1] == *p) - *targ++ = '.'; - *targ++ = '/'; - break; - - case '-': - *targ++ = '.'; - *targ++ = '.'; - break; - - default: - *targ++ = *vfile; - break; - } - vfile++; - *targ++ = '/'; - } - while (*vfile) - *targ++ = *vfile++; - - return vtbuf; -} - -static char utbuf[NAM$C_MAXRSS+1]; - -/* translate a unix path to a VMS file spec */ -char * -sys_translate_unix (ufile) - char * ufile; -{ - int slash_seen = 0; - char *p; - char * targ; - - if (!ufile) - return 0; - - targ = utbuf; - - if (*ufile == '/') - { - ufile++; - } - - while (*ufile) - { - switch (*ufile) - { - case '/': - if (slash_seen) - if (index (&ufile[1], '/')) - *targ++ = '.'; - else - *targ++ = ']'; - else - { - *targ++ = ':'; - if (index (&ufile[1], '/')) - *targ++ = '['; - slash_seen = 1; - } - break; - - case '.': - if (strncmp (ufile, "./", 2) == 0) - { - if (!slash_seen) - { - *targ++ = '['; - slash_seen = 1; - } - ufile++; /* skip the dot */ - if (index (&ufile[1], '/')) - *targ++ = '.'; - else - *targ++ = ']'; - } - else if (strncmp (ufile, "../", 3) == 0) - { - if (!slash_seen) - { - *targ++ = '['; - slash_seen = 1; - } - *targ++ = '-'; - ufile += 2; /* skip the dots */ - if (index (&ufile[1], '/')) - *targ++ = '.'; - else - *targ++ = ']'; - } - else - *targ++ = *ufile; - break; - - default: - *targ++ = *ufile; - break; - } - ufile++; - } - *targ = '\0'; - - return utbuf; -} - -char * -getwd (pathname) - char *pathname; -{ - char *ptr, *val; - extern char *getcwd (); - -#define MAXPATHLEN 1024 - - ptr = xmalloc (MAXPATHLEN); - val = getcwd (ptr, MAXPATHLEN); - if (val == 0) - { - xfree (ptr); - return val; - } - strcpy (pathname, ptr); - xfree (ptr); - - return pathname; -} - -int -getppid () -{ - long item_code = JPI$_OWNER; - unsigned long parent_id; - int status; - - if (((status = LIB$GETJPI (&item_code, 0, 0, &parent_id)) & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - return parent_id; -} - -#undef getuid -unsigned -sys_getuid () -{ - return (getgid () << 16) | getuid (); -} - -#undef read -int -sys_read (fildes, buf, nbyte) - int fildes; - char *buf; - unsigned int nbyte; -{ - return read (fildes, buf, (nbyte < MAXIOSIZE ? nbyte : MAXIOSIZE)); -} - -/* - * VAX/VMS VAX C RTL really loses. It insists that records - * end with a newline (carriage return) character, and if they - * don't it adds one (nice of it isn't it!) - * - * Thus we do this stupidity below. - */ - -#undef write -int -sys_write (fildes, buf, nbytes) - int fildes; - char *buf; - unsigned int nbytes; -{ - register char *p; - register char *e; - int sum = 0; - struct stat st; - - fstat (fildes, &st); - p = buf; - while (nbytes > 0) - { - int len, retval; - - /* Handle fixed-length files with carriage control. */ - if (st.st_fab_rfm == FAB$C_FIX - && ((st.st_fab_rat & (FAB$M_FTN | FAB$M_CR)) != 0)) - { - len = st.st_fab_mrs; - retval = write (fildes, p, min (len, nbytes)); - if (retval != len) - return -1; - retval++; /* This skips the implied carriage control */ - } - else - { - e = p + min (MAXIOSIZE, nbytes) - 1; - while (*e != '\n' && e > p) e--; - if (p == e) /* Ok.. so here we add a newline... sigh. */ - e = p + min (MAXIOSIZE, nbytes) - 1; - len = e + 1 - p; - retval = write (fildes, p, len); - if (retval != len) - return -1; - } - p += retval; - sum += retval; - nbytes -= retval; - } - return sum; -} - -/* Create file NEW copying its attributes from file OLD. If - OLD is 0 or does not exist, create based on the value of - vms_stmlf_recfm. */ - -/* Protection value the file should ultimately have. - Set by create_copy_attrs, and use by rename_sansversions. */ -static unsigned short int fab_final_pro; - -int -creat_copy_attrs (old, new) - char *old, *new; -{ - struct FAB fab = cc$rms_fab; - struct XABPRO xabpro; - char aclbuf[256]; /* Choice of size is arbitrary. See below. */ - extern int vms_stmlf_recfm; - - if (old) - { - fab.fab$b_fac = FAB$M_GET; - fab.fab$l_fna = old; - fab.fab$b_fns = strlen (old); - fab.fab$l_xab = (char *) &xabpro; - xabpro = cc$rms_xabpro; - xabpro.xab$l_aclbuf = aclbuf; - xabpro.xab$w_aclsiz = sizeof aclbuf; - /* Call $OPEN to fill in the fab & xabpro fields. */ - if (SYS$OPEN (&fab, 0, 0) & 1) - { - SYS$CLOSE (&fab, 0, 0); - fab.fab$l_alq = 0; /* zero the allocation quantity */ - if (xabpro.xab$w_acllen > 0) - { - if (xabpro.xab$w_acllen > sizeof aclbuf) - /* If the acl buffer was too short, redo open with longer one. - Wouldn't need to do this if there were some system imposed - limit on the size of an ACL, but I can't find any such. */ - { - xabpro.xab$l_aclbuf = (char *) alloca (xabpro.xab$w_acllen); - xabpro.xab$w_aclsiz = xabpro.xab$w_acllen; - if (SYS$OPEN (&fab, 0, 0) & 1) - SYS$CLOSE (&fab, 0, 0); - else - old = 0; - } - } - else - xabpro.xab$l_aclbuf = 0; - } - else - old = 0; - } - fab.fab$l_fna = new; - fab.fab$b_fns = strlen (new); - if (!old) - { - fab.fab$l_xab = 0; - fab.fab$b_rfm = vms_stmlf_recfm ? FAB$C_STMLF : FAB$C_VAR; - fab.fab$b_rat = FAB$M_CR; - } - - /* Set the file protections such that we will be able to manipulate - this file. Once we are done writing and renaming it, we will set - the protections back. */ - if (old) - fab_final_pro = xabpro.xab$w_pro; - else - SYS$SETDFPROT (0, &fab_final_pro); - xabpro.xab$w_pro &= 0xff0f; /* set O:rewd for now. This is set back later. */ - - /* Create the new file with either default attrs or attrs copied - from old file. */ - if (!(SYS$CREATE (&fab, 0, 0) & 1)) - return -1; - SYS$CLOSE (&fab, 0, 0); - /* As this is a "replacement" for creat, return a file descriptor - opened for writing. */ - return open (new, O_WRONLY); -} - -#ifdef creat -#undef creat -#include -#ifdef __GNUC__ -#ifndef va_count -#define va_count(X) ((X) = *(((int *) &(va_alist)) - 1)) -#endif -#endif - -int -sys_creat (va_alist) - va_dcl -{ - va_list list_incrementer; - char *name; - int mode; - int rfd; /* related file descriptor */ - int fd; /* Our new file descriptor */ - int count; - struct stat st_buf; - char rfm[12]; - char rat[15]; - char mrs[13]; - char fsz[13]; - extern int vms_stmlf_recfm; - - va_count (count); - va_start (list_incrementer); - name = va_arg (list_incrementer, char *); - mode = va_arg (list_incrementer, int); - if (count > 2) - rfd = va_arg (list_incrementer, int); - va_end (list_incrementer); - if (count > 2) - { - /* Use information from the related file descriptor to set record - format of the newly created file. */ - fstat (rfd, &st_buf); - switch (st_buf.st_fab_rfm) - { - case FAB$C_FIX: - strcpy (rfm, "rfm = fix"); - sprintf (mrs, "mrs = %d", st_buf.st_fab_mrs); - strcpy (rat, "rat = "); - if (st_buf.st_fab_rat & FAB$M_CR) - strcat (rat, "cr"); - else if (st_buf.st_fab_rat & FAB$M_FTN) - strcat (rat, "ftn"); - else if (st_buf.st_fab_rat & FAB$M_PRN) - strcat (rat, "prn"); - if (st_buf.st_fab_rat & FAB$M_BLK) - if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) - strcat (rat, ", blk"); - else - strcat (rat, "blk"); - return creat (name, 0, rfm, rat, mrs); - - case FAB$C_VFC: - strcpy (rfm, "rfm = vfc"); - sprintf (fsz, "fsz = %d", st_buf.st_fab_fsz); - strcpy (rat, "rat = "); - if (st_buf.st_fab_rat & FAB$M_CR) - strcat (rat, "cr"); - else if (st_buf.st_fab_rat & FAB$M_FTN) - strcat (rat, "ftn"); - else if (st_buf.st_fab_rat & FAB$M_PRN) - strcat (rat, "prn"); - if (st_buf.st_fab_rat & FAB$M_BLK) - if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) - strcat (rat, ", blk"); - else - strcat (rat, "blk"); - return creat (name, 0, rfm, rat, fsz); - - case FAB$C_STM: - strcpy (rfm, "rfm = stm"); - break; - - case FAB$C_STMCR: - strcpy (rfm, "rfm = stmcr"); - break; - - case FAB$C_STMLF: - strcpy (rfm, "rfm = stmlf"); - break; - - case FAB$C_UDF: - strcpy (rfm, "rfm = udf"); - break; - - case FAB$C_VAR: - strcpy (rfm, "rfm = var"); - break; - } - strcpy (rat, "rat = "); - if (st_buf.st_fab_rat & FAB$M_CR) - strcat (rat, "cr"); - else if (st_buf.st_fab_rat & FAB$M_FTN) - strcat (rat, "ftn"); - else if (st_buf.st_fab_rat & FAB$M_PRN) - strcat (rat, "prn"); - if (st_buf.st_fab_rat & FAB$M_BLK) - if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) - strcat (rat, ", blk"); - else - strcat (rat, "blk"); - } - else - { - strcpy (rfm, vms_stmlf_recfm ? "rfm = stmlf" : "rfm=var"); - strcpy (rat, "rat=cr"); - } - /* Until the VAX C RTL fixes the many bugs with modes, always use - mode 0 to get the user's default protection. */ - fd = creat (name, 0, rfm, rat); - if (fd < 0 && errno == EEXIST) - { - if (unlink (name) < 0) - report_file_error ("delete", build_string (name)); - fd = creat (name, 0, rfm, rat); - } - return fd; -} -#endif /* creat */ - -/* fwrite to stdout is S L O W. Speed it up by using fputc...*/ -int -sys_fwrite (ptr, size, num, fp) - register char * ptr; - FILE * fp; -{ - register int tot = num * size; - - while (tot--) - fputc (*ptr++, fp); - return num; -} - -/* - * The VMS C library routine creat actually creates a new version of an - * existing file rather than truncating the old version. There are times - * when this is not the desired behavior, for instance, when writing an - * auto save file (you only want one version), or when you don't have - * write permission in the directory containing the file (but the file - * itself is writable). Hence this routine, which is equivalent to - * "close (creat (fn, 0));" on Unix if fn already exists. - */ -int -vms_truncate (fn) - char *fn; -{ - struct FAB xfab = cc$rms_fab; - struct RAB xrab = cc$rms_rab; - int status; - - xfab.fab$l_fop = FAB$M_TEF; /* free allocated but unused blocks on close */ - xfab.fab$b_fac = FAB$M_TRN | FAB$M_GET; /* allow truncate and get access */ - xfab.fab$b_shr = FAB$M_NIL; /* allow no sharing - file must be locked */ - xfab.fab$l_fna = fn; - xfab.fab$b_fns = strlen (fn); - xfab.fab$l_dna = ";0"; /* default to latest version of the file */ - xfab.fab$b_dns = 2; - xrab.rab$l_fab = &xfab; - - /* This gibberish opens the file, positions to the first record, and - deletes all records from there until the end of file. */ - if ((SYS$OPEN (&xfab) & 01) == 01) - { - if ((SYS$CONNECT (&xrab) & 01) == 01 && - (SYS$FIND (&xrab) & 01) == 01 && - (SYS$TRUNCATE (&xrab) & 01) == 01) - status = 0; - else - status = -1; - } - else - status = -1; - SYS$CLOSE (&xfab); - return status; -} - -/* Define this symbol to actually read SYSUAF.DAT. This requires either - SYSPRV or a readable SYSUAF.DAT. */ - -#ifdef READ_SYSUAF -/* - * getuaf.c - * - * Routine to read the VMS User Authorization File and return - * a specific user's record. - */ - -static struct UAF retuaf; - -struct UAF * -get_uaf_name (uname) - char * uname; -{ - register status; - struct FAB uaf_fab; - struct RAB uaf_rab; - - uaf_fab = cc$rms_fab; - uaf_rab = cc$rms_rab; - /* initialize fab fields */ - uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; - uaf_fab.fab$b_fns = 21; - uaf_fab.fab$b_fac = FAB$M_GET; - uaf_fab.fab$b_org = FAB$C_IDX; - uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; - /* initialize rab fields */ - uaf_rab.rab$l_fab = &uaf_fab; - /* open the User Authorization File */ - status = SYS$OPEN (&uaf_fab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - status = SYS$CONNECT (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - /* read the requested record - index is in uname */ - uaf_rab.rab$l_kbf = uname; - uaf_rab.rab$b_ksz = strlen (uname); - uaf_rab.rab$b_rac = RAB$C_KEY; - uaf_rab.rab$l_ubf = (char *)&retuaf; - uaf_rab.rab$w_usz = sizeof retuaf; - status = SYS$GET (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - /* close the User Authorization File */ - status = SYS$DISCONNECT (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - status = SYS$CLOSE (&uaf_fab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - return &retuaf; -} - -struct UAF * -get_uaf_uic (uic) - unsigned long uic; -{ - register status; - struct FAB uaf_fab; - struct RAB uaf_rab; - - uaf_fab = cc$rms_fab; - uaf_rab = cc$rms_rab; - /* initialize fab fields */ - uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; - uaf_fab.fab$b_fns = 21; - uaf_fab.fab$b_fac = FAB$M_GET; - uaf_fab.fab$b_org = FAB$C_IDX; - uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; - /* initialize rab fields */ - uaf_rab.rab$l_fab = &uaf_fab; - /* open the User Authorization File */ - status = SYS$OPEN (&uaf_fab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - status = SYS$CONNECT (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - /* read the requested record - index is in uic */ - uaf_rab.rab$b_krf = 1; /* 1st alternate key */ - uaf_rab.rab$l_kbf = (char *) &uic; - uaf_rab.rab$b_ksz = sizeof uic; - uaf_rab.rab$b_rac = RAB$C_KEY; - uaf_rab.rab$l_ubf = (char *)&retuaf; - uaf_rab.rab$w_usz = sizeof retuaf; - status = SYS$GET (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - /* close the User Authorization File */ - status = SYS$DISCONNECT (&uaf_rab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - status = SYS$CLOSE (&uaf_fab); - if (!(status&1)) - { - errno = EVMSERR; - vaxc$errno = status; - return 0; - } - return &retuaf; -} - -static struct passwd retpw; - -struct passwd * -cnv_uaf_pw (up) - struct UAF * up; -{ - char * ptr; - - /* copy these out first because if the username is 32 chars, the next - section will overwrite the first byte of the UIC */ - retpw.pw_uid = up->uaf$w_mem; - retpw.pw_gid = up->uaf$w_grp; - - /* I suppose this is not the best style, to possibly overwrite one - byte beyond the end of the field, but what the heck... */ - ptr = &up->uaf$t_username[UAF$S_USERNAME]; - while (ptr[-1] == ' ') - ptr--; - *ptr = '\0'; - strcpy (retpw.pw_name, up->uaf$t_username); - - /* the rest of these are counted ascii strings */ - strncpy (retpw.pw_gecos, &up->uaf$t_owner[1], up->uaf$t_owner[0]); - retpw.pw_gecos[up->uaf$t_owner[0]] = '\0'; - strncpy (retpw.pw_dir, &up->uaf$t_defdev[1], up->uaf$t_defdev[0]); - retpw.pw_dir[up->uaf$t_defdev[0]] = '\0'; - strncat (retpw.pw_dir, &up->uaf$t_defdir[1], up->uaf$t_defdir[0]); - retpw.pw_dir[up->uaf$t_defdev[0] + up->uaf$t_defdir[0]] = '\0'; - strncpy (retpw.pw_shell, &up->uaf$t_defcli[1], up->uaf$t_defcli[0]); - retpw.pw_shell[up->uaf$t_defcli[0]] = '\0'; - - return &retpw; -} -#else /* not READ_SYSUAF */ -static struct passwd retpw; -#endif /* not READ_SYSUAF */ - -struct passwd * -getpwnam (name) - char * name; -{ -#ifdef READ_SYSUAF - struct UAF *up; -#else - char * user; - char * dir; - unsigned char * full; -#endif /* READ_SYSUAF */ - char *ptr = name; - - while (*ptr) - { - if ('a' <= *ptr && *ptr <= 'z') - *ptr -= 040; - ptr++; - } -#ifdef READ_SYSUAF - if (!(up = get_uaf_name (name))) - return 0; - return cnv_uaf_pw (up); -#else - if (strcmp (name, getenv ("USER")) == 0) - { - retpw.pw_uid = getuid (); - retpw.pw_gid = getgid (); - strcpy (retpw.pw_name, name); - if (full = egetenv ("FULLNAME")) - strcpy (retpw.pw_gecos, full); - else - *retpw.pw_gecos = '\0'; - strcpy (retpw.pw_dir, egetenv ("HOME")); - *retpw.pw_shell = '\0'; - return &retpw; - } - else - return 0; -#endif /* not READ_SYSUAF */ -} - -struct passwd * -getpwuid (uid) - unsigned long uid; -{ -#ifdef READ_SYSUAF - struct UAF * up; - - if (!(up = get_uaf_uic (uid))) - return 0; - return cnv_uaf_pw (up); -#else - if (uid == sys_getuid ()) - return getpwnam (egetenv ("USER")); - else - return 0; -#endif /* not READ_SYSUAF */ -} - -/* return total address space available to the current process. This is - the sum of the current p0 size, p1 size and free page table entries - available. */ -int -vlimit () -{ - int item_code; - unsigned long free_pages; - unsigned long frep0va; - unsigned long frep1va; - register status; - - item_code = JPI$_FREPTECNT; - if (((status = LIB$GETJPI (&item_code, 0, 0, &free_pages)) & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - free_pages *= 512; - - item_code = JPI$_FREP0VA; - if (((status = LIB$GETJPI (&item_code, 0, 0, &frep0va)) & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - item_code = JPI$_FREP1VA; - if (((status = LIB$GETJPI (&item_code, 0, 0, &frep1va)) & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - - return free_pages + frep0va + (0x7fffffff - frep1va); -} - -int -define_logical_name (varname, string) - char *varname; - char *string; -{ - struct dsc$descriptor_s strdsc = - {strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string}; - struct dsc$descriptor_s envdsc = - {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; - struct dsc$descriptor_s lnmdsc = - {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; - - return LIB$SET_LOGICAL (&envdsc, &strdsc, &lnmdsc, 0, 0); -} - -int -delete_logical_name (varname) - char *varname; -{ - struct dsc$descriptor_s envdsc = - {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; - struct dsc$descriptor_s lnmdsc = - {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; - - return LIB$DELETE_LOGICAL (&envdsc, &lnmdsc); -} - -int -ulimit () -{ - return 0; -} - -int -setpgrp () -{ - return 0; -} - -int -execvp () -{ - error ("execvp system call not implemented"); - return -1; -} - -int -rename (from, to) - char *from, *to; -{ - int status; - struct FAB from_fab = cc$rms_fab, to_fab = cc$rms_fab; - struct NAM from_nam = cc$rms_nam, to_nam = cc$rms_nam; - char from_esn[NAM$C_MAXRSS]; - char to_esn[NAM$C_MAXRSS]; - - from_fab.fab$l_fna = from; - from_fab.fab$b_fns = strlen (from); - from_fab.fab$l_nam = &from_nam; - from_fab.fab$l_fop = FAB$M_NAM; - - from_nam.nam$l_esa = from_esn; - from_nam.nam$b_ess = sizeof from_esn; - - to_fab.fab$l_fna = to; - to_fab.fab$b_fns = strlen (to); - to_fab.fab$l_nam = &to_nam; - to_fab.fab$l_fop = FAB$M_NAM; - - to_nam.nam$l_esa = to_esn; - to_nam.nam$b_ess = sizeof to_esn; - - status = SYS$RENAME (&from_fab, 0, 0, &to_fab); - - if (status & 1) - return 0; - else - { - if (status == RMS$_DEV) - errno = EXDEV; - else - errno = EVMSERR; - vaxc$errno = status; - return -1; - } -} - -/* This function renames a file like `rename', but it strips - the version number from the "to" filename, such that the "to" file is - will always be a new version. It also sets the file protection once it is - finished. The protection that we will use is stored in fab_final_pro, - and was set when we did a creat_copy_attrs to create the file that we - are renaming. - - We could use the chmod function, but Eunichs uses 3 bits per user category - to describe the protection, and VMS uses 4 (write and delete are separate - bits). To maintain portability, the VMS implementation of `chmod' wires - the W and D bits together. */ - - -static struct fibdef fib; /* We need this initialized to zero */ -char vms_file_written[NAM$C_MAXRSS]; - -int -rename_sans_version (from,to) - char *from, *to; -{ - short int chan; - int stat; - short int iosb[4]; - int status; - struct FAB to_fab = cc$rms_fab; - struct NAM to_nam = cc$rms_nam; - struct dsc$descriptor fib_d ={sizeof (fib),0,0,(char*) &fib}; - struct dsc$descriptor fib_attr[2] - = {{sizeof (fab_final_pro),ATR$C_FPRO,0,(char*) &fab_final_pro},{0,0,0,0}}; - char to_esn[NAM$C_MAXRSS]; - - $DESCRIPTOR (disk,to_esn); - - to_fab.fab$l_fna = to; - to_fab.fab$b_fns = strlen (to); - to_fab.fab$l_nam = &to_nam; - to_fab.fab$l_fop = FAB$M_NAM; - - to_nam.nam$l_esa = to_esn; - to_nam.nam$b_ess = sizeof to_esn; - - status = SYS$PARSE (&to_fab, 0, 0); /* figure out the full file name */ - - if (to_nam.nam$l_fnb && NAM$M_EXP_VER) - *(to_nam.nam$l_ver) = '\0'; - - stat = rename (from, to_esn); - if (stat < 0) - return stat; - - strcpy (vms_file_written, to_esn); - - to_fab.fab$l_fna = vms_file_written; /* this points to the versionless name */ - to_fab.fab$b_fns = strlen (vms_file_written); - - /* Now set the file protection to the correct value */ - SYS$OPEN (&to_fab, 0, 0); /* This fills in the nam$w_fid fields */ - - /* Copy these fields into the fib */ - fib.fib$r_fid_overlay.fib$w_fid[0] = to_nam.nam$w_fid[0]; - fib.fib$r_fid_overlay.fib$w_fid[1] = to_nam.nam$w_fid[1]; - fib.fib$r_fid_overlay.fib$w_fid[2] = to_nam.nam$w_fid[2]; - - SYS$CLOSE (&to_fab, 0, 0); - - stat = SYS$ASSIGN (&disk, &chan, 0, 0); /* open a channel to the disk */ - if (!stat) - LIB$SIGNAL (stat); - stat = SYS$QIOW (0, chan, IO$_MODIFY, iosb, 0, 0, &fib_d, - 0, 0, 0, &fib_attr, 0); - if (!stat) - LIB$SIGNAL (stat); - stat = SYS$DASSGN (chan); - if (!stat) - LIB$SIGNAL (stat); - strcpy (vms_file_written, to_esn); /* We will write this to the terminal*/ - return 0; -} - -int -link (file, new) - char * file, * new; -{ - register status; - struct FAB fab; - struct NAM nam; - unsigned short fid[3]; - char esa[NAM$C_MAXRSS]; - - fab = cc$rms_fab; - fab.fab$l_fop = FAB$M_OFP; - fab.fab$l_fna = file; - fab.fab$b_fns = strlen (file); - fab.fab$l_nam = &nam; - - nam = cc$rms_nam; - nam.nam$l_esa = esa; - nam.nam$b_ess = NAM$C_MAXRSS; - - status = SYS$PARSE (&fab); - if ((status & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - status = SYS$SEARCH (&fab); - if ((status & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - - fid[0] = nam.nam$w_fid[0]; - fid[1] = nam.nam$w_fid[1]; - fid[2] = nam.nam$w_fid[2]; - - fab.fab$l_fna = new; - fab.fab$b_fns = strlen (new); - - status = SYS$PARSE (&fab); - if ((status & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - - nam.nam$w_fid[0] = fid[0]; - nam.nam$w_fid[1] = fid[1]; - nam.nam$w_fid[2] = fid[2]; - - nam.nam$l_esa = nam.nam$l_name; - nam.nam$b_esl = nam.nam$b_name + nam.nam$b_type + nam.nam$b_ver; - - status = SYS$ENTER (&fab); - if ((status & 1) == 0) - { - errno = EVMSERR; - vaxc$errno = status; - return -1; - } - - return 0; -} - -void -croak (badfunc) - char *badfunc; -{ - printf ("%s not yet implemented\r\n", badfunc); - reset_all_sys_modes (); - exit (1); -} - -long -random () -{ - /* Arrange to return a range centered on zero. */ - return rand () - (1 << 30); -} - -void -srandom (seed) -{ - srand (seed); -} -#endif /* VMS */ - -#ifndef BSTRING - -#ifndef bzero - -void -bzero (b, length) - register char *b; - register int length; -{ -#ifdef VMS - short zero = 0; - long max_str = 65535; - - while (length > max_str) { - (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b); - length -= max_str; - b += max_str; - } - max_str = length; - (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b); -#else - while (length-- > 0) - *b++ = 0; -#endif /* not VMS */ -} - -#endif /* no bzero */ -#endif /* BSTRING */ - -#if (!defined (BSTRING) && !defined (bcopy)) || defined (NEED_BCOPY) -#undef bcopy +#if (!defined (BSTRING) && !defined (bcopy)) || defined (NEED_BCOPY) +#undef bcopy /* Saying `void' requires a declaration, above, where bcopy is used and that declaration causes pain for systems where bcopy is a macro. */ @@ -4892,21 +2924,8 @@ bcopy (b1, b2, length) register char *b2; register int length; { -#ifdef VMS - long max_str = 65535; - - while (length > max_str) { - (void) LIB$MOVC3 (&max_str, b1, b2); - length -= max_str; - b1 += max_str; - b2 += max_str; - } - max_str = length; - (void) LIB$MOVC3 (&length, b1, b2); -#else while (length-- > 0) *b2++ = *b1++; -#endif /* not VMS */ } #endif /* (!defined (BSTRING) && !defined (bcopy)) || defined (NEED_BCOPY) */ @@ -4918,18 +2937,11 @@ bcmp (b1, b2, length) /* This could be a macro! */ register char *b2; register int length; { -#ifdef VMS - struct dsc$descriptor_s src1 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b1}; - struct dsc$descriptor_s src2 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b2}; - - return STR$COMPARE (&src1, &src2); -#else while (length-- > 0) if (*b1++ != *b2++) return 1; return 0; -#endif /* not VMS */ } #endif /* no bcmp */ #endif /* not BSTRING */ @@ -4943,12 +2955,8 @@ strsignal (code) if (0 <= code && code < NSIG) { -#ifdef VMS - signame = sys_errlist[code]; -#else /* Cast to suppress warning if the table has const char *. */ signame = (char *) sys_siglist[code]; -#endif } return signame; @@ -5031,7 +3039,7 @@ serial_configure (struct Lisp_Process *p, attr.c_cflag |= CLOCAL; #endif #if defined (CREAD) - attr.c_cflag | CREAD; + attr.c_cflag |= CREAD; #endif /* Configure speed. */ @@ -5171,6 +3179,598 @@ serial_configure (struct Lisp_Process *p, } #endif /* TERMIOS */ + +/* System depended enumeration of and access to system processes a-la ps(1). */ + +#ifdef HAVE_PROCFS + +/* Process enumeration and access via /proc. */ + +Lisp_Object +list_system_processes () +{ + Lisp_Object procdir, match, proclist, next; + struct gcpro gcpro1, gcpro2; + register Lisp_Object tail; + + GCPRO2 (procdir, match); + /* For every process on the system, there's a directory in the + "/proc" pseudo-directory whose name is the numeric ID of that + process. */ + procdir = build_string ("/proc"); + match = build_string ("[0-9]+"); + proclist = directory_files_internal (procdir, Qnil, match, Qt, 0, Qnil); + + /* `proclist' gives process IDs as strings. Destructively convert + each string into a number. */ + for (tail = proclist; CONSP (tail); tail = next) + { + next = XCDR (tail); + XSETCAR (tail, Fstring_to_number (XCAR (tail), Qnil)); + } + UNGCPRO; + + /* directory_files_internal returns the files in reverse order; undo + that. */ + proclist = Fnreverse (proclist); + return proclist; +} + +/* The WINDOWSNT implementation is on w32.c. + The MSDOS implementation is on dosfns.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) + +Lisp_Object +list_system_processes () +{ + return Qnil; +} + +#endif /* !defined (WINDOWSNT) */ + +#ifdef GNU_LINUX +static void +time_from_jiffies (unsigned long long tval, long hz, + time_t *sec, unsigned *usec) +{ + unsigned long long ullsec; + + *sec = tval / hz; + ullsec = *sec; + tval -= ullsec * hz; + /* Careful: if HZ > 1 million, then integer division by it yields zero. */ + if (hz <= 1000000) + *usec = tval * 1000000 / hz; + else + *usec = tval / (hz / 1000000); +} + +static Lisp_Object +ltime_from_jiffies (unsigned long long tval, long hz) +{ + time_t sec; + unsigned usec; + + time_from_jiffies (tval, hz, &sec, &usec); + + return list3 (make_number ((sec >> 16) & 0xffff), + make_number (sec & 0xffff), + make_number (usec)); +} + +static void +get_up_time (time_t *sec, unsigned *usec) +{ + FILE *fup; + + *sec = *usec = 0; + + BLOCK_INPUT; + fup = fopen ("/proc/uptime", "r"); + + if (fup) + { + double uptime, idletime; + + /* The numbers in /proc/uptime use C-locale decimal point, but + we already set ourselves to the C locale (see `fixup_locale' + in emacs.c). */ + if (2 <= fscanf (fup, "%lf %lf", &uptime, &idletime)) + { + *sec = uptime; + *usec = (uptime - *sec) * 1000000; + } + fclose (fup); + } + UNBLOCK_INPUT; +} + +#define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff) +#define MINOR(d) (((unsigned)(d) & 0xff) | (((unsigned)(d) & 0xfff00000) >> 12)) + +static Lisp_Object +procfs_ttyname (int rdev) +{ + FILE *fdev = NULL; + char name[PATH_MAX]; + + BLOCK_INPUT; + fdev = fopen ("/proc/tty/drivers", "r"); + + if (fdev) + { + unsigned major; + unsigned long minor_beg, minor_end; + char minor[25]; /* 2 32-bit numbers + dash */ + char *endp; + + while (!feof (fdev) && !ferror (fdev)) + { + if (3 <= fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) + && major == MAJOR (rdev)) + { + minor_beg = strtoul (minor, &endp, 0); + if (*endp == '\0') + minor_end = minor_beg; + else if (*endp == '-') + minor_end = strtoul (endp + 1, &endp, 0); + else + continue; + + if (MINOR (rdev) >= minor_beg && MINOR (rdev) <= minor_end) + { + sprintf (name + strlen (name), "%lu", MINOR (rdev)); + break; + } + } + } + fclose (fdev); + } + UNBLOCK_INPUT; + return build_string (name); +} + +static unsigned long +procfs_get_total_memory (void) +{ + FILE *fmem = NULL; + unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */ + + BLOCK_INPUT; + fmem = fopen ("/proc/meminfo", "r"); + + if (fmem) + { + unsigned long entry_value; + char entry_name[20]; /* the longest I saw is 13+1 */ + + while (!feof (fmem) && !ferror (fmem)) + { + if (2 <= fscanf (fmem, "%s %lu kB\n", entry_name, &entry_value) + && strcmp (entry_name, "MemTotal:") == 0) + { + retval = entry_value; + break; + } + } + fclose (fmem); + } + UNBLOCK_INPUT; + return retval; +} + +Lisp_Object +system_process_attributes (Lisp_Object pid) +{ + char procfn[PATH_MAX], fn[PATH_MAX]; + struct stat st; + struct passwd *pw; + struct group *gr; + long clocks_per_sec; + char *procfn_end; + char procbuf[1025], *p, *q; + int fd; + ssize_t nread; + const char *cmd = NULL; + char *cmdline = NULL; + size_t cmdsize = 0, cmdline_size; + unsigned char c; + int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount; + unsigned long long utime, stime, cutime, cstime, start; + long priority, nice, rss; + unsigned long minflt, majflt, cminflt, cmajflt, vsize; + time_t sec; + unsigned usec; + EMACS_TIME tnow, tstart, tboot, telapsed,ttotal; + double pcpu, pmem; + Lisp_Object attrs = Qnil; + Lisp_Object cmd_str, decoded_cmd, tem; + struct gcpro gcpro1, gcpro2; + EMACS_INT uid_eint, gid_eint; + + CHECK_NUMBER_OR_FLOAT (pid); + proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); + sprintf (procfn, "/proc/%lu", proc_id); + if (stat (procfn, &st) < 0) + return attrs; + + GCPRO2 (attrs, decoded_cmd); + + /* euid egid */ + uid = st.st_uid; + /* Use of EMACS_INT stops GCC whining about limited range of data type. */ + uid_eint = uid; + attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs); + BLOCK_INPUT; + pw = getpwuid (uid); + UNBLOCK_INPUT; + if (pw) + attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); + + gid = st.st_gid; + gid_eint = gid; + attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs); + BLOCK_INPUT; + gr = getgrgid (gid); + UNBLOCK_INPUT; + if (gr) + attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + + strcpy (fn, procfn); + procfn_end = fn + strlen (fn); + strcpy (procfn_end, "/stat"); + fd = emacs_open (fn, O_RDONLY, 0); + if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof(procbuf) - 1)) > 0) + { + procbuf[nread] = '\0'; + p = procbuf; + + p = strchr (p, '('); + if (p != NULL) + { + q = strrchr (p + 1, ')'); + /* comm */ + if (q != NULL) + { + cmd = p + 1; + cmdsize = q - cmd; + } + } + else + q = NULL; + if (cmd == NULL) + { + cmd = "???"; + cmdsize = 3; + } + /* Command name is encoded in locale-coding-system; decode it. */ + cmd_str = make_unibyte_string (cmd, cmdsize); + decoded_cmd = code_convert_string_norecord (cmd_str, + Vlocale_coding_system, 0); + attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); + + if (q) + { + EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint; + p = q + 2; + /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */ + sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld", + &c, &ppid, &pgrp, &sess, &tty, &tpgid, + &minflt, &cminflt, &majflt, &cmajflt, + &utime, &stime, &cutime, &cstime, + &priority, &nice, &thcount, &start, &vsize, &rss); + { + char state_str[2]; + + state_str[0] = c; + state_str[1] = '\0'; + tem = build_string (state_str); + attrs = Fcons (Fcons (Qstate, tem), attrs); + } + /* Stops GCC whining about limited range of data type. */ + ppid_eint = ppid; + pgrp_eint = pgrp; + sess_eint = sess; + tpgid_eint = tpgid; + thcount_eint = thcount; + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs); + attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); + attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs); + attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs); + attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs); + attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs); + attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs); + clocks_per_sec = sysconf (_SC_CLK_TCK); + if (clocks_per_sec < 0) + clocks_per_sec = 100; + attrs = Fcons (Fcons (Qutime, + ltime_from_jiffies (utime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qstime, + ltime_from_jiffies (stime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qtime, + ltime_from_jiffies (stime+utime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qcutime, + ltime_from_jiffies (cutime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qcstime, + ltime_from_jiffies (cstime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qctime, + ltime_from_jiffies (cstime+cutime, clocks_per_sec)), + attrs); + attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs); + attrs = Fcons (Fcons (Qnice, make_number (nice)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs); + EMACS_GET_TIME (tnow); + get_up_time (&sec, &usec); + EMACS_SET_SECS (telapsed, sec); + EMACS_SET_USECS (telapsed, usec); + EMACS_SUB_TIME (tboot, tnow, telapsed); + time_from_jiffies (start, clocks_per_sec, &sec, &usec); + EMACS_SET_SECS (tstart, sec); + EMACS_SET_USECS (tstart, usec); + EMACS_ADD_TIME (tstart, tboot, tstart); + attrs = Fcons (Fcons (Qstart, + list3 (make_number + ((EMACS_SECS (tstart) >> 16) & 0xffff), + make_number + (EMACS_SECS (tstart) & 0xffff), + make_number + (EMACS_USECS (tstart)))), + attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs); + EMACS_SUB_TIME (telapsed, tnow, tstart); + attrs = Fcons (Fcons (Qetime, + list3 (make_number + ((EMACS_SECS (telapsed) >> 16) & 0xffff), + make_number + (EMACS_SECS (telapsed) & 0xffff), + make_number + (EMACS_USECS (telapsed)))), + attrs); + time_from_jiffies (utime + stime, clocks_per_sec, &sec, &usec); + pcpu = (sec + usec / 1000000.0) / (EMACS_SECS (telapsed) + EMACS_USECS (telapsed) / 1000000.0); + if (pcpu > 1.0) + pcpu = 1.0; + attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs); + pmem = 4.0 * 100 * rss / procfs_get_total_memory (); + if (pmem > 100) + pmem = 100; + attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs); + } + } + if (fd >= 0) + emacs_close (fd); + + /* args */ + strcpy (procfn_end, "/cmdline"); + fd = emacs_open (fn, O_RDONLY, 0); + if (fd >= 0) + { + for (cmdline_size = 0; emacs_read (fd, &c, 1) == 1; cmdline_size++) + { + if (isspace (c) || c == '\\') + cmdline_size++; /* for later quoting, see below */ + } + if (cmdline_size) + { + cmdline = xmalloc (cmdline_size + 1); + lseek (fd, 0L, SEEK_SET); + cmdline[0] = '\0'; + if ((nread = read (fd, cmdline, cmdline_size)) >= 0) + cmdline[nread++] = '\0'; + else + { + /* Assigning zero to `nread' makes us skip the following + two loops, assign zero to cmdline_size, and enter the + following `if' clause that handles unknown command + lines. */ + nread = 0; + } + /* We don't want trailing null characters. */ + for (p = cmdline + nread - 1; p > cmdline && !*p; p--) + nread--; + for (p = cmdline; p < cmdline + nread; p++) + { + /* Escape-quote whitespace and backslashes. */ + if (isspace (*p) || *p == '\\') + { + memmove (p + 1, p, nread - (p - cmdline)); + nread++; + *p++ = '\\'; + } + else if (*p == '\0') + *p = ' '; + } + cmdline_size = nread; + } + if (!cmdline_size) + { + if (!cmd) + cmd = "???"; + if (!cmdsize) + cmdsize = strlen (cmd); + cmdline_size = cmdsize + 2; + cmdline = xmalloc (cmdline_size + 1); + strcpy (cmdline, "["); + strcat (strncat (cmdline, cmd, cmdsize), "]"); + } + emacs_close (fd); + /* Command line is encoded in locale-coding-system; decode it. */ + cmd_str = make_unibyte_string (cmdline, cmdline_size); + decoded_cmd = code_convert_string_norecord (cmd_str, + Vlocale_coding_system, 0); + xfree (cmdline); + attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); + } + + UNGCPRO; + return attrs; +} + +#elif defined (SOLARIS2) && defined (HAVE_PROCFS) + +/* The header does not like to be included if _LP64 is defined and + __FILE_OFFSET_BITS == 64. This is an ugly workaround that. */ +#if !defined (_LP64) && defined (_FILE_OFFSET_BITS) && (_FILE_OFFSET_BITS == 64) +#define PROCFS_FILE_OFFSET_BITS_HACK 1 +#undef _FILE_OFFSET_BITS +#else +#define PROCFS_FILE_OFFSET_BITS_HACK 0 +#endif + +#include + +#if PROCFS_FILE_OFFSET_BITS_HACK == 1 +#define _FILE_OFFSET_BITS 64 +#endif /* PROCFS_FILE_OFFSET_BITS_HACK == 1 */ + +Lisp_Object +system_process_attributes (Lisp_Object pid) +{ + char procfn[PATH_MAX], fn[PATH_MAX]; + struct stat st; + struct passwd *pw; + struct group *gr; + char *procfn_end; + struct psinfo pinfo; + int fd; + ssize_t nread; + int proc_id, uid, gid; + Lisp_Object attrs = Qnil; + Lisp_Object decoded_cmd, tem; + struct gcpro gcpro1, gcpro2; + EMACS_INT uid_eint, gid_eint; + + CHECK_NUMBER_OR_FLOAT (pid); + proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); + sprintf (procfn, "/proc/%u", proc_id); + if (stat (procfn, &st) < 0) + return attrs; + + GCPRO2 (attrs, decoded_cmd); + + /* euid egid */ + uid = st.st_uid; + /* Use of EMACS_INT stops GCC whining about limited range of data type. */ + uid_eint = uid; + attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs); + BLOCK_INPUT; + pw = getpwuid (uid); + UNBLOCK_INPUT; + if (pw) + attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); + + gid = st.st_gid; + gid_eint = gid; + attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs); + BLOCK_INPUT; + gr = getgrgid (gid); + UNBLOCK_INPUT; + if (gr) + attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + + strcpy (fn, procfn); + procfn_end = fn + strlen (fn); + strcpy (procfn_end, "/psinfo"); + fd = emacs_open (fn, O_RDONLY, 0); + if (fd >= 0 + && (nread = read (fd, (char*)&pinfo, sizeof(struct psinfo)) > 0)) + { + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); + + { + char state_str[2]; + state_str[0] = pinfo.pr_lwp.pr_sname; + state_str[1] = '\0'; + tem = build_string (state_str); + attrs = Fcons (Fcons (Qstate, tem), attrs); + } + + /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t, + need to get a string from it. */ + + /* FIXME: missing: Qtpgid */ + + /* FIXME: missing: + Qminflt + Qmajflt + Qcminflt + Qcmajflt + + Qutime + Qcutime + Qstime + Qcstime + Are they available? */ + + attrs = Fcons (Fcons (Qtime, + list3 (make_number (pinfo.pr_time.tv_sec >> 16), + make_number (pinfo.pr_time.tv_sec & 0xffff), + make_number (pinfo.pr_time.tv_nsec))), + attrs); + + attrs = Fcons (Fcons (Qctime, + list3 (make_number (pinfo.pr_ctime.tv_sec >> 16), + make_number (pinfo.pr_ctime.tv_sec & 0xffff), + make_number (pinfo.pr_ctime.tv_nsec))), + attrs); + + attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); + attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs); + + attrs = Fcons (Fcons (Qstart, + list3 (make_number (pinfo.pr_start.tv_sec >> 16), + make_number (pinfo.pr_start.tv_sec & 0xffff), + make_number (pinfo.pr_start.tv_nsec))), + attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs); + + /* pr_pctcpu and pr_pctmem are encoded as a fixed point 16 bit number in [0 ... 1]. */ + attrs = Fcons (Fcons (Qpcpu, (pinfo.pr_pctcpu * 100.0) / (double)0x8000), attrs); + attrs = Fcons (Fcons (Qpmem, (pinfo.pr_pctmem * 100.0) / (double)0x8000), attrs); + + decoded_cmd + = code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname, + strlen (pinfo.pr_fname)), + Vlocale_coding_system, 0); + attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); + decoded_cmd + = code_convert_string_norecord (make_unibyte_string (pinfo.pr_psargs, + strlen (pinfo.pr_psargs)), + Vlocale_coding_system, 0); + attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); + } + + if (fd >= 0) + emacs_close (fd); + + UNGCPRO; + return attrs; +} + +/* The WINDOWSNT implementation is on w32.c. + The MSDOS implementation is on dosfns.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) + +Lisp_Object +system_process_attributes (Lisp_Object pid) +{ + return Qnil; +} + +#endif /* !defined (WINDOWSNT) */ + /* arch-tag: edb43589-4e09-4544-b325-978b5b121dcf (do not change this comment) */