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