NetNews Usenet Archive 1992 #16

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / sources / 563 < prev next >

Wrap

Text File | 1992-07-29 | 37.6 KB | 1,399 lines

Newsgroups: gnu.emacs.sources Path: sparky!uunet!cis.ohio-state.edu!d0sb10.fnal.gov!SNYDER From: SNYDER@d0sb10.fnal.gov (scott snyder) Subject: better subprocess support for vms emacs (2/4) Message-ID: <920730000059.28a0007c@D0SB10.FNAL.GOV> Sender: daemon@cis.ohio-state.edu Organization: Source only Discussion and requests in gnu.emacs.help. Distribution: gnu Date: Wed, 29 Jul 1992 19:00:59 GMT Lines: 1387 -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X*************** X*** 2322,2327 **** X--- 2612,2620 ---- X write (XFASTINT (XPROCESS (proc)->outfd), buf, 0); X `7D X #else /* did not do TOICREMOTE */ X+ #ifdef VMS X+ send_process (proc, "\004", 1); X+ #else X if (!NULL (XPROCESS (proc)->pty_flag)) X send_process (proc, "\004", 1); X else X*************** X*** 2329,2334 **** X--- 2622,2628 ---- X close (XPROCESS (proc)->outfd); X XFASTINT (XPROCESS (proc)->outfd) = open ("/dev/null", O_WRONLY); X `7D X+ #endif /* not VMS */ X `20 X #endif /* did not do TOICREMOTE */ X return process; X*************** X*** 2357,2362 **** X--- 2651,2657 ---- X `7D X `7D X `0C X+ #ifndef VMS X /* On receipt of a signal that a child status has changed, X loop asking about children with changed statuses until X the system says there are no more. X*************** X*** 2498,2503 **** X--- 2793,2819 ---- X #endif /* USG, but not HPUX with WNOHANG */ X `7D X `7D X+`20 X+ #else /* VMS */ X+`20 X+ static void exit_ast (handle) X+ struct vms_process_handle *handle; X+ `7B X+ register struct Lisp_Process *p = handle->proc; X+ extern int process_ef; X+`20 X+ if (p != (struct Lisp_Process *) (-1)) X+ `7B X+ XFASTINT (p->raw_status_low) = handle->exit_status & 0xfff; X+ XFASTINT (p->raw_status_high) = handle->exit_status >> 16; X+ XSETINT (p->tick, ++process_tick); X+ FD_CLR (p->infd, &input_wait_mask); X+ `7D X+ handle->proc = 0; X+ sys$setef (process_ef); X+ `7D X+`20 X+ #endif /* VMS */ X `0C X /* Report all recent events of a change in process status X (either run the sentinel or output a message). X*************** X*** 2715,2720 **** X--- 3031,3040 ---- X defsubr (&Scontinue_process); X defsubr (&Sprocess_send_eof); X defsubr (&Swaiting_for_user_input_p); X+ #ifdef VMS X+ defsubr (&Sset_process_translation_mode); X+ defsubr (&Sprocess_translation_mode); X+ #endif X `7D X `20 X #endif /* subprocesses */ X*** process.h`09Tue Feb 25 11:59:19 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Dprocess.h`09Mon May 18 22:5 V1:52 1992 X*************** X*** 71,76 **** X--- 71,83 ---- X Lisp_Object tick; X /* Event-count of last such event reported. */ X Lisp_Object update_tick; X+ #ifdef VMS X+ /* VMS pids are 32 bits wide. store the upper 12 here. */ X+ Lisp_Object hipid; X+ /* should we massage `5EM's, `5EJ's, etc. going to and from processes X+ so as to make things look more like unix? */ X+ Lisp_Object translate_p; X+ #endif X `7D; X `20 X #define ChannelMask(n) (1<<(n)) X*** s-vms.h`09Tue Feb 25 11:59:23 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Ds-vms.h`09Mon May 18 22:51: V58 1992 X*************** X*** 70,76 **** X `20 X /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ X `20 X! /* #define HAVE_SOCKETS */ X `20 X /* X *`09Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate X--- 70,76 ---- X `20 X /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ X `20 X! #define HAVE_SOCKETS X `20 X /* X *`09Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate X*************** X*** 81,87 **** X `20 X /* Define this symbol if your system has the functions bcopy, etc. */ X `20 X! /* #define BSTRING */ X `20 X /* subprocesses should be defined if you want to X have code for asynchronous subprocesses X--- 81,89 ---- X `20 X /* Define this symbol if your system has the functions bcopy, etc. */ X `20 X! #ifdef HAVE_SOCKETS X! # define BSTRING X! #endif X `20 X /* subprocesses should be defined if you want to X have code for asynchronous subprocesses X*************** X*** 89,95 **** X This is generally OS dependent, and not supported X under most USG systems. */ X `20 X! /* #define subprocesses */ X `20 X /* If your system uses COFF (Common Object File Format) then define the X preprocessor symbol "COFF". */ X--- 91,97 ---- X This is generally OS dependent, and not supported X under most USG systems. */ X `20 X! #define subprocesses X `20 X /* If your system uses COFF (Common Object File Format) then define the X preprocessor symbol "COFF". */ X*************** X*** 159,164 **** X--- 161,169 ---- X #define rename sys_rename X #define execvp sys_execvp X #define system sys_system X+`20 X+ /* select() is in the multinet socket library */ X+ #define select sys_select X `20 X /* Hide these names so that we don't get linker errors */ X #define malloc sys_malloc X*** sysdep.c`09Tue Feb 25 11:59:25 1992 X--- `5Bscratch.snyder.gnu.emacs-18_58.src`5Dsysdep.c`09Wed Jun 24 06:42:38 1 V992 X*************** X*** 62,67 **** X--- 62,68 ---- X #endif X `20 X #ifdef VMS X+ #include <dcdef.h> X #include <rms.h> X #include <ttdef.h> X #include <tt2def.h> X*************** X*** 526,531 **** X--- 527,533 ---- X `7D X `20 X #ifdef subprocesses X+ #ifndef VMS X `20 X /* X *`09flush any pending output X*************** X*** 635,640 **** X--- 637,643 ---- X #endif /* RTU */ X `7D X `20 X+ #endif /* not VMS */ X #endif /* subprocesses */ X `20 X /*ARGSUSED*/ X*************** X*** 711,716 **** X--- 714,720 ---- X if (pid == 0) X `7B X char *sh; X+ extern char *egetenv(); X `20 X sh = (char *) egetenv ("SHELL"); X if (sh == 0) X*************** X*** 921,927 **** X input_eflist = ((unsigned) 1 << (input_ef % 32)) `7C X ((unsigned) 1 << (process_ef % 32)); X timer_eflist = ((unsigned) 1 << (input_ef % 32)) `7C X! ((unsigned) 1 << (timer_ef % 32)); X SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0, X `09 &old_gtty.class, 12, 0, 0, 0, 0); X #ifndef VMS4_4 X--- 925,932 ---- X input_eflist = ((unsigned) 1 << (input_ef % 32)) `7C X ((unsigned) 1 << (process_ef % 32)); X timer_eflist = ((unsigned) 1 << (input_ef % 32)) `7C X! ((unsigned) 1 << (timer_ef % 32)) `7C X! ((unsigned) 1 << (process_ef % 32)); X SYS$QIOW (0, input_chan, IO$_SENSEMODE, &old_gtty, 0, 0, X `09 &old_gtty.class, 12, 0, 0, 0, 0); X #ifndef VMS4_4 X*************** X*** 1399,1445 **** X errno = old_errno; X `7D X `20 X- /* Wait until there is something in kbd_buffer. */ X-`20 X- wait_for_kbd_input () X- `7B X- extern int have_process_input, process_exited; X-`20 X- /* If already something, avoid doing system calls. */ X- if (detect_input_pending ()) X- `7B X- return; X- `7D X- /* Clear a flag, and tell ast routine above to set it. */ X- SYS$CLREF (input_ef); X- waiting_for_ast = 1; X- /* Check for timing error: ast happened while we were doing that. */ X- if (!detect_input_pending ()) X- `7B X- /* No timing error: wait for flag to be set. */ X- set_waiting_for_input (0); X- SYS$WFLOR (input_ef, input_eflist); X- clear_waiting_for_input (0); X- if (!detect_input_pending ()) X- `09/* Check for subprocess input availability */ X- `09`7B X- `09 int dsp = have_process_input `7C`7C process_exited; X-`20 X- `09 sys$clref (process_ef); X- `09 if (have_process_input) X- `09 process_command_input (); X- `09 if (process_exited) X- `09 process_exit (); X- `09 if (dsp) X- `09 `7B X- `09 update_mode_lines++; X- `09 redisplay_preserve_echo_area (); X- `09 `7D X- `09`7D X- `7D X- waiting_for_ast = 0; X- `7D X-`20 X /* Get rid of any pending QIO, when we are about to suspend X or when we want to throw away pending input. X We wait for a positive sign that the AST routine has run X--- 1404,1409 ---- X*************** X*** 1686,1701 **** X static char system_name_saved`5B32`5D; X #ifdef VMS X char *sp; X if ((sp = egetenv ("SYS$NODE")) == 0) X sp = "vax-vms"; X- else X- `7B X- char *end; X `20 X! if ((end = index (sp, ':')) != 0) X! `09*end = '\0'; X! `7D X! strcpy (system_name_saved, sp); X #else /* not VMS */ X gethostname (system_name_saved, sizeof (system_name_saved)); X #endif /* not VMS */ X--- 1650,1672 ---- X static char system_name_saved`5B32`5D; X #ifdef VMS X char *sp; X+ extern char *egetenv (); X if ((sp = egetenv ("SYS$NODE")) == 0) X sp = "vax-vms"; X `20 X! /* vms likes to stick a leading underscore in front of the node X! name for some reason... */ X! if (*sp == '_') ++sp; X! system_name_saved `5Bsizeof (system_name_saved) - 1`5D = '\0'; X! strncpy (system_name_saved, sp, sizeof (system_name_saved) - 1); X!`20 X! /* now hack off any trailing `60::' */ X! `7B X! char *end; X! `20 X! if ((end = index (system_name_saved, ':')) != 0) X! *end = '\0'; X! `7D X #else /* not VMS */ X gethostname (system_name_saved, sizeof (system_name_saved)); X #endif /* not VMS */ X*************** X*** 1705,1710 **** X--- 1676,1682 ---- X `7D X `0C X #ifndef HAVE_SELECT X+ #ifndef VMS /* vms has its own select emulator */ X `20 X /* Emulate as much as select as is possible under 4.1 and needed by Gnu Em Vacs X * Only checks read descriptors. X*************** X*** 1893,1898 **** X--- 1865,1871 ---- X `7D X `7D X `20 X+ #endif /* not VMS */ X #endif /* not HAVE_SELECT */ X `0C X #ifdef BSD4_1 X*************** X*** 2187,2224 **** X before attempting to translate the logical name TERM. As a last X resort, ask for VAX C's special idea of the TERM variable. */ X #undef getenv X! char * X! sys_getenv (name) X! char *name; X! `7B X! register char *val; X! static char buf`5B256`5D; X! static struct dsc$descriptor_s equiv X! = `7Bsizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf`7D; X! static struct dsc$descriptor_s d_name X! = `7B0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0`7D; X! short eqlen; X `20 X if (!strcmp (name, "TERM")) X `7B X! val = (char *) getenv ("EMACS_TERM"); X! if (val) X! `09return val; X! `7D X!`20 X! d_name.dsc$w_length = strlen (name); X! d_name.dsc$a_pointer = name; X! if (lib$sys_trnlog (&d_name, &eqlen, &equiv) == 1) X! `7B X! char *str = (char *) xmalloc (eqlen + 1); X! bcopy (buf, str, eqlen); X! str`5Beqlen`5D = '\0'; X! /* This is a storage leak, but a pain to fix. With luck, X! `09 no one will ever notice. */ X! return str; X `7D X! return (char *) getenv (name); X `7D X #endif /* getenv */ X `20 X #ifdef abort X--- 2160,2271 ---- X before attempting to translate the logical name TERM. As a last X resort, ask for VAX C's special idea of the TERM variable. */ X #undef getenv X!`20 X! /* This variable is also reset in vmsmap.c. X! This is because it gets saved in the dump file. If we didn't do anythi Vng, X! genenv() would then return the environment in effect when emacs was dum Vped X! instead of the current environment. So we reset it to NULL after mappi Vng X! in a dump. */ X! char **my_environ = NULL; X!`20 X! /* The vax c getenv() can be a real pain to deal with. X! It is hard to avoid leaking memory when using it. X! In addition, it would occasionally accvio on me for no discernable reas Von. X! The main motivation behind this sys_getenv is to call vax c's getenv() X! as little as possible. */ X!`20 X! char *sys_getenv(char *name) X! `7B X! extern char **environ; X! extern char *getenv (); X! static int n_slots_allocated, n_slots_used; X! int namelen; X! char **s, *reslt; X! char resltbuf`5B257`5D; X!`20 X! if (my_environ == NULL) X! `7B X! my_environ = (char **) xmalloc (20 * sizeof (char *)); X! *my_environ = NULL; X! n_slots_allocated = 20; X! n_slots_used = 0; X! `7D X!`20 X! /* try to find the name in our private database */ X! namelen = strlen (name); X! for (s = my_environ; *s != NULL; ++s) X! if (! strncmp (name, *s, namelen) && (*s)`5Bnamelen`5D == '=') X! `7B X! `09if ((*s)`5Bnamelen+1`5D != '\0') X! `09 return *s + namelen + 1; X! `09else X! `09 return NULL; X! `7D X `20 X+ /* didn't find it - first try some standard synonyms... */ X+ reslt = NULL; X if (!strcmp (name, "TERM")) X `7B X! reslt = sys_getenv ("EMACS_TERM"); X! `7D X! else if (!strcmp (name, "HOME")) X! `7B X! reslt = sys_getenv ("SYS$LOGIN"); X! `7D X! else if (!strcmp (name, "TMP")) X! `7B X! reslt = sys_getenv ("SYS$SCRATCH"); X! `7D X!`20 X! /* no luck - try a logical name translation */ X! if (reslt == NULL) X! `7B X! struct dsc$descriptor_s name_dsc X! `09= `7Bnamelen, DSC$K_DTYPE_T, DSC$K_CLASS_S, name`7D; X! $DESCRIPTOR (reslt_dsc, resltbuf); X! short resltlen; X!`20 X! if (lib$sys_trnlog (&name_dsc, &resltlen, &reslt_dsc) == 1) X! `09`7B X! `09 reslt = resltbuf; X! `09 reslt`5Bresltlen`5D = '\0'; X! `09`7D X! `7D X!`20 X! /* look up special values of `60USER' and `60TERM' */ X! if (reslt == NULL && X! (!strcmp (name, "USER") `7C`7C !strcmp (name, "TERM")) && X! (int) environ >= 512) X! reslt = getenv (name); X!`20 X! /* store what we've found in our private database... */ X! `7B X! char *reslt1 = reslt; X! char *entry; X!`20 X! if (reslt1 == NULL) reslt1 = ""; X! entry = (char *) xmalloc (namelen + 1 + strlen (reslt1) + 1); X! strcpy (entry, name); X! entry`5Bnamelen`5D = '='; X! strcpy (entry+namelen+1, reslt1); X!`20 X! my_environ`5Bn_slots_used`5D = entry; X! ++n_slots_used; X!`20 X! if (reslt != NULL) reslt = entry + namelen + 1; X! `7D X!`20 X! if (n_slots_used == n_slots_allocated) X! `7B X! n_slots_allocated *= 2; X! my_environ = (char **) xrealloc (my_environ, X! `09`09`09`09 n_slots_allocated * sizeof (char *)); X `7D X! my_environ`5Bn_slots_used`5D = NULL; X!`20 X! return reslt; X `7D X+`20 X #endif /* getenv */ X `20 X #ifdef abort X*************** X*** 2854,2859 **** X--- 2901,2907 ---- X #include <acldef.h> X #include <chpdef.h> X #include <jpidef.h> X+ #include <dvidef.h> X `20 X /* Return as a string the VMS error string pertaining to STATUS. X Reuses the same static buffer each time it is called. */ X*************** X*** 2914,2919 **** X--- 2962,2968 ---- X `7B X static char *user = NULL; X char dir_fn`5B512`5D; X+ extern char *getenv(); X `20 X /* translate possible directory spec into .DIR file name, so brain-dead X * access() can treat the directory like a file. */ X*************** X*** 3250,3257 **** X char *pathname; X `7B X char *ptr; X- strcpy (pathname, egetenv ("PATH")); X `20 X ptr = pathname; X while (*ptr) X `7B X--- 3299,3306 ---- X char *pathname; X `7B X char *ptr; X `20 X+ getcwd(pathname, 1025, 1); X ptr = pathname; X while (*ptr) X `7B X*************** X*** 3815,3820 **** X--- 3864,3870 ---- X unsigned char * full; X #endif /* READ_SYSUAF */ X char *ptr = name; X+ extern char *egetenv(); X `20 X while (*ptr) X `7B X*************** X*** 4146,4151 **** X--- 4196,5022 ---- X `7B X srand (seed); X `7D X+`20 X+ /* support for unix-style asynchronous processes under VMS */ X+`20 X+ /* Subprocess I/O is done through `60pseudo-fd's, which can refer to X+ mailboxes, ptys, and network streams. They are created by vms_pipe, X+ vms_make_pty, and vms_net_chan. They are operated on by vms_read_fd, X+ vms_write_fd, and vms_close_fd. They also can be passed to our select X+ emulator. Pseudo-fd 0 always refers to the keyboard. X+`20 X+ When a pseudo-fd is created, a read qio is queued to the channel. X+ When it completes, a flag is set in the structure for that fd, along X+ with a local event flag. The select emulator watches that event flag X+ to know when to wake up. X+`20 X+ Some of this code was borrowed from the old vmsfns.c... X+`20 X+ - sss (snyder@d0gsc.fnal.gov) */ X+`20 X+`20 X+ #define MAXDESC 32 X+`20 X+ #define MSGSIZE 160 /* Maximum size for mailbox operatio Vns */ X+`20 X+ #ifdef HAVE_SOCKETS X+ #include "multinet_root:`5Bmultinet.include.vms`5Dinetiodef.h" X+ #include "multinet_root:`5Bmultinet.include.sys`5Dioctl.h" X+ #define NETBUFSIZ 1024 X+ #endif X+`20 X+ /* IO status block for mailbox operations. */ X+ struct mbx_iosb X+ `7B X+ short status; X+ short size; X+ int pid; X+ `7D; X+`20 X+`20 X+ /* define the structure of the buffers used for communicating with the pty X+ driver. each buffer is exactly one page long. */ X+`20 X+ #define PAGESIZE 512 X+ #define PTYBUF_SIZE (PAGESIZE - 2*sizeof(short)) X+ #define PTY_BUFFERS 2 X+ #define PTY_READBUF 0 X+`20 X+ struct ptybuf X+ `7B X+ short stat; X+ short len; X+ char buf`5BPTYBUF_SIZE`5D; X+ `7D; X+`20 X+`20 X+ /* describe the state of one pseudo-fd */ X+`20 X+ struct vms_pseudo_fd X+ `7B X+ /* true if this pfd has been allocated */ X+ int inuse : 1; X+`20 X+ /* true if there is input in the buffer */ X+ int input_avail : 1; X+`20 X+ /* true for pty and network pfds, respectively */ X+ int is_pty : 1; X+ int is_net : 1; X+`20 X+ /* the vms i/o channel */ X+ int chan; X+`20 X+ /* i/o buffers and iosb's */ X+ union X+ `7B X+ `09struct X+ `09 `7B X+ `09 int pty_lastlen`5BPTY_BUFFERS`5D; X+ `09 struct ptybuf *pty_buffers; X+ `09 `7D pty; X+`20 X+ `09struct X+ `09 `7B X+ `09 char *mbx_buffer; X+ `09 struct mbx_iosb iosb; X+ `09 `7D mbx; X+`20 X+ `09struct X+ `09 `7B X+ `09 char *net_buffer; X+ `09 struct mbx_iosb iosb; X+ `09 `7D net; X+ `7D a; X+ `7D; X+`20 X+ /* accessor macros */ X+`20 X+ #define PTY_STRUCT(fdp, i) (&((fdp)->a.pty.pty_buffers`5Bi`5D)) X+ #define PTY_BUF(fdp, i) (&((fdp)->a.pty.pty_buffers`5Bi`5D.buf`5B0`5D)) X+ #define PTY_LEN(fdp, i) ((fdp)->a.pty.pty_buffers`5Bi`5D.len) X+ #define PTY_STAT(fdp, i) ((fdp)->a.pty.pty_buffers`5Bi`5D.stat) X+ #define PTY_LASTLEN(fdp, i) ((fdp)->a.pty.pty_lastlen`5Bi`5D) X+`20 X+ #define MBX_BUF(fdp) ((fdp)->a.mbx.mbx_buffer) X+ #define MBX_IOSB(fdp) ((fdp)->a.mbx.iosb) X+`20 X+ #define NET_BUF(fdp) ((fdp)->a.net.net_buffer) X+ #define NET_IOSB(fdp) ((fdp)->a.net.iosb) X+`20 X+ /* the table of pds structs */ X+ static struct vms_pseudo_fd vms_fd_tab`5BMAXDESC`5D = `7B`7B1`7D,`7B1`7D,` V7B1`7D`7D; X+`20 X+ /* the select emulator for vms */ X+`20 X+ /* X+ * tests for input available on all channels given in the mask TEST_FDS. X+ * for all channels on which input is available, the corresponding bit is X+ * set in READY_FDS. the total number of ready channels is returned. X+ */ X+`20 X+ static int select_test (test_fds, ready_fds) X+ int test_fds, *ready_fds; X+ `7B X+ int fd; X+ int ravail = 0; X+`20 X+ *ready_fds = 0; X+`20 X+ /* pfd 0 always refers to the keyboard */ X+ if (test_fds & 1) X+ if (detect_input_pending ()) X+ `7B X+ `09*ready_fds `7C= 1; X+ `09++ravail; X+ `7D X+`20 X+ for (fd=3; fd<MAXDESC; fd++) X+ if ((test_fds & (1<<fd)) && vms_fd_tab`5Bfd`5D.input_avail) X+ `7B X+ `09*ready_fds `7C= (1<<fd); X+ `09++ravail; X+ `7D X+`20 X+ return ravail; X+ `7D X+`20 X+ /* Emulate as much as select as is possible under vms and needed by Gnu Em Vacs X+ * Only checks read descriptors. X+ */ X+`20 X+ /* Only rfds are checked. */ X+ /* note that select is #defined as sys_select to avoid conflicting with X+ the multinet socketlib */ X+ int X+ select (nfds, rfds, wfds, efds, timeout) X+ int nfds; X+ int *rfds, *wfds, *efds, *timeout; X+ `7B X+ int orfds = 0, ravail; X+ int timeoutval = timeout ? *timeout : 100000; X+ extern int process_tick, update_tick; X+ int time `5B2`5D; X+ int dum_10000000 = -10000000, dum_0 = 0; X+ `20 X+ /* Convert to VMS format */ X+ LIB$EMUL (&timeoutval, &dum_10000000, &dum_0, time); X+`20 X+ if (rfds) X+ `7B X+ orfds = *rfds; X+ *rfds = 0; X+ `7D X+ if (wfds) X+ *wfds = 0; X+ if (efds) X+ *efds = 0; X+`20 X+ if ((ravail = select_test (orfds, rfds)) != 0 `7C`7C timeoutval == 0) X+ return ravail; X+`20 X+ /* Clear a flag, and tell ast routine above to set it. */ X+ SYS$CLREF (input_ef); X+ waiting_for_ast = 1; X+ /* Check for timing error: ast happened while we were doing that. */ X+ if ((ravail = select_test (orfds, rfds)) == 0) X+ `7B X+ int timed_out = 0; X+`20 X+ /* No timing error: wait for flag to be set. */ X+ /* warning: the DEC C RTL uses timer 1 for alarm(). */ X+ SYS$CANTIM (2, 0); X+ if (SYS$SETIMR (timer_ef, time, 0, 2) & 1) /* Set timer */ X+ `09while (ravail == 0 && process_tick == update_tick && !timed_out) X+ `09 `7B X+ `09 int eflist; X+`20 X+ `09 /* Wait for timer expiry or input */ X+ `09 SYS$WFLOR (timer_ef, timer_eflist); X+ `09 sys$clref (process_ef); X+ `09 ravail = select_test (orfds, rfds); X+ `09 sys$readef (timer_ef, &eflist); X+ `09 timed_out = (eflist & ((unsigned) 1 << (timer_ef % 32))); X+ `09 `7D X+ `7D X+ waiting_for_ast = 0; X+ `20 X+ return ravail; X+ `7D X+`20 X+ /* the input AST function for pfd's. X+ set the input_avail flag in the pfd struct and set the local event X+ flag which the select emulator is waiting on. */ X+`20 X+ static void vms_input_ast (fdp) X+ struct vms_pseudo_fd *fdp; X+ `7B X+ fdp->input_avail = 1; X+ sys$setef (process_ef); X+ `7D X+`20 X+ /* start input on the pfd described by the indicated slot. */ X+ static void vms_start_input (fdp) X+ struct vms_pseudo_fd *fdp; X+ `7B X+ int status; X+`20 X+ if (fdp->is_pty) X+ `7B X+ #ifdef HAVE_VMS_PTYS X+ status = ptd$read (process_ef, fdp->chan, vms_input_ast, fdp, X+ `09`09`09 PTY_STRUCT (fdp, PTY_READBUF), PTYBUF_SIZE); X+ #endif X+ `7D X+ else if (fdp->is_net) X+ `7B X+ #ifdef HAVE_SOCKETS X+ status = sys$qio(process_ef, fdp->chan, IO$_RECEIVE, &NET_IOSB (fdp) V, X+ `09`09 vms_input_ast, fdp, NET_BUF (fdp), NETBUFSIZ, X+ `09`09 0, 0, 0, 0); X+ #endif X+ `7D X+ else X+ `7B X+ status = sys$qio(process_ef, fdp->chan, IO$_READVBLK, &MBX_IOSB (fdp V), X+ `09`09 vms_input_ast, fdp, MBX_BUF (fdp), MSGSIZE, X+ `09`09 0, 0, 0, 0); X+ `7D X+ if (! (status & 1)) X+ lib$signal (status); X+ `7D X+`20 X+`20 X+ /* functions for reading and writing pfds */ X+`20 X+ int vms_read_fd(fd, buf, len, translate) X+ int fd, len, translate; X+ char *buf; X+ `7B X+ struct vms_pseudo_fd *fdp = &vms_fd_tab`5Bfd`5D; X+ char *chars; X+ int nchars; X+`20 X+ if (!fdp->inuse) abort(); X+`20 X+ /* return now if there's nothing to read */ X+ if ( ! fdp->input_avail) X+ return 0; X+`20 X+ /* reading from net streams */ X+ if (fdp->is_net) X+ `7B X+ chars = NET_BUF (fdp); X+ nchars = NET_IOSB (fdp).size; X+ /* if nchars == 0 the connection has gone away? X+ `09 try returning 0 here so waiting_for_process_input will terminate X+ `09 the stream. */ X+ if (nchars == 0) return 0; X+ `7D X+`20 X+ /* reading from ptys */ X+ else if (fdp->is_pty) X+ `7B X+ char *p; X+`20 X+ chars = PTY_BUF (fdp, PTY_READBUF); X+ nchars = PTY_LEN (fdp, PTY_READBUF); X+`20 X+ /* remove carriage returns and NUL's if translation is on */ X+ if (translate) X+ `09for (p = chars; p < chars+nchars; p++) X+ `09 if (*p == '\r' `7C`7C *p == '\0') X+ `09 `7B X+ `09 --nchars; X+ `09 memcpy (p, p+1, nchars - (p-chars)); X+ `09 --p; X+ `09 `7D X+ `7D X+`20 X+ /* reading from mbxs */ X+ else X+ `7B X+ chars = MBX_BUF (fdp); X+ nchars = MBX_IOSB (fdp).size; X+`20 X+ /* Hack around VMS oddity of sending extraneous CR/LF characters for X+ * some of the commands (but not most). (if translation is on) X+ */ X+ if (translate) X+ `09`7B X+ `09 if (nchars > 0 && *chars == '\r') X+ `09 `7B X+ `09 chars++; X+ `09 nchars--; X+ `09 `7D X+ `09 if (nchars > 0 && chars`5Bnchars - 1`5D == '\n') X+ `09 nchars--; X+ `09 if (nchars > 0 && chars`5Bnchars - 1`5D == '\r') X+ `09 nchars--; X+ `20 X+ `09 /* add a newline onto the end */ X+ `09 chars`5Bnchars++`5D = '\n'; X+ `09`7D X+ `7D X+`20 X+ /* copy the data to the output buffer */ X+ if (nchars > len) nchars = len; X+ memcpy (buf, chars, nchars); X+`20 X+ /* queue another read to the channel */ X+ fdp->input_avail = 0; X+ vms_start_input (fdp); X+`20 X+ /* we can't just return 0; if we do, wait_reading_process_input() will X+ think that the process has died. so, do the following to fake it out V. */ X+ if (nchars == 0) X+ `7B X+ nchars = -1; X+ errno = EWOULDBLOCK; X+ `7D X+`20 X+ return nchars; X+ `7D X+`20 X+ #ifdef HAVE_VMS_PTYS X+`20 X+ static int vms_write_pty(fdp, buf, len, translate) X+ struct vms_pseudo_fd *fdp; X+ char *buf; X+ int len, translate; X+ `7B X+ int i, status; X+`20 X+ /* we can't write more than PTYBUF_SIZE characters at once... */ X+ if (len > PTYBUF_SIZE) X+ len = PTYBUF_SIZE; X+`20 X+ /* find a free buffer */ X+ for (i = 0; i < PTY_BUFFERS; i++) X+ if (i != PTY_READBUF && PTY_STAT (fdp, i) != 0) X+ break; X+`20 X+ /* if we couldn't find one, return an error status with X+ errno = EWOULDBLOCK */ X+ if (i >= PTY_BUFFERS) X+ `7B X+ errno = EWOULDBLOCK; X+ return -1; X+ `7D X+`20 X+ /* if the previous write resulted in a data overrun error, requeue that X+ write, and return an EWOULDBLOCK error. */ X+ if (PTY_STAT (fdp, i) == SS$_DATAOVERUN) X+ `7B X+ int j; X+`20 X+ /* the number of characters that the last request tried to write X+ `09 is in PTY_LASTLEN(fdp, i). the number of characters that were X+ `09 actually written is in PTY_LEN(fdp, i). */ X+`20 X+ len = PTY_LASTLEN (fdp, i) - PTY_LEN (fdp, i); X+ for (j=0; j<len; j++) X+ `09PTY_BUF (fdp, i)`5Bj`5D = PTY_BUF (fdp, i)`5Bj + PTY_LEN (fdp, i)`5D; X+ PTY_LASTLEN(fdp, i) = len; X+`20 X+ ptd$write (fdp->chan, 0, 0, PTY_STRUCT (fdp, i), len, 0, 0); X+ errno = EWOULDBLOCK; X+ return -1; X+ `7D X+`20 X+ /* copy the data to the pty buffer */ X+ memcpy (PTY_BUF (fdp, i), buf, len); X+`20 X+ if (translate) X+ `7B X+`20 X+ /* if the buffer consists of the single character `5ED, change it to V `5EZ. X+ `09 also translate NL's to CR's */ X+ if (len == 1 && PTY_BUF (fdp, i)`5B0`5D == '\004') X+ `09PTY_BUF (fdp, i)`5B0`5D = '\032'; X+ else X+ `09`7B X+ `09 char *p; X+ `09 for (p = PTY_BUF (fdp, i); p < PTY_BUF (fdp, i) + len; p++) X+ `09 if (*p == '\n') X+ `09 *p = '\r'; X+ `09`7D X+ `7D X+`20 X+`20 X+ /* que the write */ X+ PTY_LASTLEN (fdp, i) = len; X+ status = ptd$write (fdp->chan, 0, 0, PTY_STRUCT (fdp, i), len, 0, 0); X+ if (! (status & 1)) X+ return -1; X+`20 X+ return len; X+ `7D X+`20 X+ #endif X+`20 X+ static int vms_write_mbx(fdp, buf, len, translate) X+ struct vms_pseudo_fd *fdp; X+ char *buf; X+ int len, translate; X+ `7B X+ int status, oldrwm; X+ int xlen = len; X+`20 X+ /* turn off resource-wait mode to prevent blocking on a full mbx */ X+ oldrwm = sys$setrwm(1); X+`20 X+ /* as a special hack, if the buffer consists of the single character `5E VD, X+ write EOF to the mailbox. */ X+`20 X+ if (len == 1 && buf`5B0`5D == '\004' && translate) X+ status = sys$qiow (0, fdp->chan, IO$_WRITEOF `7C IO$M_NOW, X+ `09`09 0, 0, 0, buf, xlen, 0, 0, 0, 0); X+ else X+ `7B X+ /* strip trailing newlines if translation is on */ X+ if (xlen > 0 && buf`5Bxlen-1`5D == '\n' && translate) X+ `09--xlen; X+ status = sys$qiow (0, fdp->chan, IO$_WRITEVBLK `7C IO$M_NOW, X+ `09`09`09 0, 0, 0, buf, xlen, 0, 0, 0, 0); X+ `7D X+`20 X+ /* restore the previous state of resource-waiting */ X+ if (oldrwm == SS$_WASCLR) X+ sys$setrwm (0); X+`20 X+ if (! (status & 1)) X+ `7B X+ if (status = SS$_MBFULL) X+ `09errno = EWOULDBLOCK; X+ else X+ `09errno = EVMSERR; X+ `20 X+ return -1; X+ `7D X+`20 X+ return len; X+ `7D X+`20 X+ #ifdef HAVE_SOCKETS X+`20 X+ static int vms_write_net(fdp, buf, len) X+ struct vms_pseudo_fd *fdp; X+ char *buf; X+ int len; X+ `7B X+ extern int socket_errno; X+ int status; X+ int dum_0 = 0, dum_1 = 1; X+`20 X+ /* turn on nonblocking mode */ X+ if (socket_ioctl (fdp->chan, FIONBIO, &dum_1) != 0) X+ `7B X+ errno = socket_errno; X+ return -1; X+ `7D X+`20 X+ /* do the write */ X+ status = socket_write (fdp->chan, buf, len); X+ if (status == -1) errno = socket_errno; X+`20 X+ /* back to blocking mode so reads will work properly */ X+ if (socket_ioctl (fdp->chan, FIONBIO, &dum_0) != 0) X+ `7B X+ errno = socket_errno; X+ return -1; X+ `7D X+`20 X+ return status; X+ `7D X+`20 X+ #endif X+`20 X+ int vms_write_fd(fd, buf, len, translate) X+ int fd, len, translate; X+ char *buf; X+ `7B X+ struct vms_pseudo_fd *fdp = &vms_fd_tab`5Bfd`5D; X+`20 X+ if (!fdp->inuse) abort (); X+`20 X+ if (fdp->is_pty) X+ `7B X+ #ifdef HAVE_VMS_PTYS X+ /* it's a pty */ X+ return vms_write_pty (fdp, buf, len, translate); X+ #endif X+ `7D X+ else if (fdp->is_net) X+ `7B X+ #ifdef HAVE_SOCKETS X+ /* it's a socket */ X+ return vms_write_net (fdp, buf, len); X+ #endif X+ `7D X+ else X+ `7B X+ /* it's a mailbox */ X+ return vms_write_mbx (fdp, buf, len, translate); X+ `7D X+ `7D X+`20 X+ /* close a pfd and free its buffers */ X+`20 X+ void vms_close_fd (fd) X+ int fd; X+ `7B X+ int dum_PTY_BUFFERS = PTY_BUFFERS; X+ struct vms_pseudo_fd *fdp = &vms_fd_tab`5Bfd`5D; X+`20 X+ if ( ! fdp->inuse) abort (); X+`20 X+ if (fdp->is_pty) X+ `7B X+ #ifdef HAVE_VMS_PTYS X+ ptd$delete (fdp->chan); X+ lib$free_vm_page (&dum_PTY_BUFFERS, &fdp->a.pty.pty_buffers); X+ #endif X+ `7D X+ else if (fdp->is_net) X+ `7B X+ #ifdef HAVE_SOCKETS X+ socket_close (fdp->chan); X+ if (NET_BUF (fdp)) X+ `09`7B X+ `09 free (NET_BUF (fdp)); X+ `09 NET_BUF (fdp) = 0; X+ `09`7D X+ #endif X+ `7D X+ else X+ `7B X+ sys$dassgn (fdp->chan); X+ if (MBX_BUF (fdp)) X+ `09`7B X+ `09 free (MBX_BUF (fdp)); X+ `09 MBX_BUF (fdp) = 0; X+ `09`7D X+ `7D X+ fdp->inuse = 0; X+ fdp->input_avail = 0; X+ `7D X+`20 X+ /* functions for creating pfds */ X+`20 X+ /* Creates a temporary mailbox and returns the channel in CHAN. X+ * 'buffer_factor' is used to allow sending messages asynchronously X+ * till some point. X+ */ X+`20 X+ static int X+ create_mbx (chan, buffer_factor) X+ int *chan; X+ int buffer_factor; X+ `7B X+ int status; X+`20 X+ status = sys$crembx (0, chan, MSGSIZE, MSGSIZE * buffer_factor, 0, 0, 0) V; X+ if (! (status & 1)) X+ `7B X+ message ("Unable to create mailbox. Need TMPMBX privilege."); X+ return 0; X+ `7D X+ return 1; X+ `7D /* create_mbx */ X+`20 X+ void vms_get_device_name (fd, dsc) X+ int fd; X+ struct dsc$descriptor_s *dsc; X+ `7B X+ int status; X+ short retlen; X+ struct vms_pseudo_fd *fdp = &vms_fd_tab`5Bfd`5D; X+ int dum_DVI$_DEVNAM = DVI$_DEVNAM; X+`20 X+ if (!fdp->inuse) X+ abort(); X+`20 X+ status = lib$getdvi (&dum_DVI$_DEVNAM, &fdp->chan, 0, 0, dsc, X+ `09`09 &retlen); X+ if (! (status & 1)) X+ lib$signal (status); X+`20 X+ dsc->dsc$w_length = retlen; X+ `7D X+`20 X+ int vms_pipe (fds) X+ int fds`5B2`5D; X+ `7B X+ int i, j; X+ struct vms_pseudo_fd *fdp; X+`20 X+ /* search vms_fd_tab for two free pseudo-fds; store their indices in FDS V. */ X+ for (i=3, j=0; j<2 && i<MAXDESC; i++) X+ if ( ! vms_fd_tab`5Bi`5D.inuse) X+ fds`5Bj++`5D = i; X+`20 X+ /* return an error status if we didn't find two free slots */ X+ if (j<2) return -1; X+`20 X+ /* create the output mailbox */ X+ fdp = &vms_fd_tab`5Bfds`5B1`5D`5D; X+ fdp->inuse = 1; X+ fdp->is_pty = fdp->is_net = 0; X+ if (! create_mbx (&fdp->chan, 2)) X+ return -1; X+`20 X+ /* and the input mailbox */ X+ fdp = &vms_fd_tab`5Bfds`5B0`5D`5D; X+ fdp->inuse = 1; X+ fdp->is_pty = fdp->is_net = 0; X+ MBX_BUF (fdp) = (char *) xmalloc (MSGSIZE+1); X+ fdp->input_avail = 0; X+ if (! create_mbx (&fdp->chan, 1)) X+ return -1; X+ vms_start_input (fdp); X+`20 X+ /* done! */ X+ return 0; X+ `7D X+`20 X+ #ifdef HAVE_VMS_PTYS X+`20 X+ int vms_make_pty(fds) X+ int fds`5B2`5D; X+ `7B X+ int i, status; X+ struct vms_pseudo_fd *fdp; X+ struct ptybuf *addarr`5B2`5D; X+ struct X+ `7B X+ char class; X+ char type; X+ unsigned short scr_wid; X+ unsigned long tt_char : 24, scr_len : 8; X+ unsigned long tt2_char; X+ `7D term_mode; X+ int dum_PTY_BUFFERS = PTY_BUFFERS; X+ `20 X+ /* search vms_fd_tab for a free pseudo-fd; store its index in FDS. */ X+ for (i=3; i<MAXDESC; i++) X+ if (! vms_fd_tab`5Bi`5D.inuse) X+ `7B X+ `09fds`5B0`5D = fds`5B1`5D = i; X+ `09break; X+ `7D X+`20 X+ fdp = &vms_fd_tab`5Bfds`5B1`5D`5D; X+`20 X+ /* return an error status if we didn't find a free slot */ X+ if (i >= MAXDESC) X+ return -1; X+`20 X+ /* allocate some buffers for the pty */ X+ status = lib$get_vm_page (&dum_PTY_BUFFERS, &fdp->a.pty.pty_buffers); X+ if (! (status & 1)) X+ return -1; X+`20 X+ /* mark buffers as not busy */ X+ for (i=0; i<PTY_BUFFERS; i++) X+ PTY_STAT(fdp, i) = 1; X+`20 X+ #if 0 X+ /* get the current terminal characteristics */ X+ SYS$QIOW (0, input_chan, IO$_SENSEMODE, 0, 0, 0, X+ &term_mode, sizeof(term_mode), 0, 0, 0, 0); X+`20 X+ /* use those characteristics for the new pty, with the exception X+ of pasthru.. */ X+ term_mode.tt2_char &= `7ETT2$M_PASTHRU; X+ #endif X+ term_mode.class = DC$_TERM; X+ term_mode.type = TT$_UNKNOWN; X+ term_mode.scr_wid = 511; X+ term_mode.scr_len = 255; X+ term_mode.tt_char = TT$M_ESCAPE `7C TT$M_LOWER `7C TT$M_MECHFORM `7C TT$ VM_NOECHO; X+ term_mode.tt2_char = TT2$M_ALTYPEAHD; X+`20 X+ /* create the pty */ X+ addarr`5B0`5D = fdp->a.pty.pty_buffers; X+ addarr`5B1`5D = addarr`5B0`5D + PTY_BUFFERS; X+ status = ptd$create (&fdp->chan, 0, &term_mode, sizeof (term_mode), X+ `09`09 0, 0, 0, addarr); X+ if (! (status & 1)) X+ return -1; X+`20 X+ /* finish initializing and start the input */ X+ fdp->inuse = 1; X+ fdp->is_pty = 1; X+ fdp->is_net = 0; X+ fdp->input_avail = 0; X+ vms_start_input (fdp); X+`20 X+ return 0; X+ `7D X+`20 X+ #endif X+`20 X+ #ifdef HAVE_SOCKETS X+`20 X+ int vms_net_chan(vms_chan, fds) X+ int vms_chan; X+ int fds`5B2`5D; X+ `7B X+ int i; X+ struct vms_pseudo_fd *fdp; X+`20 X+ /* search vms_fd_tab for a free pseudo-fd; store its index in FDS. */ X+ for (i=3; i<MAXDESC; i++) X+ if (! vms_fd_tab`5Bi`5D.inuse) X+ `7B X+ `09fds`5B0`5D = fds`5B1`5D = i; X+ `09break; X+ `7D X+`20 X+ /* return an error status if we didn't find a free slot */ X+ if (i >= MAXDESC) X+ return -1; X+`20 X+ fdp = &vms_fd_tab`5Bfds`5B1`5D`5D; X+ fdp->inuse = 1; X+ fdp->is_pty = 0; X+ fdp->is_net = 1; X+ fdp->chan = vms_chan; X+`20 X+ NET_BUF (fdp) = (char *) xmalloc (NETBUFSIZ+1); X+ fdp->input_avail = 0; X+ vms_start_input (fdp); X+`20 X+ /* done! */ X+ return 0; X+ `7D X+`20 X+ #endif X+`20 X+`20 X+ /* emulate kill() for vms. X+ for SIGINT, do a $forcex on the target. X+ for SIGQUIT, SIGKILL, and SIGHUP, do a $delprc. */ X+`20 X+ kill(pid, signal) X+ int pid, signal; X+ `7B X+ if (pid < 0) pid = -pid; X+ `20 X+ switch (signal) X+ `7B X+ case SIGINT: X+ sys$forcex (&pid, 0, SS$_FORCEDEXIT); X+ break; X+ case SIGQUIT: X+ case SIGKILL: X+ case SIGHUP: X+ sys$delprc (&pid, 0); X+ break; X+ default: X+ croak ("unimplemented kill signal"); X+ `7D X+ `7D X+`20 X+ char *sys_siglist`5BNSIG + 1`5D = X+ `7B X+ "bogus signal", /* 0 */ X+ "hangup", /* 1 SIGHUP */ X+ "interrupt", /* 2 SIGINT */ X+ "quit", /* 3 SIGQUIT */ X+ "illegal instruction", /* 4 SIGILL */ X+ "trace trap", /* 5 SIGTRAP */ X+ "IOT instruction", /* 6 SIGIOT */ X+ "EMT instruction", /* 7 SIGEMT */ X+ "floating point exception", /* 8 SIGFPE */ X+ "kill", /* 9 SIGKILL */ X+ "bus error", /* 10 SIGBUS */ X+ "segmentation violation", /* 11 SIGSEGV */ X+ "bad argument to system call", /* 12 SIGSYS */ X+ "write on a pipe with no one to read it", /* 13 SIGPIPE */ X+ "alarm clock", /* 14 SIGALRM */ X+ "software termination signum", /* 15 SIGTERM */ X+ "bogus signal", /* 16 */ X+ #ifdef __GNUC__ X+ "bogus signal", /* 17 */ X+ "bogus signal", /* 18 */ X+ "bogus signal", /* 19 */ X+ "bogus signal", /* 20 */ X+ "bogus signal", /* 21 */ X+ "bogus signal", /* 22 */ X+ "bogus signal", /* 23 */ X+ "bogus signal", /* 24 */ X+ "bogus signal", /* 25 */ X+ "bogus signal", /* 26 */ X+ "bogus signal", /* 27 */ X+ "bogus signal", /* 28 */ X+ "bogus signal", /* 29 */ X+ "bogus signal", /* 30 */ X+ "bogus signal", /* 31 */ X+ #endif X+ 0 `7D; X+`20 X #endif /* VMS */ X `0C X #ifdef WRONG_NAME_INSQUE X*** temacs.opt`09Tue Feb 25 11:59:25 1992 X--- `5Bscratch.snyder.gnu.emacs-18_58.src`5Dtemacs.opt`09Thu Jul 2 17:36:01 +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-