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 || NULL (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   record_unwind_protect (call_process_cleanup,
 577                          Fcons (make_number (fd[0]), make_number (pid)));
 578
 579
 580   if (XTYPE (buffer) == Lisp_Buffer)
 581     Fset_buffer (buffer);
 582
 583   immediate_quit = 1;
 584   QUIT;
 585
 586   while (1)
 587     {
 588       sys$waitfr (vs->eventFlag);
 589       if (vs->iosb[0] & 1)
 590         {
 591           immediate_quit = 0;
 592           if (!NULL (buffer))
 593             {
 594               vs->iosb[1] = clean_vms_buffer (vs->inputBuffer, vs->iosb[1]);
 595               InsCStr (vs->inputBuffer, vs->iosb[1]);
 596             }
 597           if (!NULL (display) && INTERACTIVE)
 598           redisplay_preserve_echo_area ();
 599           immediate_quit = 1;
 600           QUIT;
 601           if (!start_vms_process_read (vs))
 602             break;              /* The other side went away */
 603         }
 604       else
 605         break;
 606     }
 607     sys$dassgn (inchannel);
 608     sys$dassgn (outchannel);
 609     give_back_vms_process_stuff (vs);
 610
 611   /* Wait for it to terminate, unless it already has.  */
 612   wait_for_termination (pid);
 613
 614   immediate_quit = 0;
 615
 616   set_current_buffer (old);
 617
 618   unbind_to (count);
 619
 620   return Qnil;
 621 }
 622
 623 create_process (process, new_argv)
 624      Lisp_Object process;
 625      char *new_argv;
 626 {
 627   int pid, inchannel, outchannel, forkin, forkout;
 628   char old_dir[512];
 629   char in_dev_name[65];
 630   char out_dev_name[65];
 631   short iosb[4];
 632   int status;
 633   int spawn_flags = CLI$M_NOWAIT;
 634   int child_sig ();
 635   struct {
 636     int l;
 637     char *a;
 638   } din, dout, dprompt, dcmd;
 639   VMS_PROC_STUFF *vs;
 640   VMS_PROC_STUFF *get_vms_process_stuff ();
 641
 642   status = get_pty_channel (in_dev_name, out_dev_name, &inchannel, &outchannel);
 643   if (!(status & 1))
 644     {
 645       remove_process (process);
 646       error ("Error getting PTY channel: %x", status);
 647     }
 648   dout.l = strlen (out_dev_name);
 649   dout.a = out_dev_name;
 650   dprompt.l = strlen (DCL_PROMPT);
 651   dprompt.a = DCL_PROMPT;
 652
 653   if (strcmp (new_argv, "*dcl*") == 0)
 654     {
 655       din.l = strlen (in_dev_name);
 656       din.a = in_dev_name;
 657       dcmd.l = 0;
 658       dcmd.a = (char *)0;
 659     }
 660   else
 661     {
 662       din.l = strlen ("NLA0:");
 663       din.a = "NLA0:";
 664       dcmd.l = strlen (new_argv);
 665       dcmd.a = new_argv;
 666     }
 667
 668   /* Delay interrupts until we have a chance to store
 669      the new fork's pid in its process structure */
 670   sys$setast (0);
 671
 672   vs = get_vms_process_stuff ();
 673   if (vs == 0)
 674     {
 675       sys$setast (1);
 676       remove_process (process);
 677       error ("Too many VMS processes");
 678     }
 679   vs->inputChan = inchannel;
 680   vs->outputChan = outchannel;
 681
 682   /* Start a read on the process channel */
 683   start_vms_process_read (vs);
 684
 685   /* Switch current directory so that the child inherits it. */
 686   VMSgetwd (old_dir);
 687   child_setup (0, 0, 0, 0, 0);
 688
 689   status = lib$spawn (&dcmd, &din, &dout, &spawn_flags, 0, &vs->pid,
 690                       &vs->exitStatus, 0, child_sig, vs, &dprompt);
 691   chdir (old_dir);
 692
 693   if (status != SS$_NORMAL)
 694     {
 695       sys$setast (1);
 696       remove_process (process);
 697       error ("Error calling LIB$SPAWN: %x", status);
 698     }
 699   vs->pid &= 0xffff;            /* It needs to fit in a FASTINT,
 700                                    we don't need the rest of the bits */
 701   pid = vs->pid;
 702
 703   /*
 704     ON VMS process->infd holds the (event flag-1)
 705     that we use for doing I/O on that process.
 706     `input_wait_mask' is the cluster of event flags
 707     we can wait on.
 708
 709     Event flags returned start at 1 for the keyboard.
 710     Since Unix expects descriptor 0 for the keyboard,
 711     we substract one from the event flag.
 712     */
 713   inchannel = vs->eventFlag-1;
 714
 715   /* Record this as an active process, with its channels.
 716      As a result, child_setup will close Emacs's side of the pipes.  */
 717   chan_process[inchannel] = process;
 718   XFASTINT (XPROCESS (process)->infd) = inchannel;
 719   XFASTINT (XPROCESS (process)->outfd) = outchannel;
 720   XFASTINT (XPROCESS (process)->flags) = RUNNING;
 721
 722   /* Delay interrupts until we have a chance to store
 723      the new fork's pid in its process structure */
 724
 725 #define NO_ECHO         "set term/noecho\r"
 726   sys$setast (0);
 727   /*
 728     Send a command to the process to not echo input
 729
 730     The CMU PTY driver does not support SETMODEs.
 731     */
 732   write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO));
 733
 734   XFASTINT (XPROCESS (process)->pid) = pid;
 735   sys$setast (1);
 736 }
 737
 738 child_sig (vs)
 739      VMS_PROC_STUFF *vs;
 740 {
 741   register int pid;
 742   Lisp_Object tail, proc;
 743   register struct Lisp_Process *p;
 744   int old_errno = errno;
 745
 746   pid = vs->pid;
 747   sys$setef (vs->eventFlag);
 748
 749   for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
 750     {
 751       proc = XCONS (XCONS (tail)->car)->cdr;
 752       p = XPROCESS (proc);
 753       if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
 754         break;
 755     }
 756
 757   if (XSYMBOL (tail) == XSYMBOL (Qnil))
 758     return;
 759
 760   child_changed++;
 761   XFASTINT (p->flags) = EXITED | CHANGED;
 762   /* Truncate the exit status to 24 bits so that it fits in a FASTINT */
 763   XFASTINT (p->reason) = (vs->exitStatus) & 0xffffff;
 764 }
 765
 766 syms_of_vmsproc ()
 767 {
 768   defsubr (&Scall_process);
 769 }
 770
 771 init_vmsproc ()
 772 {
 773   char *malloc ();
 774   int i;
 775   VMS_PROC_STUFF *vs;
 776
 777   for (vs=procList, i=0; i<MAX_EVENT_FLAGS+1; i++, vs++)
 778     {
 779       vs->busy = 0;
 780       vs->eventFlag = i;
 781       sys$clref (i);
 782       vs->inputChan = 0;
 783       vs->pid = 0;
 784     }
 785   procList[0].busy = 1;         /* Zero is reserved */
 786 }