/* UNIX specific extensions */


#include "os.h"
#include "mem.h"
#include "strings.h"

#include <stdio.h>
#include <fcntl.h>
#include <sys/types.h>

#ifdef sun
#define pid_t int
#endif


/*---------------------------------------------------------------------------*/

/*
 * This file contains C procedures that are to be made available to the
 * Scheme world.  A special naming convention is used for the procedure
 * names so that any Scheme identifier can be written out (including
 * identifiers with '#' characters).  The procedure 'c_id_to_symbol' in
 * 'strings.c' implements the naming convention.
 *
 * The arguments and results of these procedures are of type 'SCM_obj'.
 * Macros and procedures exist to convert from Scheme data representation
 * to C data representation (see 'gambit.h').
 *
 */


SCM_obj X23X23unixDsystem( str )
SCM_obj str;
{ SCM_obj result;
  char *mark = local_mark();              /* put mark on local C heap    */
  char *command = string_to_c_str( str ); /* convert Scheme string to C  */
  if (command == NULL)
    result = SCM_false;
  else
    result = SCM_int_to_obj( system( command ) );
  local_release( mark );                  /* get rid of converted string */
  return result;
}


/* defined in os.c */

#define MAX_NB_FDS 32
extern OS_FILE file[MAX_NB_OPEN_FILES];


SCM_obj X23X23osDpipeDopen( path, args )
SCM_obj path, args;
{ char *exec_args[100], *mark;
  long i;
  SCM_obj lst = args;
  int j = 1;
  pid_t child_pid;
  int child_to_parent[2], parent_to_child[2];

  for (i=0; i<(long)MAX_NB_OPEN_FILES-1; i++)
    if ((file[i] == -1) && (file[i+1] == -1)) break; /* need 2 slots */
  if (i == (long)MAX_NB_OPEN_FILES-1) return (long)SCM_false;
  mark = local_mark();
  exec_args[0] = os_expand_filename( string_to_c_str(path) );
  if (exec_args[0] == NULL) goto err3;

  while (lst != SCM_null)
  { char *s = string_to_c_str(
                *(SCM_obj *)(lst-SCM_type_PAIR+PAIR_CAR*sizeof(SCM_obj)) );
    exec_args[j++] = s;
    if ((s == NULL) || (j == 100)) goto err3;
    lst = *(SCM_obj *)(lst-SCM_type_PAIR+PAIR_CDR*sizeof(SCM_obj));
  }
  exec_args[j] = NULL;

  if (pipe( child_to_parent ) != 0) goto err3;
  if (pipe( parent_to_child ) != 0) goto err2;

  if ((child_to_parent[0] < 0) || (child_to_parent[0] >= MAX_NB_FDS) ||
      (child_to_parent[1] < 0) || (child_to_parent[1] >= MAX_NB_FDS) ||
      (parent_to_child[0] < 0) || (parent_to_child[0] >= MAX_NB_FDS) ||
      (parent_to_child[1] < 0) || (parent_to_child[1] >= MAX_NB_FDS))
    goto err1;

  child_pid = vfork();
  if (child_pid == -1)
    goto err1;
  else if (child_pid == 0)
  { setpgrp();
    if ((dup2( parent_to_child[0], 0 ) == 0) && /* setup stdin */
        (dup2( child_to_parent[1], 1 ) == 1) && /* setup stdout */
        (dup2( child_to_parent[1], 2 ) == 2) && /* setup stderr */
        (close( child_to_parent[0] ) == 0) &&
        (close( child_to_parent[1] ) == 0) &&
        (close( parent_to_child[0] ) == 0) &&
        (close( parent_to_child[1] ) == 0))
      execv( exec_args[0], exec_args );
    _exit(0);
  }

  if ((close( child_to_parent[1] ) != 0) ||
      (close( parent_to_child[0] ) != 0)) goto err1;

  file[i]   = child_to_parent[0];
  file[i+1] = parent_to_child[1];

  local_release( mark );
  return SCM_int_to_obj(i);

  err1:
  close( parent_to_child[0] );
  close( parent_to_child[1] );

  err2:
  close( child_to_parent[0] );
  close( child_to_parent[1] );

  err3:
  local_release( mark );
  return (long)SCM_false;
}


SCM_obj X23X23osDpipeDclose( ind )
SCM_obj ind;
{ long i = SCM_obj_to_int(ind);
  if ((i>=3) && (i<(long)MAX_NB_OPEN_FILES-1))
  { OS_FILE f1 = file[i], f2 = file[i+1];
    int ok1, ok2;
    file[i] = -1;
    file[i+1] = -1;
    ok1 = ((f1 != -1) && (close( f1 ) == 0));
    ok2 = ((f2 != -1) && (close( f2 ) == 0));
    if (ok1 && ok2)
      return (long)SCM_true;
  }
  return (long)SCM_false;
}


/* Sample use of pipes:


(define (##open-pipe path . args)
  (let ((descr (##os-pipe-open path args)))
    (if descr
      (##make-port descr path 1
        ##os-file-read
        (lambda (descr s i j) (##os-file-write (##fixnum.+ descr 1) s i j))
        ##os-file-read-ready
        ##os-pipe-close
        (##make-string 64 #\space)
        (##make-string 1 #\space))
      #f)))

(define (pwd)  (run "/bin/pwd"))
(define (date) (run "/bin/date"))

(define (run . args)
  (let ((p (##apply ##open-pipe args)))
    (if p
      (let loop ((l '()))
        (let ((x (read-char p)))
          (if (or (eof-object? x) (char=? x #\newline))
            (begin
              (close-input-port p)
              (list->string (reverse l)))
            (loop (cons x l)))))
      #f)))

*/


/*---------------------------------------------------------------------------*/


void ext_init()
{ DEFINE_C_PROC(X23X23unixDsystem);
  DEFINE_C_PROC(X23X23osDpipeDopen);
  DEFINE_C_PROC(X23X23osDpipeDclose);
}


/*---------------------------------------------------------------------------*/