DataMuseum.dk

top - download

    Length: 9823 (0x265f)
    Types: TextFile
    Names: »process.c«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/microcode/process.c« 

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1986                    *
*               Massachusetts Institute of Technology           *
*                                                               *
* This material was developed by the Scheme project at the      *
* Massachusetts Institute of Technology, Department of          *
* Electrical Engineering and Computer Science.  Permission to   *
* copy this software, to redistribute it, and to use it for any *
* purpose is granted, subject to the following restrictions and *
* understandings.                                               *
*                                                               *
* 1. Any copy made of this software must include this copyright *
* notice in full.                                               *
*                                                               *
* 2. Users of this software agree to make their best efforts (a)*
* to return to the MIT Scheme project any improvements or       *
* extensions that they make, so that these may be included in   *
* future releases; and (b) to inform MIT of noteworthy uses of  *
* this software.                                                *
*                                                               *
* 3.  All materials developed as a consequence of the use of    *
* this software shall duly acknowledge such use, in accordance  *
* with the usual standards of acknowledging credit in academic  *
* research.                                                     *
*                                                               *
* 4. MIT has made no warrantee or representation that the       *
* operation of this software will be error-free, and MIT is     *
* under no obligation to provide any services, by way of        *
* maintenance, update, or otherwise.                            *
*                                                               *
* 5.  In conjunction with products arising from the use of this *
* material, there shall be no use of the name of the            *
* Massachusetts Institute of Technology nor of any adaptation   *
* thereof in any advertising, promotional, or sales literature  *
* without prior written consent from MIT in each case.          *
*                                                               *
****************************************************************/

/* File: PROCESS.C
 *
 * Utilities for invoking inferior processes
 *
 */
\f


#ifdef bsd
#include <strings.h>
#include <sys/wait.h>
#define Wait_Type		union wait
#define STOPSIG(s)		(s.w_stopsig)
#define TERMSIG(s)		(s.w_termsig)
#define RETCODE(s)		(s.w_retcode)
#else
#include <string.h>
#define Wait_Type		int
#define wait3(x, y, z)		wait(x)
#define WIFEXITED(w)		((w & 0377) == 0)
#define WIFSTOPPED(w)		((w & 0377) == 0177)
#define STOPSIG(w)		((w >> 8) & 0377)
#define TERMSIG(w)		(w & 0377)
#define RETCODE(w)		((w >> 8) & 0377)
#define SIGCONT			-1
#define TTIN_MASK		0
#define TTOUT_MASK		0
#define getpgrp(x)		x
#define killpg			kill
#define index			strchr
#endif

#ifdef hpux
#include <fcntl.h>
#endif

#include <signal.h>
#include <sgtty.h>
#include <sys/file.h>
#include "scheme.h"
#include "primitive.h"

#define NO_STATUS             0
#define ERR_RETURNED         -1

extern int errno;

#if (defined(bsd) || defined(hpux) || defined(TRIX))
#define fork()		vfork()
#endif

#if defined(SIGTTIN) && defined(SIGTTOU)

#define TTIN_MASK	(1 << (SIGTTIN - 1))
#define TTOUT_MASK	(1 << (SIGTTOU - 1))

/* Moby Hair here.  We have to change the group of the child
   process so that if scheme is suspended and then restarted, the
   children won't all get restarted as well.  The problem lies in that
   only one group of processes can control the terminal at one time.
   Hence, we switch control of the terminal to the child process
   when they are created and restarted.  Care must be taken to assure
   that control of the terminal is resumed to scheme when the child
   dies or suspends.
   In order to make sure scheme doesn't die when it finds out that
   one of it's children has taken over control of the terminal, we must
   block the TTIN and TTOU signals.
   Isn't job control under UNIX great?
 */

void give_terminal_control(pgrp)
long pgrp;
{ ioctl(fileno(stdout), TIOCSPGRP, &pgrp);
  ioctl(fileno(stdin), TIOCSPGRP, &pgrp);
}

#else
#define give_terminal_control(pgrp)
#endif
\f


long Basic_Exec(Arg)
Pointer Arg;
{ int status, argc, child;
  long pgrp;
  char *C_String;
  char *scan, *orig;
  char storage[1000];
  char *name, *(argv[20]), temp[FILE_NAME_LENGTH];

  scan = storage;
  orig = scan;

  C_String = Scheme_String_To_C_String(Arg);
  /* Copy the string into scan */
  while (*scan++ = *C_String++) ;

  scan = orig;

  for (argc = 0, argv[0] = scan; *scan != '\0'; scan++)
    if (*scan == ' ')
      { *scan = '\0';
	scan++;
	argv[++argc] = scan;
      }
  argv[++argc] = '\0';
  /* Seek out the pathname of the program to run */
  find_pathname(argv[0], temp);

  argv[0] = temp;
  /* Block the signals that would make scheme die when the child got
     control of the terminal.
  */
  sigblock(sigsetmask(0) | TTIN_MASK | TTOUT_MASK);
  if ((child = fork()) == 0)
  { setpgrp(child, getpid());
    give_terminal_control(getpgrp(child));
    execv(argv[0], argv);
    fprintf(stderr, "\nExecl error, ERRNO is %d.", errno);
    /* Make sure to do _exit and not exit or else you will mess up the
       parent process
    */
    _exit(1);
  }
  return child;
}
\f


