src/vmsproc.c

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