src/vmsproc.c

   1 /* Interfaces to subprocesses on VMS.
   2    Copyright (C) 1988 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 /*
  22     Event flag and `select' emulation
  23
  24     0 is never used
  25     1 is the terminal
  26     23 is the timer event flag
  27     24-31 are reserved by VMS
  28 */
  29 #include <config.h>
  30 #include        <ssdef.h>
  31 #include        <iodef.h>
  32 #include        <dvidef.h>
  33 #include        <clidef.h>
  34 #include        "vmsproc.h"
  35 #include        "lisp.h"
  36 #include        "buffer.h"
  37 #include        <file.h>
  38 #include        "process.h"
  39 #include        "commands.h"
  40 #include        <errno.h>
  41 extern Lisp_Object call_process_cleanup ();
  42
  43
  44 #define         KEYBOARD_EVENT_FLAG             1
  45 #define         TIMER_EVENT_FLAG                23
  46
  47 static VMS_PROC_STUFF   procList[MAX_EVENT_FLAGS+1];
  48
  49 get_kbd_event_flag ()
  50 {
  51   /*
  52     Return the first event flag for keyboard input.
  53     */
  54   VMS_PROC_STUFF        *vs = &procList[KEYBOARD_EVENT_FLAG];
  55
  56   vs->busy = 1;
  57   vs->pid = 0;
  58   return (vs->eventFlag);
  59 }
  60
  61 get_timer_event_flag ()
  62 {
  63   /*
  64     Return the last event flag for use by timeouts
  65     */
  66   VMS_PROC_STUFF        *vs = &procList[TIMER_EVENT_FLAG];
  67
  68   vs->busy = 1;
  69   vs->pid = 0;
  70   return (vs->eventFlag);
  71 }
  72
  73 VMS_PROC_STUFF *
  74 get_vms_process_stuff ()
  75 {
  76   /*
  77     Return a process_stuff structure
  78
  79     We use 1-23 as our event flags to simplify implementing
  80     a VMS `select' call.
  81     */
  82   int i;
  83   VMS_PROC_STUFF *vs;
  84
  85   for (i=1, vs = procList; i<MAX_EVENT_FLAGS; i++, vs++)
  86     {
  87       if (!vs->busy)
  88         {
  89           vs->busy = 1;
  90           vs->inputChan = 0;
  91           vs->pid = 0;
  92           sys$clref (vs->eventFlag);
  93           return (vs);
  94         }
  95     }
  96   return ((VMS_PROC_STUFF *)0);
  97 }
  98
  99 give_back_vms_process_stuff (vs)
 100      VMS_PROC_STUFF *vs;
 101 {
 102   /*
 103     Return an event flag to our pool
 104     */
 105   vs->busy = 0;
 106   vs->inputChan = 0;
 107   vs->pid = 0;
 108 }
 109
 110 VMS_PROC_STUFF *
 111 get_vms_process_pointer (pid)
 112      int pid;
 113 {
 114   /*
 115     Given a pid, return the VMS_STUFF pointer
 116     */
 117   int                   i;
 118   VMS_PROC_STUFF        *vs;
 119
 120   /* Don't search the last one */
 121   for (i=0, vs=procList; i<MAX_EVENT_FLAGS; i++, vs++)
 122     {
 123       if (vs->busy && vs->pid == pid)
 124         return (vs);
 125     }
 126   return ((VMS_PROC_STUFF *)0);
 127 }
 128
 129 start_vms_process_read (vs)
 130      VMS_PROC_STUFF *vs;
 131 {
 132   /*
 133     Start an asynchronous  read on a VMS process
 134     We will catch up with the output sooner or later
 135     */
 136   int                   status;
 137   int                   ProcAst ();
 138
 139   status = sys$qio (vs->eventFlag, vs->outputChan, IO$_READVBLK,
 140                    vs->iosb, 0, vs,
 141                    vs->inputBuffer, sizeof (vs->inputBuffer), 0, 0, 0, 0);
 142   if (status != SS$_NORMAL)
 143     return (0);
 144   else
 145     return (1);
 146 }
 147
 148 extern int      waiting_for_ast;                /* in sysdep.c */
 149 extern int      timer_ef;
 150 extern int      input_ef;
 151
 152 select (nDesc, rdsc, wdsc, edsc, timeOut)
 153      int nDesc;
 154      int *rdsc;
 155      int *wdsc;
 156      int *edsc;
 157      int *timeOut;
 158 {
 159   /* Emulate a select call
 160
 161      We know that we only use event flags 1-23
 162
 163      timeout == 100000 & bit 0 set means wait on keyboard input until
 164      something shows up.  If timeout == 0, we just read the event
 165      flags and return what we find.  */
 166
 167   int nfds = 0;
 168   int status;
 169   int time[2];
 170   int delta = -10000000;
 171   int zero = 0;
 172   int timeout = *timeOut;
 173   unsigned long mask, readMask, waitMask;
 174
 175   if (rdsc)
 176     readMask = *rdsc << 1;      /* Unix mask is shifted over 1 */
 177   else
 178     readMask = 0;               /* Must be a wait call */
 179
 180   sys$clref (KEYBOARD_EVENT_FLAG);
 181   sys$setast (0);               /* Block interrupts */
 182   sys$readef (KEYBOARD_EVENT_FLAG, &mask); /* See what is set */
 183   mask &= readMask;             /* Just examine what we need */
 184   if (mask == 0)
 185     {           /* Nothing set, we must wait */
 186       if (timeout != 0)
 187         {       /* Not just inspecting... */
 188           if (!(timeout == 100000 &&
 189                 readMask == (1 << KEYBOARD_EVENT_FLAG)))
 190             {
 191               lib$emul (&timeout, &delta, &zero, time);
 192               sys$setimr (TIMER_EVENT_FLAG, time, 0, 1);
 193               waitMask = readMask | (1 << TIMER_EVENT_FLAG);
 194             }
 195           else
 196             waitMask = readMask;
 197           if (waitMask & (1 << KEYBOARD_EVENT_FLAG))
 198             {
 199               sys$clref (KEYBOARD_EVENT_FLAG);
 200               waiting_for_ast = 1; /* Only if reading from 0 */
 201             }
 202           sys$setast (1);
 203           sys$wflor (KEYBOARD_EVENT_FLAG, waitMask);
 204           sys$cantim (1, 0);
 205           sys$readef (KEYBOARD_EVENT_FLAG, &mask);
 206           if (readMask & (1 << KEYBOARD_EVENT_FLAG))
 207             waiting_for_ast = 0;
 208         }
 209     }
 210   sys$setast (1);
 211
 212   /*
 213     Count number of descriptors that are ready
 214     */
 215   mask &= readMask;
 216   if (rdsc)
 217     *rdsc = (mask >> 1);        /* Back to Unix format */
 218   for (nfds = 0; mask; mask >>= 1)
 219     {
 220       if (mask & 1)
 221         nfds++;
 222     }
 223   return (nfds);
 224 }
 225
 226 #define MAX_BUFF        1024
 227
 228 write_to_vms_process (vs, buf, len)
 229      VMS_PROC_STUFF *vs;
 230      char *buf;
 231      int len;
 232 {
 233   /*
 234     Write something to a VMS process.
 235
 236     We have to map newlines to carriage returns for VMS.
 237     */
 238   char          ourBuff[MAX_BUFF];
 239   short         iosb[4];
 240   int                   status;
 241   int                   in, out;
 242
 243   while (len > 0)
 244     {
 245       out = map_nl_to_cr (buf, ourBuff, len, MAX_BUFF);
 246       status = sys$qiow (0, vs->inputChan, IO$_WRITEVBLK|IO$M_NOFORMAT,
 247                         iosb, 0, 0, ourBuff, out, 0, 0, 0, 0);
 248       if (status != SS$_NORMAL || (status = iosb[0]) != SS$_NORMAL)
 249         {
 250           error ("Could not write to subprocess: %x", status);
 251           return (0);
 252         }
 253       len -= out;
 254     }
 255   return (1);
 256 }
 257
 258 static
 259 map_nl_to_cr (in, out, maxIn, maxOut)
 260      char *in;
 261      char *out;
 262      int maxIn;
 263      int maxOut;
 264 {
 265   /*
 266     Copy `in' to `out' remapping `\n' to `\r'
 267     */
 268   int                   c;
 269   int                   o;
 270
 271   for (o=0; maxIn-- > 0 && o < maxOut; o++)
 272     {
 273       c = *in++;
 274       *out++ = (c == '\n') ? '\r' : c;
 275     }
 276   return (o);
 277 }
 278
 279 clean_vms_buffer (buf, len)
 280      char *buf;
 281      int len;
 282 {
 283   /*
 284     Sanitize output from a VMS subprocess
 285     Strip CR's and NULLs
 286     */
 287   char          *oBuf = buf;
 288   char          c;
 289   int                   l = 0;
 290
 291   while (len-- > 0)
 292     {
 293       c = *buf++;
 294       if (c == '\r' || c == '\0')
 295         ;
 296       else
 297         {
 298           *oBuf++ = c;
 299           l++;
 300         }
 301     }
 302   return (l);
 303 }
 304
 305 /*
 306     For the CMU PTY driver
 307 */
 308 #define         PTYNAME         "PYA0:"
 309
 310 get_pty_channel (inDevName, outDevName, inChannel, outChannel)
 311      char *inDevName;
 312      char *outDevName;
 313      int *inChannel;
 314      int *outChannel;
 315 {
 316   int                   PartnerUnitNumber;
 317   int                   status;
 318   struct {
 319     int l;
 320     char        *a;
 321   } d;
 322   struct {
 323     short       BufLen;
 324     short       ItemCode;
 325     int *BufAddress;
 326     int *ItemLength;
 327   } g[2];
 328
 329   d.l = strlen (PTYNAME);
 330   d.a = PTYNAME;
 331   *inChannel = 0;               /* Should be `short' on VMS */
 332   *outChannel = 0;
 333   *inDevName = *outDevName = '\0';
 334   status  = sys$assign (&d, inChannel, 0, 0);
 335   if (status == SS$_NORMAL)
 336     {
 337       *outChannel = *inChannel;
 338       g[0].BufLen = sizeof (PartnerUnitNumber);
 339       g[0].ItemCode = DVI$_UNIT;
 340       g[0].BufAddress = &PartnerUnitNumber;
 341       g[0].ItemLength = (int *)0;
 342       g[1].BufLen = g[1].ItemCode = 0;
 343       status = sys$getdviw (0, *inChannel, 0, &g, 0, 0, 0, 0);
 344       if (status == SS$_NORMAL)
 345         {
 346           sprintf (inDevName, "_TPA%d:", PartnerUnitNumber);
 347           strcpy (outDevName, inDevName);
 348         }
 349     }
 350   return (status);
 351 }
 352
 353 VMSgetwd (buf)
 354      char *buf;
 355 {
 356   /*
 357     Return the current directory
 358     */
 359   char curdir[256];
 360   char *getenv ();
 361   char *s;
 362   short len;
 363   int status;
 364   struct
 365     {
 366       int       l;
 367       char      *a;
 368     } d;
 369
 370   s = getenv ("SYS$DISK");
 371   if (s)
 372     strcpy (buf, s);
 373   else
 374     *buf = '\0';
 375
 376   d.l = 255;
 377   d.a = curdir;
 378   status = sys$setddir (0, &len, &d);
 379   if (status & 1)
 380     {
 381       curdir[len] = '\0';
 382       strcat (buf, curdir);
 383     }
 384 }
 385 \f
 386 static
 387 call_process_ast (vs)
 388      VMS_PROC_STUFF *vs;
 389 {
 390   sys$setef (vs->eventFlag);
 391 }
 392
 393 void
 394 child_setup (in, out, err, new_argv, env)
 395      int in, out, err;
 396      register char **new_argv;
 397      char **env;
 398 {
 399   /* ??? I suspect that maybe this shouldn't be done on VMS.  */
 400 #ifdef subprocesses
 401   /* Close Emacs's descriptors that this process should not have.  */
 402   close_process_descs ();
 403 #endif
 404
 405   if (XTYPE (current_buffer->directory) == Lisp_String)
 406     chdir (XSTRING (current_buffer->directory)->data);
 407 }
 408
 409 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
 410   "Call PROGRAM synchronously in a separate process.\n\
 411 Program's input comes from file INFILE (nil means null device, `NLA0:').\n\
 412 Insert output in BUFFER before point; t means current buffer;\n\
 413  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 414 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 415 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 416 This function waits for PROGRAM to terminate, unless BUFFER is 0;\n\
 417 if you quit, the process is killed.")
 418   (nargs, args)
 419      int nargs;
 420      register Lisp_Object *args;
 421 {
 422   Lisp_Object display, buffer, path;
 423   char oldDir[512];
 424   int inchannel, outchannel;
 425   int len;
 426   int call_process_ast ();
 427   struct
 428     {
 429       int l;
 430       char *a;
 431     } dcmd, din, dout;
 432   char inDevName[65];
 433   char outDevName[65];
 434   short iosb[4];
 435   int status;
 436   int SpawnFlags = CLI$M_NOWAIT;
 437   VMS_PROC_STUFF *vs;
 438   VMS_PROC_STUFF *get_vms_process_stuff ();
 439   int fd[2];
 440   int filefd;
 441   register int pid;
 442   char buf[1024];
 443   int count = specpdl_ptr - specpdl;
 444   register unsigned char **new_argv;
 445   struct buffer *old = current_buffer;
 446
 447   CHECK_STRING (args[0], 0);
 448
 449   if (nargs <= 1 || NILP (args[1]))
 450     args[1] = build_string ("NLA0:");
 451   else
 452     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
 453
 454   CHECK_STRING (args[1], 1);
 455
 456   {
 457     register Lisp_Object tem;
 458     buffer = tem = args[2];
 459     if (nargs <= 2)
 460       buffer = Qnil;
 461     else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
 462                || XFASTINT (tem) == 0))
 463       {
 464         buffer = Fget_buffer (tem);
 465         CHECK_BUFFER (buffer, 2);
 466       }
 467   }
 468
 469   display = nargs >= 3 ? args[3] : Qnil;
 470
 471   {
 472     /*
 473         if (args[0] == "*dcl*" then we need to skip pas the "-c",
 474         else args[0] is the program to run.
 475     */
 476     register int i;
 477     int arg0;
 478     int firstArg;
 479
 480     if (strcmp (XSTRING (args[0])->data, "*dcl*") == 0)
 481       {
 482         arg0 = 5;
 483         firstArg = 6;
 484       }
 485     else
 486       {
 487         arg0 = 0;
 488         firstArg = 4;
 489       }
 490     len = XSTRING (args[arg0])->size + 1;
 491     for (i = firstArg; i < nargs; i++)
 492       {
 493         CHECK_STRING (args[i], i);
 494         len += XSTRING (args[i])->size + 1;
 495       }
 496     new_argv = alloca (len);
 497     strcpy (new_argv, XSTRING (args[arg0])->data);
 498     for (i = firstArg; i < nargs; i++)
 499       {
 500         strcat (new_argv, " ");
 501         strcat (new_argv, XSTRING (args[i])->data);
 502       }
 503     dcmd.l = len-1;
 504     dcmd.a = new_argv;
 505
 506     status = get_pty_channel (inDevName, outDevName, &inchannel, &outchannel);
 507     if (!(status & 1))
 508       error ("Error getting PTY channel: %x", status);
 509     if (XTYPE (buffer) == Lisp_Int)
 510       {
 511         dout.l = strlen ("NLA0:");
 512         dout.a = "NLA0:";
 513       }
 514     else
 515       {
 516         dout.l = strlen (outDevName);
 517         dout.a = outDevName;
 518       }
 519
 520     vs = get_vms_process_stuff ();
 521     if (!vs)
 522       {
 523         sys$dassgn (inchannel);
 524         sys$dassgn (outchannel);
 525         error ("Too many VMS processes");
 526       }
 527     vs->inputChan = inchannel;
 528     vs->outputChan = outchannel;
 529   }
 530
 531   filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
 532   if (filefd < 0)
 533     {
 534       sys$dassgn (inchannel);
 535       sys$dassgn (outchannel);
 536       give_back_vms_process_stuff (vs);
 537       report_file_error ("Opening process input file", Fcons (args[1], Qnil));
 538     }
 539   else
 540     close (filefd);
 541
 542   din.l = XSTRING (args[1])->size;
 543   din.a = XSTRING (args[1])->data;
 544
 545   /*
 546       Start a read on the process channel
 547   */
 548   if (XTYPE (buffer) != Lisp_Int)
 549     {
 550       start_vms_process_read (vs);
 551       SpawnFlags = CLI$M_NOWAIT;
 552     }
 553   else
 554     SpawnFlags = 0;
 555
 556   /*
 557       On VMS we need to change the current directory
 558       of the parent process before forking so that
 559       the child inherit that directory.  We remember
 560       where we were before changing.
 561   */
 562   VMSgetwd (oldDir);
 563   child_setup (0, 0, 0, 0, 0);
 564   status = lib$spawn (&dcmd, &din, &dout, &SpawnFlags, 0, &vs->pid,
 565               &vs->exitStatus, 0, call_process_ast, vs);
 566   chdir (oldDir);
 567
 568   if (status != SS$_NORMAL)
 569     {
 570       sys$dassgn (inchannel);
 571       sys$dassgn (outchannel);
 572       give_back_vms_process_stuff (vs);
 573       error ("Error calling LIB$SPAWN: %x", status);
 574     }
 575   pid = vs->pid;
 576
 577   if (XTYPE (buffer) == Lisp_Int)
 578     {
 579 #ifndef subprocesses
 580       wait_without_blocking ();
 581 #endif subprocesses
 582       return Qnil;
 583     }
 584
 585   if (!NILP (display) && INTERACTIVE)
 586     prepare_menu_bars ();
 587
 588   record_unwind_protect (call_process_cleanup,
 589                          Fcons (make_number (fd[0]), make_number (pid)));
 590
 591
 592   if (XTYPE (buffer) == Lisp_Buffer)
 593     Fset_buffer (buffer);
 594
 595   immediate_quit = 1;
 596   QUIT;
 597
 598   while (1)
 599     {
 600       sys$waitfr (vs->eventFlag);
 601       if (vs->iosb[0] & 1)
 602         {
 603           immediate_quit = 0;
 604           if (!NILP (buffer))
 605             {
 606               vs->iosb[1] = clean_vms_buffer (vs->inputBuffer, vs->iosb[1]);
 607               InsCStr (vs->inputBuffer, vs->iosb[1]);
 608             }
 609           if (!NILP (display) && INTERACTIVE)
 610           redisplay_preserve_echo_area ();
 611           immediate_quit = 1;
 612           QUIT;
 613           if (!start_vms_process_read (vs))
 614             break;              /* The other side went away */
 615         }
 616       else
 617         break;
 618     }
 619
 620   sys$dassgn (inchannel);
 621   sys$dassgn (outchannel);
 622   give_back_vms_process_stuff (vs);
 623
 624   /* Wait for it to terminate, unless it already has.  */
 625   wait_for_termination (pid);
 626
 627   immediate_quit = 0;
 628
 629   set_current_buffer (old);
 630
 631   return unbind_to (count, Qnil);
 632 }
 633
 634 create_process (process, new_argv)
 635      Lisp_Object process;
 636      char *new_argv;
 637 {
 638   int pid, inchannel, outchannel, forkin, forkout;
 639   char old_dir[512];
 640   char in_dev_name[65];
 641   char out_dev_name[65];
 642   short iosb[4];
 643   int status;
 644   int spawn_flags = CLI$M_NOWAIT;
 645   int child_sig ();
 646   struct {
 647     int l;
 648     char *a;
 649   } din, dout, dprompt, dcmd;
 650   VMS_PROC_STUFF *vs;
 651   VMS_PROC_STUFF *get_vms_process_stuff ();
 652
 653   status = get_pty_channel (in_dev_name, out_dev_name, &inchannel, &outchannel);
 654   if (!(status & 1))
 655     {
 656       remove_process (process);
 657       error ("Error getting PTY channel: %x", status);
 658     }
 659   dout.l = strlen (out_dev_name);
 660   dout.a = out_dev_name;
 661   dprompt.l = strlen (DCL_PROMPT);
 662   dprompt.a = DCL_PROMPT;
 663
 664   if (strcmp (new_argv, "*dcl*") == 0)
 665     {
 666       din.l = strlen (in_dev_name);
 667       din.a = in_dev_name;
 668       dcmd.l = 0;
 669       dcmd.a = (char *)0;
 670     }
 671   else
 672     {
 673       din.l = strlen ("NLA0:");
 674       din.a = "NLA0:";
 675       dcmd.l = strlen (new_argv);
 676       dcmd.a = new_argv;
 677     }
 678
 679   /* Delay interrupts until we have a chance to store
 680      the new fork's pid in its process structure */
 681   sys$setast (0);
 682
 683   vs = get_vms_process_stuff ();
 684   if (vs == 0)
 685     {
 686       sys$setast (1);
 687       remove_process (process);
 688       error ("Too many VMS processes");
 689     }
 690   vs->inputChan = inchannel;
 691   vs->outputChan = outchannel;
 692
 693   /* Start a read on the process channel */
 694   start_vms_process_read (vs);
 695
 696   /* Switch current directory so that the child inherits it. */
 697   VMSgetwd (old_dir);
 698   child_setup (0, 0, 0, 0, 0);
 699
 700   status = lib$spawn (&dcmd, &din, &dout, &spawn_flags, 0, &vs->pid,
 701                       &vs->exitStatus, 0, child_sig, vs, &dprompt);
 702   chdir (old_dir);
 703
 704   if (status != SS$_NORMAL)
 705     {
 706       sys$setast (1);
 707       remove_process (process);
 708       error ("Error calling LIB$SPAWN: %x", status);
 709     }
 710   vs->pid &= 0xffff;            /* It needs to fit in a FASTINT,
 711                                    we don't need the rest of the bits */
 712   pid = vs->pid;
 713
 714   /*
 715     ON VMS process->infd holds the (event flag-1)
 716     that we use for doing I/O on that process.
 717     `input_wait_mask' is the cluster of event flags
 718     we can wait on.
 719
 720     Event flags returned start at 1 for the keyboard.
 721     Since Unix expects descriptor 0 for the keyboard,
 722     we substract one from the event flag.
 723     */
 724   inchannel = vs->eventFlag-1;
 725
 726   /* Record this as an active process, with its channels.
 727      As a result, child_setup will close Emacs's side of the pipes.  */
 728   chan_process[inchannel] = process;
 729   XFASTINT (XPROCESS (process)->infd) = inchannel;
 730   XFASTINT (XPROCESS (process)->outfd) = outchannel;
 731   XPROCESS (process)->status = Qrun
 732
 733   /* Delay interrupts until we have a chance to store
 734      the new fork's pid in its process structure */
 735
 736 #define NO_ECHO         "set term/noecho\r"
 737   sys$setast (0);
 738   /*
 739     Send a command to the process to not echo input
 740
 741     The CMU PTY driver does not support SETMODEs.
 742     */
 743   write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO));
 744
 745   XFASTINT (XPROCESS (process)->pid) = pid;
 746   sys$setast (1);
 747 }
 748
 749 child_sig (vs)
 750      VMS_PROC_STUFF *vs;
 751 {
 752   register int pid;
 753   Lisp_Object tail, proc;
 754   register struct Lisp_Process *p;
 755   int old_errno = errno;
 756
 757   pid = vs->pid;
 758   sys$setef (vs->eventFlag);
 759
 760   for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
 761     {
 762       proc = XCONS (XCONS (tail)->car)->cdr;
 763       p = XPROCESS (proc);
 764       if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
 765         break;
 766     }
 767
 768   if (XSYMBOL (tail) == XSYMBOL (Qnil))
 769     return;
 770
 771   p->status = Fcons (Qexit, Fcons (make_number (vs->exitStatus), Qnil))
 772 }
 773
 774 syms_of_vmsproc ()
 775 {
 776   defsubr (&Scall_process);
 777 }
 778
 779 init_vmsproc ()
 780 {
 781   char *malloc ();
 782   int i;
 783   VMS_PROC_STUFF *vs;
 784
 785   for (vs=procList, i=0; i<MAX_EVENT_FLAGS+1; i++, vs++)
 786     {
 787       vs->busy = 0;
 788       vs->eventFlag = i;
 789       sys$clref (i);
 790       vs->inputChan = 0;
 791       vs->pid = 0;
 792     }
 793   procList[0].busy = 1;         /* Zero is reserved */
 794 }