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