Mercurial > emacs
diff src/sysdep.c @ 97142:c3512b2085a0
* bitmaps/README:
* xfns.c:
* termcap.c:
* term.c:
* syswait.h:
* systty.h:
* systime.h:
* syssignal.h:
* sysdep.c:
* process.h:
* process.c:
* print.c:
* ndir.h:
* lread.c:
* keyboard.c:
* getpagesize.h:
* floatfns.c:
* fileio.c:
* emacs.c:
* doc.c:
* dispnew.c:
* dired.c:
* data.c:
* callproc.c:
* buffer.c:
* README:
* Makefile.in:
* s/template.h:
* s/msdos.h:
* m/vax.h: Remove VMS support.
* s/vms.h:
* vlimit.h:
* uaf.h:
* temacs.opt:
* param.h:
* ioctl.h: Remove file.
* descrip.mms:
* compile.com: Remove file.
* Create.c: Remove VMS support.
* message.el (Module):
* gnus-start.el (Module):
* gnus-registry.el (Module):
* textmodes/texinfmt.el:
* nxml/nxml-enc.el:
* mail/feedmail.el:
* international/mule.el:
* international/latexenc.el:
* emulation/viper-util.el:
* emulation/viper-init.el:
* emulation/viper-ex.el:
* emacs-lisp/bytecomp.el:
* version.el:
* subr.el:
* startup.el:
* sort.el:
* shadowfile.el:
* recentf.el:
* printing.el:
* paths.el:
* minibuffer.el:
* ls-lisp.el:
* loadup.el:
* hippie-exp.el:
* finder.el:
* files.el:
* ediff-util.el:
* ediff-ptch.el:
* ediff-init.el:
* ediff-diff.el:
* dired.el:
* dired-aux.el:
* cus-edit.el:
* bindings.el:
* arc-mode.el:
* add-log.el: Remove VMS support.
* obsolete/vmsproc.el:
* obsolete/vms-pmail.el:
* obsolete/vms-patch.el: Remove file.
* etags.c:
* emacsclient.c: Remove VMS support.
* termcap.src: Remove file.
* README:
* PROBLEMS:
* MACHINES: Remove VMS info.
* ediff.texi: Remove VMS support.
* os.texi:
* intro.texi:
* files.texi: Remove VMS support.
* emacs.texi: Remove VMS support.
* make-dist:
* README: Remove VMS support.
* vms: Remove directory.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Thu, 31 Jul 2008 05:33:56 +0000 |
| parents | 840bd675fd85 |
| children | d711e8ee1f6b |
line wrap: on
line diff
--- a/src/sysdep.c Thu Jul 31 02:47:32 2008 +0000 +++ b/src/sysdep.c Thu Jul 31 05:33:56 2008 +0000 @@ -90,32 +90,7 @@ #endif #endif -#ifdef VMS -#include <rms.h> -#include <ttdef.h> -#include <tt2def.h> -#include <iodef.h> -#include <ssdef.h> -#include <descrip.h> -#include <fibdef.h> -#include <atrdef.h> -#include <ctype.h> -#include <string.h> -#ifdef __GNUC__ #include <sys/file.h> -#else -#include <file.h> -#endif -#undef F_SETFL -#ifndef RAB$C_BID -#include <rab.h> -#endif -#define MAXIOSIZE (32 * PAGESIZE) /* Don't I/O more than 32 blocks at a time */ -#endif /* VMS */ - -#ifndef VMS -#include <sys/file.h> -#endif /* not VMS */ #ifdef HAVE_FCNTL_H #include <fcntl.h> @@ -159,10 +134,6 @@ 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 +268,6 @@ 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 +284,6 @@ } } #endif /* not MSDOS */ -#endif /* not VMS */ #endif /* not WINDOWSNT */ } @@ -357,20 +321,13 @@ #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 +338,7 @@ 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 +347,6 @@ emacs_ospeed = sg.sg_ospeed; #endif /* not HAVE_TERMIO */ #endif /* not HAVE_TERMIOS */ -#endif /* not VMS */ #endif /* not DOS_NT */ } @@ -443,12 +399,6 @@ 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 +453,6 @@ #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 +494,6 @@ #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 +591,6 @@ #endif /* not DOS_NT */ } -#endif /* not VMS */ #endif /* subprocesses */ @@ -662,47 +609,6 @@ 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 +630,6 @@ #endif /* no USG_JOBCTRL */ #endif /* no SIGTSTP */ -#endif /* not VMS */ } /* Fork a subshell. */ @@ -732,7 +637,6 @@ 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 +762,6 @@ #endif restore_signal_handlers (saved_handlers); synch_process_alive = 0; -#endif /* !VMS */ } static void @@ -1076,14 +979,6 @@ 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. */ if (ioctl (fd, TIOCGETP, &settings->main) < 0) @@ -1091,7 +986,6 @@ #endif /* not DOS_NT */ #endif #endif -#endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS @@ -1168,14 +1062,6 @@ 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. */ if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) @@ -1184,7 +1070,6 @@ #endif #endif -#endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS @@ -1253,25 +1138,6 @@ 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 @@ -1431,16 +1297,6 @@ 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 +1304,6 @@ 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 @@ -1500,14 +1355,6 @@ #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 +1376,6 @@ #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 @@ -1625,22 +1469,6 @@ } #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 (); *heightp = ScreenRows (); @@ -1648,7 +1476,6 @@ *widthp = 0; *heightp = 0; #endif -#endif /* not VMS */ #endif /* not SunOS-style */ #endif /* not BSD-style */ } @@ -1822,270 +1649,7 @@ } #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 +1731,10 @@ extern Lisp_Object Vsystem_name; -#ifndef VMS #ifdef HAVE_SOCKETS #include <sys/socket.h> #include <netdb.h> #endif /* HAVE_SOCKETS */ -#endif /* not VMS */ #ifdef TRY_AGAIN #ifndef HAVE_H_ERRNO @@ -2183,15 +1745,6 @@ 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 +1860,6 @@ #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 +1869,6 @@ } #ifndef MSDOS -#ifndef VMS #if !defined (HAVE_SELECT) #include "sysselect.h" @@ -2557,7 +2108,6 @@ #endif #endif /* not HAVE_SELECT */ -#endif /* not VMS */ #endif /* not MSDOS */ /* POSIX signals support - DJB */ @@ -2888,112 +2438,6 @@ #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 @@ -3225,7 +2669,6 @@ */ #ifdef subprocesses -#ifndef VMS #ifndef HAVE_GETTIMEOFDAY #ifdef HAVE_TIMEVAL @@ -3246,8 +2689,7 @@ #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) @@ -3292,150 +2734,6 @@ #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) @@ -3586,1259 +2884,6 @@ } #endif /* !HAVE_RMDIR */ - - -/* Functions for VMS */ -#ifdef VMS -#include <acldef.h> -#include <chpdef.h> -#include <jpidef.h> - -/* Return as a string the VMS error string pertaining to STATUS. - Reuses the same static buffer each time it is called. */ - -char * -vmserrstr (status) - int status; /* VMS status code */ -{ - 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; -} - -#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.) - */ - -#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 <prvdef.h> -#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 <varargs.h> -#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 @@ -4849,21 +2894,8 @@ 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 */ @@ -4879,21 +2911,8 @@ 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) */ @@ -4905,18 +2924,11 @@ 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 */ @@ -4930,12 +2942,8 @@ 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;