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 / 562 < prev next >

Wrap

Text File | 1992-07-29 | 38.4 KB | 1,315 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 (1/4) Message-ID: <920730000040.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:40 GMT Lines: 1303 This is a set of patches for emacs 18.58 to get the unix subprocess functions (i.e., start-process and the stuff dealing with the Process type) working on VMS. It also includes support for pseudoterminals and network streams (using the Multinet TCP/IP package). This has been tested with both vax c and gcc. It should work on both VMS 5.4 and 5.5 (but see the warning in the readme about using pseudoterminals under 5.4). The network support requires Multinet, but it shouldn't be too hard to get it working with UCX (the call interface is supposed to be the same). enjoy... scott snyder snyder@d0gsc.fnal.gov $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-010 25-Jun-1992 $! On 29-JUL-1992 22:21:58.40 By user SNYDER $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 4 PARTS, TO KEEP EACH PART $! BELOW 80 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. VMS-CHANGES-README.;8 $! 2. SRC.DIFFS;2 $! 3. LISP.DIFFS;8 $! 4. S-VMS5-4.H;1 $! 5. DIRED.EL;10 $! 6. CALC.DIFFS;2 $! 7. GNUS.DIFFS;3 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ x = P1 - f$parse(P1,,,"version") $ y = f$search(x) $ if y .eqs. "" then $ goto file_absent $ x = f$integer(f$parse(P1,,,"version")-";") $ y = f$integer(f$parse(y,,,"version")-";") $ if x .gt. y then $ goto file_absent $ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive $ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped." $ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped." $file_delete: $ delete 'f'* $ exit $file_interactive: $ if x .eq. y then e "-W-EXISTS, File ''P1' exists." $ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists." $ read/error=file_delete/end=file_delete- /prompt="Create new version [y/n]: " - sys$command x $ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped." $ if .not. x then $ goto file_delete $ P1 = P1 - f$parse(P1,,,"version") $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X XThis kit contains patched to add unix-style subprocesses, Xpseudo-terminals, and network streams to VMS emacs. This file Xcontains a description of how to install it and a brief description of Xthe changes. X X X Installation. X X XI will assume that you are starting with a virgin 18.58 distribution. XYou should probably also review the contents of VMSBUILD. X X1. Unpack this shar file (if you haven't done so already) in some Xconvenient directory. Apply the patches in src.diffs to the src Xdirectory. Apply the patches in lisp.diffs to the lisp directory. XCopy the file s-vms5-4.h into the src directory, and copy the file Xdired.el into the lisp directory. X X2. If you presently have a working version of emacs, you'll probably Xwant to byte-compile the lisp files changed by the last step. They Xare: X X compile, dired, lpr, shell, telnet, vms-patch X XIf you don't happen to have a working emacs, you can just delete the Xexisting .elc files which correspond to these sources. You can then Xgo back later, byte-compile the files, and rebuild emacs. X X3. Set up emacs.com, config.h, and paths.h as described in VMSBUILD. XIf you want pseudoterminals, include s-vms5-4.h instead of s-vms4-4.h. X XWARNING: VMS 5.4-2 had a bug in the swapper which could cause the Xsystem to crash if a process with a pseudoterminal got swapped out. XThis bug appears to be fixed in VMS 5.5. I don't have any information Xon other versions. I have a workaround for the problem in 5.4 which Xconsists of a patch to the ptd$services image. Contact me if you're Xinterested... X X4. The network support in this version will only work with Multinet. XIf you are not running Multinet, disable it by commenting out the line X X#define HAVE_SOCKETS X Xfrom s-vms.h and by commenting out the line X Xmultinet:multinet_socket_library/share X Xfrom temacs.opt. X X5. Execute compile.com and link.com to build temacs.exe. X X6. Build the stuff in `5B-.etc`5D as described in VMSBUILD. You may also Xwant to compile wakeup at this point. X X7. Execute build.com to build temacs.dump. X X X X X Usage X X XThe subprocess functions should work much like they do on unix. XSome notes: X X* Both mailboxes and pseudoterminals are supported (provided you X included s-vms5-4.h when building). Which one is used depends on the X value of the variable process-connection-type. X X* Subprocesses are created with lib$spawn. The command line which is X used is formed in the following manner. The exec path is searched for X a file matching the supplied program name. If the program name did X not include an extension, the extensions `60.com' and `60.exe' are X searched for. The command string is formed from the result of the X search as follows: X X Found .com : `60@<full pathname>' X Found .exe : `60MCR <full pathname>' X No match : `60<program name>' X X Finally, the supplied arguments are concatenated together on the end X of the command string, separated by spaces. X X* Subprocess I/O is usually massaged to make things work more like X unix. This is controlled by the function X set-process-translation-mode: X X Xset-process-translation-mode: XSet the translation mode for PROCESS to MODE. XIf MODE is non-nil, the following translations are performed: X X Sending to PTY processes: X If the output string consists of the single character `5ED, it is X changed to a `5EZ.`20 X All newlines (`5EJ) are converted to carriage-returns (`5EM). X X Reading from PTY processes: X All carriage-returns (`5EM) and nuls (`5E@) are removed. X X Sending to MBX processes: X If the output string consists of the single character `5ED, an EOF X is written to the mailbox instead. X If the output string ends in a newline (`5EJ), the newline is removed. X X Reading from MBX processes: X If the string starts with a carriage return (`5EM) it is removed. X If the string ends with a CR/LF sequence (`5EM`5EJ), the sequence is X removed. X A newline (`5EJ) is added to the end of the string. X XThis function is unique to VMS. X X There is also the function process-translation-mode to retrieve the X current translation setting. X X X* Sending SIGINT to a subprocess is implemented by doing a $forcex on X it. Sending SIGQUIT, SIGKILL, or SIGHUP to a subprocess will kill it X with $delprc. X X X* I've rewritten sys_getenv() so that it uses getenv() as little as X possble. This was done both to reduce the dependencies on the current X environment (in particular, DCL symbols are no longer translated) and X because getenv() would occasionally crash on me for no apparent X reason. This has the side effect of plugging an ugly memory leak. X X X* With the enclosed patches, the emacs packages compile, dired, lpr, X shell, telnet, and time all work to some extent. I am also enclosing X patches to GNUS and the gnuplot interface of calc which allow them to X run under VMS. X Xenjoy! Xscott snyder Xsnyder@d0gsc.fnal.gov $ CALL UNPACK VMS-CHANGES-README.;8 1275471601 $ create 'f' X*** callproc.c`09Tue Feb 25 11:59:02 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Dcallproc.c`09Mon May 18 22: V51:23 1992 X*************** X*** 72,77 **** X--- 72,94 ---- X /* Exit code of synchronous subprocess if positive, X minus the signal number if negative. */ X int synch_process_retcode; X+`20 X+ #ifdef VMS X+ #include <descrip.h> X+ #define CLI$M_NOWAIT 1 /* clidef.h is missing from C librar Vy */ X+ #define CLI$M_WAIT 0 /* clidef.h is missing from C librar Vy */ X+`20 X+ /* macros to extract the low and high portions of a VMS pid */ X+`20 X+ #define LOPID(x) ((x) & 0x000fffff) X+ #define HIPID(x) (((x) & 0xfff00000) >> 20) X+`20 X+ /* join the two parts back together again */ X+`20 X+ #define MKPID(lo, hi) ((lo) `7C ((hi) << 20)) X+`20 X+ static int sync_process_exited; X+ #endif X `0C X Lisp_Object X call_process_cleanup (fdpid) X*************** X*** 80,87 **** X--- 97,109 ---- X register Lisp_Object fd, pid; X fd = Fcar (fdpid); X pid = Fcdr (fdpid); X+ #ifdef VMS X+ vms_close_fd (XFASTINT (fd)); X+ kill (MKPID (XFASTINT (Fcar (pid)), XFASTINT (Fcdr (pid))), SIGKILL); X+ #else X close (XFASTINT (fd)); X kill (XFASTINT (pid), SIGKILL); X+ #endif X return Qnil; X `7D X `20 X*************** X*** 92,97 **** X--- 114,190 ---- X #else X extern noshare char **environ; X #endif X+`20 X+ static void sync_exit_ast(void) X+ `7B X+ extern int process_ef, process_tick; X+`20 X+ sync_process_exited = 1; X+`20 X+ /* jar select loose */ X+ ++process_tick; X+ sys$setef(process_ef); X+ `7D X+`20 X+ /* Prepare a command string for starting a process on VMS. NEW_ARGV is a X+ NULL-terminated vector of arguments, with NEW_ARGV`5B0`5D being the pro Vgram X+ to run, or the DCL command verb. First, EXEC-PATH is searched for a fil Ve X+ matching NEW_ARGV`5B0`5D and ending either `60.com' or `60.exe'. If a m Vatch is X+ found ending with `60.com', NEW_ARGV`5B0`5D is changed to an `60@' in f Vront of X+ the full path; if a match is found ending in `60.exe', NEW_ARGV`5B0`5D V is changed X+ to `60MCR ' in front of the full path. Finally, the elements of NEW_ARG VV X+ are concatenated together (separated by spaces) into a single string, w Vhich X+ is then returned. This string will have been obtained from malloc(), an Vd X+ should be freed when you are done with it. X+`20 X+ This function may clobber NEW_ARGV`5B0`5D. X+ */ X+`20 X+ char *vms_hack_process_args(new_argv) X+ unsigned char **new_argv; X+ `7B X+ int i, totlen; X+ char *cmd; X+ Lisp_Object path; X+`20 X+ openp (Vexec_path, build_string (new_argv`5B0`5D), ":.EXE:.COM", &path, V 1); X+ if ( ! NULL (path)) X+ `7B X+ if (XSTRING(path)->size >= 4 && X+ `09 strcmp (XSTRING (path)->data + XSTRING (path)->size - 4,".EXE") == 0) X+ `09`7B X+ `09 unsigned char *buf = alloca (XSTRING (path)->size + 5); X+ `09 strcpy (buf, "MCR "); X+ `09 strcat (buf, XSTRING (path)->data); X+ `09 new_argv`5B0`5D = buf; X+ `09`7D X+ else if (XSTRING (path)->size >= 4 && X+ `09 strcmp (XSTRING (path)->data + XSTRING (path)->size - 4, X+ `09`09 ".COM") == 0) X+ `09`7B X+ `09 unsigned char *buf = alloca (XSTRING (path)->size + 2); X+ `09 strcpy (buf, "@"); X+ `09 strcat (buf, XSTRING (path)->data); X+ `09 new_argv`5B0`5D = buf; X+ `09`7D X+ else X+ `09new_argv`5B0`5D = XSTRING (path)->data; X+ `7D X+`20 X+ totlen = 0; X+ for (i=0; new_argv`5Bi`5D != 0; i++) X+ totlen += strlen (new_argv`5Bi`5D) + 1; X+ cmd = (char *) xmalloc (totlen+1); X+ cmd`5B0`5D = '\0'; X+ for (i=0; new_argv`5Bi`5D != 0; i++) X+ `7B X+ strcat (cmd, new_argv`5Bi`5D); X+ strcat (cmd, " "); X+ `7D X+`20 X+ return cmd; X+ `7D X+`20 X #else X extern char **environ; X #endif X*************** X*** 113,124 **** X Lisp_Object display, buffer, path; X int fd`5B2`5D; X int filefd; X- register int pid; X char buf`5B1024`5D; X int count = specpdl_ptr - specpdl; X register unsigned char **new_argv X = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); X struct buffer *old = current_buffer; X `20 X CHECK_STRING (args`5B0`5D, 0); X `20 X--- 206,223 ---- X Lisp_Object display, buffer, path; X int fd`5B2`5D; X int filefd; X char buf`5B1024`5D; X int count = specpdl_ptr - specpdl; X register unsigned char **new_argv X = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); X struct buffer *old = current_buffer; X+ #ifdef VMS X+ int pid; X+ char out_name_buf`5B33`5D; X+ $DESCRIPTOR (out_dsc, out_name_buf); X+ #else X+ register int pid; X+ #endif X `20 X CHECK_STRING (args`5B0`5D, 0); X `20 X*************** X*** 131,136 **** X--- 230,250 ---- X else X args`5B1`5D = Fexpand_file_name (args`5B1`5D, current_buffer->director Vy); X `20 X+ #ifdef VMS X+ /* if the file name doesn't have an extension, add a period. */ X+ `7B X+ extern unsigned char *strchr (), *strrchr (); X+ unsigned char *p = strrchr (XSTRING (args`5B1`5D)->data, '`5D'); X+ if (p == 0) X+ p = strrchr (XSTRING (args`5B1`5D)->data, ':'); X+ if (p == 0) X+ p = XSTRING (args`5B1`5D)->data; X+`20 X+ if (strchr (p, '.') == 0) X+ args`5B1`5D = concat2 (args`5B1`5D, build_string (".")); X+ `7D X+ #endif X+`20 X CHECK_STRING (args`5B1`5D, 1); X `20 X `7B X*************** X*** 165,170 **** X--- 279,285 ---- X `7B X report_file_error ("Opening process input file", Fcons (args`5B1`5D, V Qnil)); X `7D X+ #ifndef VMS X /* Search for program; barf if not found. */ X openp (Vexec_path, args`5B0`5D, "", &path, 1); X if (NULL (path)) X*************** X*** 173,185 **** X report_file_error ("Searching for program", Fcons (args`5B0`5D, Qnil V)); X `7D X new_argv`5B0`5D = XSTRING (path)->data; X `20 X if (XTYPE (buffer) == Lisp_Int) X #ifdef VMS X! fd`5B1`5D = open ("NLA0:", 0), fd`5B0`5D = -1; X! #else X fd`5B1`5D = open ("/dev/null", O_WRONLY), fd`5B0`5D = -1; X- #endif /* not VMS */ X else X `7B X pipe (fd); X--- 288,314 ---- X report_file_error ("Searching for program", Fcons (args`5B0`5D, Qnil V)); X `7D X new_argv`5B0`5D = XSTRING (path)->data; X+ #endif X `20 X if (XTYPE (buffer) == Lisp_Int) X #ifdef VMS X! `7B X! out_dsc.dsc$b_dtype = DSC$K_DTYPE_T; X! out_dsc.dsc$b_class = DSC$K_CLASS_S; X! out_dsc.dsc$a_pointer = "NLA0:"; X! out_dsc.dsc$w_length = strlen (out_dsc.dsc$a_pointer); X! fd`5B0`5D = -1; X! `7D X! else X! `7B X! extern struct dsc$descriptor_s *vms_mbx_dsc (); X! if (vms_pipe (fd) < 0) X! error ("can't create mailboxes"); X! vms_close_fd (fd`5B1`5D); X! vms_get_device_name (fd`5B0`5D, &out_dsc); X! `7D X! #else /* not VMS */ X fd`5B1`5D = open ("/dev/null", O_WRONLY), fd`5B0`5D = -1; X else X `7B X pipe (fd); X*************** X*** 188,197 **** X--- 317,328 ---- X set_exclusive_use (fd`5B0`5D); X #endif X `7D X+ #endif /* not VMS */ X `20 X synch_process_death = 0; X synch_process_retcode = 0; X `20 X+ #ifndef VMS X `7B X /* child_setup must clobber environ in systems with true vfork. X Protect it from permanent change. */ X*************** X*** 235,241 **** X--- 366,406 ---- X close (fd`5B0`5D); X report_file_error ("Doing vfork", Qnil); X `7D X+ #else /* VMS */ X+ `7B X+ struct dsc$descriptor_s in_dsc, cmd_dsc; X+ int status; X+ int dum_CLI$M_NOWAIT = CLI$M_NOWAIT; X+ char *cmd; X+`20 X+ close (filefd); X+ in_dsc.dsc$b_dtype = DSC$K_DTYPE_T; X+ in_dsc.dsc$b_class = DSC$K_CLASS_S; X+ in_dsc.dsc$a_pointer = (char *) XSTRING (args`5B1`5D)->data; X+ in_dsc.dsc$w_length = strlen (XSTRING (args`5B1`5D)->data); X+`20 X+ cmd = vms_hack_process_args (new_argv); X+`20 X+ cmd_dsc.dsc$b_dtype = DSC$K_DTYPE_T; X+ cmd_dsc.dsc$b_class = DSC$K_CLASS_S; X+ cmd_dsc.dsc$a_pointer = cmd; X+ cmd_dsc.dsc$w_length = strlen (cmd); X+`20 X+ sync_process_exited = 0; X+ status = lib$spawn (&cmd_dsc, &in_dsc, &out_dsc, &dum_CLI$M_NOWAIT, 0, X+ `09`09`09&pid, &synch_process_retcode, 0, sync_exit_ast, 0); X+`20 X+ free (cmd); X `20 X+ if (! (status & 1)) X+ `7B X+ `09vms_close_fd (fd`5B0`5D); X+ `09error ("Unable to spawn subprocess"); X+ `7D X+ `7D X+ #endif /* VMS */ X+`20 X+`20 X if (XTYPE (buffer) == Lisp_Int) X `7B X #ifndef subprocesses X*************** X*** 244,251 **** X--- 409,423 ---- X return Qnil; X `7D X `20 X+ #ifdef VMS X+ record_unwind_protect (call_process_cleanup, X+ `09`09`09 Fcons (make_number (fd`5B0`5D), X+ `09`09`09`09Fcons (make_number (LOPID (pid)), X+ `09`09`09`09 make_number (HIPID (pid))))); X+ #else X record_unwind_protect (call_process_cleanup, X `09`09`09 Fcons (make_number (fd`5B0`5D), make_number (pid))); X+ #endif X `20 X `20 X if (XTYPE (buffer) == Lisp_Buffer) X*************** X*** 257,264 **** X--- 429,446 ---- X `7B X register int nread; X `20 X+ #ifdef VMS X+ int rfds = 1<<fd`5B0`5D; X+`20 X+ while ( ! sync_process_exited ) X+ `7B X+ select(32, &rfds, 0, 0, 0); X+ if ((nread = vms_read_fd (fd`5B0`5D, buf, sizeof buf)) > 0) X+ `09`7B X+ #else /* not VMS */ X while ((nread = read (fd`5B0`5D, buf, sizeof buf)) > 0) X `7B X+ #endif /* not VMS */ X `09immediate_quit = 0; X `09if (!NULL (buffer)) X `09 insert (buf, nread); X*************** X*** 266,276 **** X--- 448,464 ---- X `09 redisplay_preserve_echo_area (); X `09immediate_quit = 1; X `09QUIT; X+ #ifdef VMS X+ `7D X `7D X `7D X+ #else /* not VMS */ X+ `7D X+ `7D X `20 X /* Wait for it to terminate, unless it already has. */ X wait_for_termination (pid); X+ #endif /* not VMS */ X `20 X immediate_quit = 0; X `20 X*************** X*** 317,322 **** X--- 505,511 ---- X return Qnil; X `7D X `0C X+ #ifndef VMS X /* This is the last thing run in a newly forked inferior X either synchronous or asynchronous. X Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2. X*************** X*** 423,428 **** X--- 612,618 ---- X write (1, new_argv`5B0`5D, strlen (new_argv`5B0`5D)); X _exit (1); X `7D X+ #endif /* not VMS */ X `0C X init_callproc () X `7B X*** emacs.c`09Tue Feb 25 11:59:05 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Demacs.c`09Mon May 18 22:51: V29 1992 X*************** X*** 169,176 **** X #endif /* CLASH_DETECTION */ X `20 X #ifdef VMS X! kill_vms_processes (); X! LIB$STOP (SS$_ABORT); X #else X /* Signal the same code; this time it will really be fatal. */ X kill (getpid (), fatal_error_code); X--- 169,175 ---- X #endif /* CLASH_DETECTION */ X `20 X #ifdef VMS X! lib$signal (SS$_DEBUG); X #else X /* Signal the same code; this time it will really be fatal. */ X kill (getpid (), fatal_error_code); X*************** X*** 565,574 **** X #ifdef subprocesses X kill_buffer_processes (Qnil); X #endif /* subprocesses */ X-`20 X- #ifdef VMS X- kill_vms_processes (); X- #endif /* VMS */ X `20 X Fdo_auto_save (Qt); X `20 X--- 564,569 ---- X*** keyboard.c`09Tue Feb 25 11:59:07 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Dkeyboard.c`09Mon May 18 22: V51:34 1992 X*************** X*** 1123,1131 **** X /* One way or another, wait until input is available; then, if X `09 interrupt handlers have not read it, read it now. */ X `20 X- #ifdef VMS X- wait_for_kbd_input (); X- #else X /* Note SIGIO has been undef'd if FIONREAD is missing. */ X #ifdef SIGIO X gobble_input (); X--- 1123,1128 ---- X*************** X*** 1156,1162 **** X `09 read_avail_input (0); X `09 `7D X `09`7D X- #endif /* not VMS */ X `7D X `20 X input_pending = --kbd_count > 0; X--- 1153,1158 ---- X*** process.c`09Tue Feb 25 11:59:19 1992 X--- `5Bscratch.snyder.gnu.emacs-18_58.src`5Dprocess.c`09Thu Jul 2 07:52:52 V 1992 X*************** X*** 22,32 **** X `20 X #include "config.h" X `20 X- #ifdef VMS X- /* Prevent the file from being totally empty. */ X- static dummy () `7B`7D X- #endif X-`20 X #ifdef subprocesses X /* The entire file is within this conditional */ X `20 X--- 22,27 ---- X*************** X*** 38,46 **** X--- 33,54 ---- X #include <sys/stat.h> X `20 X #ifdef HAVE_SOCKETS`09/* TCP connection support, if kernel can do it */ X+ #ifdef VMS X+ #ifndef __GNUC__ X+ #include "multinet_root:`5Bmultinet.include.sys`5Dtypes.h" X+ #undef FD_SET /* we need types for the rest of the multinet includes */ X+ #undef FD_CLR /* to work with vaxc. but types makes bogus defns */ X+ #undef FD_ISSET /* of the FD_* macros... */ X+ #undef FD_ZERO X+ #endif X+ #include "multinet_root:`5Bmultinet.include.sys`5Dsocket.h" X+ #include "multinet_root:`5Bmultinet.include`5Dnetdb.h" X+ #include "multinet_root:`5Bmultinet.include.netinet`5Din.h" X+ #else X #include <sys/socket.h> X #include <netdb.h> X #include <netinet/in.h> X+ #endif X #endif /* HAVE_SOCKETS */ X `20 X #if defined(BSD) `7C`7C defined(STRIDE) X*************** X*** 101,106 **** X--- 109,122 ---- X #undef O_NONBLOCK X #endif X `20 X+ #ifdef VMS X+ #include <descrip.h> X+ #include <iodef.h> X+ #include <dvidef.h> X+ #define CLI$M_NOWAIT 1 /* clidef.h is missing from C librar Vy */ X+ #define CLI$M_WAIT 0 /* clidef.h is missing from C librar Vy */ X+ #endif X+`20 X #undef NULL X #include "lisp.h" X #include "window.h" X*************** X*** 135,141 **** X `20 X /* Define the structure that the wait system call stores. X On many systems, there is a structure defined for this. X! But on vanilla-ish USG systems there is not. */ X `20 X #ifndef WAITTYPE X #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined V (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER) X--- 151,169 ---- X `20 X /* Define the structure that the wait system call stores. X On many systems, there is a structure defined for this. X! But on vanilla-ish USG systems there is not. X! Neither is there on VMS (surprise, surprise!). */ X!`20 X! #ifdef VMS X! # define WAITTYPE int X! # define WIFSTOPPED(w) 0 X! # define WIFSIGNALED(w) 0 X! # define WIFEXITED(w) ((w) != -1) X! # define WRETCODE(w) (w) X! # define WSTOPSIG(w) (w) X! # define WCOREDUMP(w) 0 X! # define WTERMSIG(w) (w) X! #endif X `20 X #ifndef WAITTYPE X #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined V (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER) X*************** X*** 289,294 **** X--- 317,384 ---- X output from the process is to read at least one char. X Always -1 on systems that support FIONREAD. */ X `20 X+ #ifdef VMS X+`20 X+ /* A few notes on the VMS subprocess implementation: X+`20 X+ All input and output is done through `60pseudo-fds', which are X+ managed in sysdep.c. They can refer to mailboxes, ptys, or X+ network streams. They are created by the functions vms_pipe, X+ vms_make_pty, and vms_net_chan and operated on with vms_read_fd, X+ vms_write_fd, and vms_close_fd. They also can be used with the X+ vms select emulator in sysdep.c. X+`20 X+ Pseudo-fd 0 always refers to the keyboard. The select emulator X+ knows about this. X+`20 X+ Retrieving the exit status from a child process works somewhat differen Vtly X+ on vms than on unix. One can request a subprocess termination AST, X+ and one can supply a memory location into which the system will X+ write the completion status when the subprocess completes. Naturally, X+ one must ensure that this memory location remains valid until the X+ process actually exits. If I were to use a member of the Lisp_Process X+ struct for this, I don't think that that can be guaranteed: it seems X+ possible for the Lisp_Process struct to be freed before the process X+ actually terminates. X+`20 X+ To solve this problem, we keep the exit status in a separate structure, X+ struct vms_process_handle. These are kept in a table: vms_handle_tab. X+ Besides the exit status longword, each handle contains a pointer X+ back to the Lisp_Process struct. The procedure works like this: X+`20 X+ - Initially, all the handles have a NULL pointer. X+ - When creating a process, we find a free handle (one with a NULL point Ver) X+ and set it to point to the Lisp_Process struct for this process. X+ - When deleting a process, we search the table for a handle pointing X+ to the process's Lisp_Process struct. If there's one there, we X+ invalidate it by changing the pointer to -1. X+ - When we receive an exit_ast, we look at the value of the pointer in X+ the handle. If it's still valid (not -1), we copy the status return X+ into the Lisp_Process struct. In any event, we reset the pointer to X+ NULL to free the handle. X+`20 X+ - sss (snyder@d0gsc.fnal.gov) */ X+`20 X+ struct vms_process_handle `7B X+ struct Lisp_Process *proc; X+ int exit_status; X+ `7D; X+`20 X+ struct vms_process_handle vms_handle_tab`5BMAXDESC`5D; X+`20 X+ /* macros to extract the low and high portions of a VMS pid */ X+`20 X+ #define LOPID(x) ((x) & 0x000fffff) X+ #define HIPID(x) (((x) & 0xfff00000) >> 20) X+`20 X+ /* join the two parts back together again */ X+`20 X+ #define MKPID(lo, hi) ((lo) `7C ((hi) << 20)) X+`20 X+ static void exit_ast(); X+`20 X+ #endif /* VMS */ X+`20 X int proc_buffered_char`5BMAXDESC`5D; X `20 X /* These variables hold the filter about to be run, and its args, X*************** X*** 510,515 **** X--- 600,609 ---- X XFASTINT (p->infd) = 0; X XFASTINT (p->outfd) = 0; X XFASTINT (p->pid) = 0; X+ #ifdef VMS X+ XFASTINT (p->hipid) = 0; X+ p->translate_p = Qt; X+ #endif X XFASTINT (p->tick) = 0; X XFASTINT (p->update_tick) = 0; X p->raw_status_low = Qnil; X*************** X*** 538,543 **** X--- 632,651 ---- X `7B X register Lisp_Object pair; X `20 X+ #ifdef VMS X+ int i; X+`20 X+ /* invalidate the handle */ X+ sys$setast (0); X+ for (i=0; i<MAXDESC; i++) X+ if (vms_handle_tab`5Bi`5D.proc == XPROCESS (proc)) X+ `7B X+ `09vms_handle_tab`5Bi`5D.proc = (struct Lisp_Process *) (-1); X+ `09break; X+ `7D X+ sys$setast (1); X+ #endif X+`20 X pair = Frassq (proc, Vprocess_alist); X Vprocess_alist = Fdelq (pair, Vprocess_alist); X Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); X*************** X*** 822,827 **** X--- 930,985 ---- X XPROCESS (proc)->kill_without_query = Fnull (value); X return Fnull (tem); X `7D X+`20 X+ #ifdef VMS X+`20 X+ DEFUN ("set-process-translation-mode", Fset_process_translation_mode, X+ Sset_process_translation_mode, 2, 2, 0, X+ "Set the translation mode for PROCESS to MODE.\n\ X+ If MODE is non-nil, the following translations are performed:\n\ X+ \n\ X+ Sending to PTY processes:\n\ X+ If the output string consists of the single character `5ED, it is\n\ X+ changed to a `5EZ. \n\ X+ All newlines (`5EJ) are converted to carriage-returns (`5EM).\n\ X+ \n\ X+ Reading from PTY processes:\n\ X+ All carriage-returns (`5EM) and nuls (`5E@) are removed.\n\ X+ \n\ X+ Sending to MBX processes:\n\ X+ If the output string consists of the single character `5ED, an EOF\n\ X+ is written to the mailbox instead.\n\ X+ If the output string ends in a newline (`5EJ), the newline is removed. V\n\ X+ \n\ X+ Reading from MBX processes:\n\ X+ If the string starts with a carriage return (`5EM) it is removed.\n\ X+ If the string ends with a CR/LF sequence (`5EM`5EJ), the sequence is\n V\ X+ removed.\n\ X+ A newline (`5EJ) is added to the end of the string.\n\ X+ \n\ X+ This function is unique to VMS.") X+ (proc, mode) X+ register Lisp_Object proc, mode; X+ `7B X+ CHECK_PROCESS (proc, 0); X+ XPROCESS (proc)->translate_p = mode; X+ return mode; X+ `7D X+`20 X+ DEFUN ("process-translation-mode", Fprocess_translation_mode, X+ Sprocess_translation_mode, 1, 1, 0, X+ "Returns the translation mode of PROCESS.\n\ X+ See set-process-translation-mode for more info on process I/O translations V.\n\ X+ \n\ X+ This function is unique to VMS.") X+ (proc) X+ register Lisp_Object proc; X+ `7B X+ CHECK_PROCESS (proc, 0); X+ return XPROCESS (proc)->translate_p; X+ `7D X+`20 X+ #endif /* VMS */ X `0C X Lisp_Object X list_processes_1 () X*************** X*** 991,996 **** X--- 1149,1155 ---- X new_argv`5Bi - 2`5D = 0; X new_argv`5B0`5D = XSTRING (program)->data; X `20 X+ #ifndef VMS X /* If program file name is not absolute, search our path for it */ X if (new_argv`5B0`5D`5B0`5D != '/') X `7B X*************** X*** 1000,1005 **** X--- 1159,1165 ---- X `09report_file_error ("Searching for program", Fcons (program, Qnil)); X new_argv`5B0`5D = XSTRING (tem)->data; X `7D X+ #endif /* not VMS */ X `20 X proc = make_process (name); X `20 X*************** X*** 1015,1020 **** X--- 1175,1266 ---- X return proc; X `7D X `20 X+ #ifdef VMS X+`20 X+ create_process (process, new_argv) X+ Lisp_Object process; X+ char **new_argv; X+ `7B X+ int fds`5B2`5D, pid, status, handle_ndx; X+ int dum_CLI$M_NOWAIT = CLI$M_NOWAIT; X+ char *cmd; X+ int pty_flag = 0; X+ char indevbuf`5B21`5D, outdevbuf`5B21`5D; X+ $DESCRIPTOR (indsc, indevbuf); X+ $DESCRIPTOR (outdsc, outdevbuf); X+`20 X+ struct dsc$descriptor_s cmd_dsc; X+ extern char *vms_hack_process_args (); X+`20 X+ /* create the I/O channels, either ptys or mailboxes */ X+ status = -1; X+ #ifdef HAVE_VMS_PTYS X+ if (EQ (Vprocess_connection_type, Qt)) X+ `7B X+ status = vms_make_pty (fds); X+ if (status >= 0) X+ `09pty_flag = 1; X+ `7D X+ #endif X+`20 X+ if (status < 0) X+ `7B X+ if (vms_pipe (fds) < 0) X+ `09error ("Can't create mailboxes"); X+ `7D X+`20 X+ /* find a free process handle */ X+ for (handle_ndx = 0; handle_ndx < MAXDESC; handle_ndx++) X+ if (vms_handle_tab`5Bhandle_ndx`5D.proc == 0) X+ `7B X+ `09vms_handle_tab`5Bhandle_ndx`5D.proc = XPROCESS (process); X+ `09vms_handle_tab`5Bhandle_ndx`5D.exit_status = -1; X+ `09break; X+ `7D X+ if (handle_ndx >= MAXDESC) X+ error ("Can't allocate process handle"); X+`20 X+ /* fill in the fields of the process struct */ X+ chan_process`5Bfds`5B0`5D`5D = process; X+ XFASTINT (XPROCESS (process)->infd) = fds`5B0`5D; X+ XFASTINT (XPROCESS (process)->outfd) = fds`5B1`5D; X+ XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); X+ XPROCESS (process)->status = Qrun; X+ XPROCESS (process)->subtty = Qnil; X+`20 X+ /* prepare the dcl command line */ X+ cmd = vms_hack_process_args (new_argv); X+ cmd_dsc.dsc$b_dtype = DSC$K_DTYPE_T; X+ cmd_dsc.dsc$b_class = DSC$K_CLASS_S; X+ cmd_dsc.dsc$a_pointer = cmd; X+ cmd_dsc.dsc$w_length = strlen (cmd); X+`20 X+ /* spawn the subprocess... */ X+ vms_get_device_name (fds`5B0`5D, &indsc); X+ vms_get_device_name (fds`5B1`5D, &outdsc); X+`20 X+ message ("Creating subprocess..."); X+ status = lib$spawn (&cmd_dsc, &outdsc, &indsc, &dum_CLI$M_NOWAIT, 0, X+ &pid, &vms_handle_tab`5Bhandle_ndx`5D.exit_status, 0 V, X+ `09`09 exit_ast, &vms_handle_tab`5Bhandle_ndx`5D); X+ if (! (status & 1)) X+ `7B X+ remove_process (process);`20 X+ error ("Unable to spawn subprocess"); X+ `7D X+`20 X+ /* record the pid */ X+ XFASTINT (XPROCESS (process)->pid) = LOPID (pid); X+ XFASTINT (XPROCESS (process)->hipid) = HIPID (pid); X+`20 X+ /* receive input from this process */ X+ FD_SET (fds`5B0`5D, &input_wait_mask); X+`20 X+ message ("Creating subprocess...done"); X+ `7D X+`20 X+ #else /* not VMS */ X+`20 X create_process_1 (signo) X int signo; X `7B X*************** X*** 1333,1338 **** X--- 1579,1586 ---- X `7D X `7D X `20 X+ #endif /* not VMS */ X+`20 X #ifdef HAVE_SOCKETS X `20 X /* open a TCP network connection to a given HOST/SERVICE. Treated X*************** X*** 1396,1406 **** X--- 1644,1656 ---- X if (s < 0)`20 X report_file_error ("error creating socket", Fcons (name, Qnil)); X `20 X+ #ifndef VMS X /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) X when connect is interrupted. So let's not let it get interrupted. * V/ X if (interrupt_input) X unrequest_sigio (); X stop_polling (); X+ #endif X `20 X while (1) X `7B X*************** X*** 1411,1422 **** X--- 1661,1685 ---- X /* Report a "real" error. */ X if (errno != EINTR) X `09`7B X+ #ifdef VMS X+ `09 socket_close (s); X+ #else X `09 close (s); X+ #endif X `09 error ("Host \"%s\" not responding", XSTRING (host)->data); X `09`7D X /* Loop around after temporary error. */ X `7D X `20 X+ #ifdef VMS X+ `7B X+ int fds`5B2`5D; X+ if (vms_net_chan (s, fds) < 0) X+ report_file_error ("error starting I/O on socket", Fcons (name, Qnil V)); X+ inch = fds`5B0`5D; X+ outch = fds`5B1`5D; X+ `7D X+ #else /* not VMS */ X if (interrupt_input) X request_sigio (); X start_polling (); X*************** X*** 1425,1430 **** X--- 1688,1694 ---- X outch = dup (s); X if (outch < 0)`20 X report_file_error ("error duplicating socket", Fcons (name, Qnil)); X+ #endif /* not VMS */ X `20 X if (!NULL (buffer)) X buffer = Fget_buffer_create (buffer); X*************** X*** 1432,1437 **** X--- 1696,1702 ---- X `20 X chan_process`5Binch`5D = proc; X `20 X+ #ifndef VMS X #ifdef O_NONBLOCK X fcntl (inch, F_SETFL, O_NONBLOCK); X #else X*************** X*** 1439,1444 **** X--- 1704,1710 ---- X fcntl (inch, F_SETFL, O_NDELAY); X #endif X #endif X+ #endif /* not VMS */ X `20 X XPROCESS (proc)->childp = host; X XPROCESS (proc)->command_channel_p = Qnil; X*************** X*** 1448,1454 **** X XPROCESS (proc)->command = Qnil; X XPROCESS (proc)->pid = Qnil; X XPROCESS (proc)->kill_without_query = Qt; X! XFASTINT (XPROCESS (proc)->infd) = s; X XFASTINT (XPROCESS (proc)->outfd) = outch; X XPROCESS (proc)->status = Qrun; X FD_SET (inch, &input_wait_mask); X--- 1714,1720 ---- X XPROCESS (proc)->command = Qnil; X XPROCESS (proc)->pid = Qnil; X XPROCESS (proc)->kill_without_query = Qt; X! XFASTINT (XPROCESS (proc)->infd) = inch; X XFASTINT (XPROCESS (proc)->outfd) = outch; X XPROCESS (proc)->status = Qrun; X FD_SET (inch, &input_wait_mask); X*************** X*** 1469,1479 **** X--- 1735,1751 ---- X `20 X if (inchannel) X `7B X+ #ifdef VMS X+ vms_close_fd (inchannel); X+ if (outchannel != inchannel) X+ `09vms_close_fd (outchannel); X+ #else X /* Beware SIGCHLD hereabouts. */ X flush_pending_output (inchannel); X close (inchannel); X if (outchannel && outchannel != inchannel) X `09close (outchannel); X+ #endif /* not VMS */ X `20 X XFASTINT (p->infd) = 0; X XFASTINT (p->outfd) = 0; X*************** X*** 1488,1493 **** X--- 1760,1766 ---- X `20 X close_process_descs () X `7B X+ #ifndef VMS X int i; X for (i = 0; i < MAXDESC; i++) X `7B X*************** X*** 1506,1511 **** X--- 1779,1785 ---- X `09 close (XFASTINT (XPROCESS (process)->subtty)); X `09`7D X `7D X+ #endif X `7D X `0C X DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_ou Vtput, X*************** X*** 1920,1925 **** X--- 2194,2203 ---- X register struct Lisp_Process *p = XPROCESS (proc); X register int opoint; X `20 X+ #ifdef VMS X+ nchars = vms_read_fd (channel, chars, sizeof chars, X+ `09`09`09! NULL (XPROCESS (proc)->translate_p)); X+ #else X if (proc_buffered_char`5Bchannel`5D < 0) X nchars = read (channel, chars, sizeof chars); X else X*************** X*** 1932,1937 **** X--- 2210,2216 ---- X else X `09nchars = nchars + 1; X `7D X+ #endif /* not VMS */ X `20 X if (nchars <= 0) return nchars; X `20 X*************** X*** 1993,1998 **** X--- 2272,2278 ---- X `20 X jmp_buf send_process_frame; X `20 X+ #ifndef VMS X send_process_trap () X `7B X #ifdef BSD4_1 X*************** X*** 2001,2006 **** X--- 2281,2287 ---- X #endif /* BSD4_1 */ X longjmp (send_process_frame, 1); X `7D X+ #endif /* not VMS */ X `20 X send_process (proc, buf, len) X Lisp_Object proc; X*************** X*** 2019,2027 **** X--- 2300,2313 ---- X if (!setjmp (send_process_frame)) X while (len > 0) X `7B X+ #ifdef VMS X+ rv = vms_write_fd (XFASTINT (XPROCESS (proc)->outfd), buf, len, X+ ! NULL (XPROCESS (proc)->translate_p) ); X+ #else X `09signal (SIGPIPE, send_process_trap); X `09rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len); X `09signal (SIGPIPE, SIG_DFL); X+ #endif X `09if (rv < 0) X `09 `7B X `09 if (0 X*************** X*** 2123,2128 **** X--- 2409,2417 ---- X error ("Process %s is not active", X `09 XSTRING (p->name)->data); X `20 X+ #ifdef VMS X+ gid = MKPID(XFASTINT (p->pid), XFASTINT (p->hipid)); X+ #else X if (NULL (p->pty_flag)) X current_group = Qnil; X `20 X*************** X*** 2220,2225 **** X--- 2509,2515 ---- X kill (XFASTINT (p->pid), signo); X return; X `7D X+ #endif /* not VMS */ X `20 X /* gid may be a pid, or minus a pgrp's number */ X #ifdef TIOCSIGSEND +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-