Define_Primitive(Prim_Spawn, 1, "SPAWN")
/* SPAWN spawns a child process.  It is left up to the 
   runtime system to pause the appropriate processes
   (ie. parent or child)
*/
{ Primitive_1_Arg();
  Arg_1_Type(TC_CHARACTER_STRING);
  return C_Integer_To_Scheme_Integer(Basic_Exec(Arg1));
}

Define_Primitive(Prim_Exec, 1, "EXEC")
/* EXEC differs from spawn in that it causes a child process to
   be started, and proceeds to give all control to that process
   until its completion
*/
{ Wait_Type status;
  int temp;
  Primitive_1_Arg();

  Arg_1_Type(TC_CHARACTER_STRING);
  Basic_Exec(Arg1);
  temp = wait(&status);
  /* child had control of the terminal, now return control to scheme */
  give_terminal_control(getpgrp(0));
  if (temp == ERR_RETURNED)
  Primitive_Error(ERR_EXTERNAL_RETURN);
  if WIFEXITED(status) return NIL;
  Primitive_Error(ERR_EXTERNAL_RETURN);     
}

listen_for_child()
{ return;
}

#ifndef SIGCHLD
#define SIGCHLD SIGCLD
#endif

Define_Primitive(Prim_Pause, 0, "PAUSE")
{ int (*old_CHLD_handler)();
  old_CHLD_handler = signal(SIGCHLD, listen_for_child);
  pause();
  /* Return terminal control to Scheme */
  signal(SIGCHLD, old_CHLD_handler);
  give_terminal_control(getpgrp(0));
  return TRUTH;
}
\f


Define_Primitive(Prim_Wait, 0, "WAIT")
{ long pid;
  Wait_Type status;
  Pointer *Old_Free;
  Pointer end_sig, ret_code;
  Pointer Process_Id;
  Primitive_1_Arg();

  Primitive_GC_If_Needed(Free+4);
  pid = wait3(&status, (WNOHANG | WUNTRACED), 0);
  if (pid == NO_STATUS || pid == ERR_RETURNED)
    { end_sig = NIL;
      ret_code = NIL;
    }
  else if WIFSTOPPED(status)
    { end_sig = C_Integer_To_Scheme_Integer(STOPSIG(status));
      ret_code = NIL;
    }
  else 
    { end_sig = C_Integer_To_Scheme_Integer(TERMSIG(status));
      ret_code = C_Integer_To_Scheme_Integer(RETCODE(status));
    }
  Process_Id = C_Integer_To_Scheme_Integer(pid);
  Old_Free = Free;
  *Free++ = Make_Non_Pointer(TC_MANIFEST_VECTOR, 3);
  *Free++ = Process_Id;
  *Free++ = end_sig;
  *Free++ = ret_code;
  /* Return terminal Control to Scheme */
  give_terminal_control(getpgrp(0));
  return Make_Pointer(TC_VECTOR, Old_Free);
}

/* I don't care what the UNIX manual says, the thing that sends
   a signal to a process should be called "signal", not "kill".
*/
Define_Primitive(Prim_Signal, 2, "SIGNAL")
{ long pid, pgrp, sig;
  Primitive_2_Args();

  Scheme_Integer_To_C_Integer(Arg1, &pid);
  Scheme_Integer_To_C_Integer(Arg2, &sig);
  pgrp = getpgrp(pid);
  if (sig == SIGCONT) 
    { sigblock(sigsetmask(0) | TTIN_MASK | TTOUT_MASK);
      /* give terminal control to child */
      give_terminal_control(pgrp);
    }
  if (killpg(pgrp, sig) == 0) return TRUTH;
  fprintf(stderr, "\nkill error, ERRNO is %d", errno);
  Primitive_Error(ERR_EXTERNAL_RETURN);
}
\f


Define_Primitive(Prim_Get_Env_Var, 1, "GET-ENVIRONMENT-VARIABLE")
/* Looks up in the user's shell environment the value of the 
   variable specified as a string.
*/
{  extern char *getenv();
   Primitive_1_Arg();

   Arg_1_Type(TC_CHARACTER_STRING);
   return C_String_To_Scheme_String(getenv(Scheme_String_To_C_String(Arg1)));
}

/* Finding the home of a program specified by name */

/* Check whether a file exists */

Boolean file_exists(name)
char *name;
{ int desc;
  if ((desc = open(name, O_RDONLY|O_NDELAY, 0)) != -1)
  { close(desc);
    return true;
  }
  return false;
}

/* Find the correct file. */

find_pathname(program_name, target)
char *program_name, *target;
{ extern char *getenv();
  char *path, *next;
  int length;

  /* Attempt first in the home directory */

  if ((program_name[0] == '/') ||		/* Absolute path */
      (file_exists(program_name)) ||		/* In current directory */
      ((path = getenv("PATH")) == NULL))
    strcpy(target, program_name);
  for (next = index(path, ':') ;
       path != NULL;
       path = next+1, next = index(path, ':'))
    { length = ((next == NULL) ? strlen(path) : (next-path));
      strncpy(target, path, length);
      target[length] = '/';
      target[length+1] = '\0';
      strcpy(&target[length+1], program_name);
      if (file_exists(target)) return;
    }
  strcpy(target, program_name);
}