//! @file genie-unix.c
//! @author J. Marcel van der Veer

//! @section Copyright
//!
//! This file is part of Algol68G - an Algol 68 compiler-interpreter.
//! Copyright 2001-2026 J. Marcel van der Veer [algol68g@xs4all.nl].

//! @section License
//!
//! This program is free software; you can redistribute it and/or modify it 
//! under the terms of the GNU General Public License as published by the 
//! Free Software Foundation; either version 3 of the License, or 
//! (at your option) any later version.
//!
//! This program is distributed in the hope that it will be useful, but 
//! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
//! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
//! more details. You should have received a copy of the GNU General Public 
//! License along with this program. If not, see [http://www.gnu.org/licenses/].

//! @section Synopsis
//!
//! Low-level UNIX routines.

#include "a68g.h"
#include "a68g-genie.h"
#include "a68g-prelude.h"
#include "a68g-transput.h"

#define VECTOR_SIZE 512
#define FD_READ 0
#define FD_WRITE 1

#if defined (HAVE_DIRENT_H)

//! @brief PROC (STRING) [] STRING directory

void genie_directory (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
    PUSH_VALUE (p, A68G_MAX_INT, A68G_INT);
  } else {
    char *dir_name = a_to_c_string (p, buffer, name);
    DIR *dir = opendir (dir_name);
    if (dir == NULL) {
      diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
      exit_genie (p, A68G_RUNTIME_ERROR);
    }
    int n = 0;
    struct dirent *entry;
    do {
      entry = readdir (dir);
      if (errno != 0) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      if (entry != NULL) {
        n++;
      }
    } while (entry != NULL);
    rewinddir (dir);
    if (errno != 0) {
      diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
      exit_genie (p, A68G_RUNTIME_ERROR);
    }
    A68G_REF z, row; A68G_ARRAY arr; A68G_TUPLE tup;
    NEW_ROW_1D (z, row, arr, tup, M_ROW_STRING, M_STRING, n);
    A68G_REF *base = DEREF (A68G_REF, &row);
    for (int k = 0; k < n; k++) {
      entry = readdir (dir);
      if (errno != 0) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      base[k] = c_to_a_string (p, D_NAME (entry), DEFAULT_WIDTH);
    }
    if (closedir (dir) != 0) {
      diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
      exit_genie (p, A68G_RUNTIME_ERROR);
    }
    PUSH_REF (p, z);
    a68g_free (buffer);
  }
}

#endif

//! @brief PROC [] INT utc time

void genie_utctime (NODE_T * p)
{
  time_t dt;
  if (time (&dt) == (time_t) - 1) {
    (void) empty_row (p, M_ROW_INT);
  } else {
    ADDR_T pop_sp = A68G_SP;
    struct tm *tod = gmtime (&dt);
    PUSH_VALUE (p, TM_YEAR (tod) + 1900, A68G_INT);
    PUSH_VALUE (p, TM_MON (tod) + 1, A68G_INT);
    PUSH_VALUE (p, TM_MDAY (tod), A68G_INT);
    PUSH_VALUE (p, TM_HOUR (tod), A68G_INT);
    PUSH_VALUE (p, TM_MIN (tod), A68G_INT);
    PUSH_VALUE (p, TM_SEC (tod), A68G_INT);
    PUSH_VALUE (p, TM_WDAY (tod) + 1, A68G_INT);
    PUSH_VALUE (p, TM_ISDST (tod), A68G_INT);
    A68G_REF row = genie_make_row (p, M_INT, 8, pop_sp);
    A68G_SP = pop_sp;
    PUSH_REF (p, row);
  }
}

//! @brief PROC [] INT local time

void genie_localtime (NODE_T * p)
{
  time_t dt;
  if (time (&dt) == (time_t) - 1) {
    (void) empty_row (p, M_ROW_INT);
  } else {
    ADDR_T pop_sp = A68G_SP;
    struct tm *tod = localtime (&dt);
    PUSH_VALUE (p, TM_YEAR (tod) + 1900, A68G_INT);
    PUSH_VALUE (p, TM_MON (tod) + 1, A68G_INT);
    PUSH_VALUE (p, TM_MDAY (tod), A68G_INT);
    PUSH_VALUE (p, TM_HOUR (tod), A68G_INT);
    PUSH_VALUE (p, TM_MIN (tod), A68G_INT);
    PUSH_VALUE (p, TM_SEC (tod), A68G_INT);
    PUSH_VALUE (p, TM_WDAY (tod) + 1, A68G_INT);
    PUSH_VALUE (p, TM_ISDST (tod), A68G_INT);
    A68G_REF row = genie_make_row (p, M_INT, 8, pop_sp);
    A68G_SP = pop_sp;
    PUSH_REF (p, row);
  }
}

//! @brief PROC INT rows

void genie_rows (NODE_T * p)
{
  errno = 0;
  PUSH_VALUE (p, A68G (term_heigth), A68G_INT);
}

//! @brief PROC INT columns

void genie_columns (NODE_T * p)
{
  errno = 0;
  PUSH_VALUE (p, A68G (term_width), A68G_INT);
}

//! @brief PROC INT argc

void genie_argc (NODE_T * p)
{
  errno = 0;
  PUSH_VALUE (p, A68G (argc), A68G_INT);
}

//! @brief PROC (INT) STRING argv

void genie_argv (NODE_T * p)
{
  errno = 0;
  A68G_INT a68g_index;
  POP_OBJECT (p, &a68g_index, A68G_INT);
  if (VALUE (&a68g_index) >= 1 && VALUE (&a68g_index) <= A68G (argc)) {
    char *q = A68G (argv)[VALUE (&a68g_index) - 1];
// Allow for spaces ending in # to have A68 comment syntax with '#!'.
    size_t n = strlen (q);
    while (n > 0 && (IS_SPACE (q[n - 1]) || q[n - 1] == '#')) {
      q[--n] = NULL_CHAR;
    }
    PUSH_REF (p, c_to_a_string (p, q, DEFAULT_WIDTH));
  } else {
    PUSH_REF (p, empty_string (p));
  }
}

//! @brief Find good argument

int find_good_arg (void)
{
  for (int i = 0; i < A68G (argc); i++) {
    char *q = A68G (argv)[i];
    if (strncmp (q, "--script", 8) == 0) {
      return i + 1;
    }
    if (strncmp (q, "--run-script", 12) == 0) {
      return i + 1;
    }
    if (strcmp (q, "--") == 0) {
      return i;
    }
    if (strcmp (q, "--exit") == 0) {
      return i;
    }
  }
  return 0;
}

//! @brief PROC INT a68g argc

void genie_a68g_argc (NODE_T * p)
{
  errno = 0;
  PUSH_VALUE (p, A68G (argc) - find_good_arg (), A68G_INT);
}

//! @brief PROC (INT) STRING a68g_argv

void genie_a68g_argv (NODE_T * p)
{
  errno = 0;
  A68G_INT a68g_index;
  POP_OBJECT (p, &a68g_index, A68G_INT);
  int k = VALUE (&a68g_index);
  if (k > 1) {
    k += find_good_arg ();
  }
  if (k >= 1 && k <= A68G (argc)) {
    char *q = A68G (argv)[k - 1];
// Allow for spaces ending in # to have A68 comment syntax with '#!'.
    size_t n = strlen (q);
    while (n > 0 && (IS_SPACE (q[n - 1]) || q[n - 1] == '#')) {
      q[--n] = NULL_CHAR;
    }
    PUSH_REF (p, c_to_a_string (p, q, DEFAULT_WIDTH));
  } else {
    PUSH_REF (p, empty_string (p));
  }
}

//! @brief PROC STRING pwd

void genie_pwd (NODE_T * p)
{
  errno = 0;
  char *buffer = NO_TEXT;
  BOOL_T cont = A68G_TRUE;
  size_t size = BUFFER_SIZE;
  while (cont) {
    buffer = (char *) a68g_alloc (size, __func__, __LINE__);
    if (buffer == NO_TEXT) {
      diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
      exit_genie (p, A68G_RUNTIME_ERROR);
    }
    if (getcwd (buffer, size) == buffer) {
      cont = A68G_FALSE;
    } else {
      a68g_free (buffer);
      cont = (BOOL_T) (errno == 0);
      size *= 2;
    }
  }
  if (buffer != NO_TEXT && errno == 0) {
    PUSH_REF (p, c_to_a_string (p, buffer, DEFAULT_WIDTH));
    a68g_free (buffer);
  } else {
    PUSH_REF (p, empty_string (p));
  }
}

//! @brief PROC (STRING) INT cd

void genie_cd (NODE_T * p)
{
  errno = 0;
  A68G_REF dir;
  POP_REF (p, &dir);
  CHECK_INIT (p, INITIALISED (&dir), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, dir), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    int ret = chdir (a_to_c_string (p, buffer, dir));
    if (ret == 0) {
      PUSH_VALUE (p, 0, A68G_INT);
    } else {
      diagnostic (A68G_RUNTIME_ERROR, p, ERROR_FILE_ACCESS);
      exit_genie (p, A68G_RUNTIME_ERROR);
    }
    a68g_free (buffer);
  }
}

//! @brief PROC (STRING) BITS

void genie_file_mode (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (unt) (ST_MODE (&status)), A68G_BITS);
    } else {
      PUSH_VALUE (p, 0x0, A68G_BITS);
    }
    a68g_free (buffer);
  }
}

//! @brief PROC (STRING) BOOL file is block device

void genie_file_is_block_device (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISBLK (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

//! @brief PROC (STRING) BOOL file is char device

void genie_file_is_char_device (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISCHR (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

//! @brief PROC (STRING) BOOL file is directory

void genie_file_is_directory (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISDIR (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

//! @brief PROC (STRING) BOOL file is regular

void genie_file_is_regular (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISREG (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

#if defined (S_ISFIFO)

//! @brief PROC (STRING) BOOL file is fifo

void genie_file_is_fifo (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISFIFO (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

#endif

#if defined (S_ISLNK)

//! @brief PROC (STRING) BOOL file is link

void genie_file_is_link (NODE_T * p)
{
  errno = 0;
  A68G_REF name;
  POP_REF (p, &name);
  CHECK_INIT (p, INITIALISED (&name), M_STRING);
  char *buffer = (char *) a68g_alloc (1 + a68g_string_size (p, name), __func__, __LINE__);
  if (buffer == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_MEMORY_FULL);
    exit_genie (p, A68G_RUNTIME_ERROR);
  } else {
    struct stat status;
    if (stat (a_to_c_string (p, buffer, name), &status) == 0) {
      PUSH_VALUE (p, (BOOL_T) (S_ISLNK (ST_MODE (&status)) != 0 ? A68G_TRUE : A68G_FALSE), A68G_BOOL);
    } else {
      PUSH_VALUE (p, A68G_FALSE, A68G_BOOL);
    }
    a68g_free (buffer);
  }
}

#endif

//! @brief Convert [] STRING row to char *vec[].

void convert_string_vector (NODE_T * p, char *vec[], A68G_REF row)
{
  BYTE_T *z = ADDRESS (&row);
  A68G_ARRAY *arr = (A68G_ARRAY *) & z[0];
  A68G_TUPLE *tup = (A68G_TUPLE *) & z[SIZE_ALIGNED (A68G_ARRAY)];
  int k = 0;
  if (get_row_size (tup, DIM (arr)) > 0) {
    BYTE_T *base_addr = DEREF (BYTE_T, &ARRAY (arr));
    BOOL_T done = A68G_FALSE;
    initialise_internal_index (tup, DIM (arr));
    while (!done) {
      ADDR_T a68g_index = calculate_internal_index (tup, DIM (arr));
      ADDR_T elem_addr = (a68g_index + SLICE_OFFSET (arr)) * SLICE_SIZE (arr) + FIELD_OFFSET (arr);
      BYTE_T *elem = &base_addr[elem_addr];
      size_t size = a68g_string_size (p, *(A68G_REF *) elem);
      CHECK_INIT (p, INITIALISED ((A68G_REF *) elem), M_STRING);
      vec[k] = (char *) get_heap_space (1 + size);
      ASSERT (a_to_c_string (p, vec[k], *(A68G_REF *) elem) != NO_TEXT);
      if (k == VECTOR_SIZE - 1) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_TOO_MANY_ARGUMENTS);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      if (strlen (vec[k]) > 0) {
        k++;
      }
      done = increment_internal_index (tup, DIM (arr));
    }
  }
  vec[k] = NO_TEXT;
}

//! @brief Free char *vec[].

void free_vector (char *vec[])
{
  int k = 0;
  while (vec[k] != NO_TEXT) {
    a68g_free (vec[k]);
    k++;
  }
}

//! @brief Reset error number.

void genie_reset_errno (NODE_T * p)
{
  (void) *p;
  errno = 0;
}

//! @brief Error number.

void genie_errno (NODE_T * p)
{
  PUSH_VALUE (p, errno, A68G_INT);
}

//! @brief PROC strerror = (INT) STRING

void genie_strerror (NODE_T * p)
{
  A68G_INT i;
  POP_OBJECT (p, &i, A68G_INT);
  PUSH_REF (p, c_to_a_string (p, strerror (VALUE (&i)), DEFAULT_WIDTH));
}

//! @brief Set up file for usage in pipe.

void set_up_file (NODE_T * p, A68G_REF * z, int fd, A68G_CHANNEL chan, BOOL_T r_mood, BOOL_T w_mood, int pid)
{
  *z = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
  A68G_FILE *f = FILE_DEREF (z);
  STATUS (f) = (STATUS_MASK_T) ((pid < 0) ? 0 : INIT_MASK);
  IDENTIFICATION (f) = nil_ref;
  TERMINATOR (f) = nil_ref;
  CHANNEL (f) = chan;
  FD (f) = fd;
  STREAM (&DEVICE (f)) = NO_STREAM;
  OPENED (f) = A68G_TRUE;
  APPEND (f) = A68G_FALSE;
  OPEN_EXCLUSIVE (f) = A68G_FALSE;
  READ_MOOD (f) = r_mood;
  WRITE_MOOD (f) = w_mood;
  CHAR_MOOD (f) = A68G_TRUE;
  DRAW_MOOD (f) = A68G_FALSE;
  FORMAT (f) = nil_format;
  TRANSPUT_BUFFER (f) = get_unblocked_transput_buffer (p);
  STRING (f) = nil_ref;
  reset_transput_buffer (TRANSPUT_BUFFER (f));
  set_default_event_procedures (f);
}

//! @brief Create and push a pipe.

void genie_mkpipe (NODE_T * p, int fd_r, int fd_w, int pid)
{
  errno = 0;
  A68G_REF r, w;
  set_up_file (p, &r, fd_r, A68G (stand_in_channel), A68G_TRUE, A68G_FALSE, pid);
  set_up_file (p, &w, fd_w, A68G (stand_out_channel), A68G_FALSE, A68G_TRUE, pid);
  PUSH_REF (p, r);
  PUSH_REF (p, w);
  PUSH_VALUE (p, pid, A68G_INT);
}

//! @brief Push an environment string.

void genie_getenv (NODE_T * p)
{
  errno = 0;
  A68G_REF a_env;
  POP_REF (p, &a_env);
  CHECK_INIT (p, INITIALISED (&a_env), M_STRING);
  char *z_env = (char *) get_heap_space (1 + a68g_string_size (p, a_env));
  char *z = a_to_c_string (p, z_env, a_env);
  char *val = getenv (z);
  if (val == NO_TEXT) {
    a_env = empty_string (p);
  } else {
    a_env = tmp_to_a68g_string (p, val);
  }
  PUSH_REF (p, a_env);
}

//! @brief PROC fork = INT

void genie_fork (NODE_T * p)
{
  #if defined (BUILD_WINDOWS)
    PUSH_VALUE (p, -1, A68G_INT);
  #else
    errno = 0;
    int pid = (int) fork ();
    PUSH_VALUE (p, pid, A68G_INT);
  #endif
}

//! @brief PROC execve = (STRING, [] STRING, [] STRING) INT 

void genie_exec (NODE_T * p)
{
  errno = 0;
// Pop parameters.
  A68G_REF a_prog, a_args, a_env;
  POP_REF (p, &a_env);
  POP_REF (p, &a_args);
  POP_REF (p, &a_prog);
// Convert strings and hasta el infinito.
  char *prog = (char *) get_heap_space (1 + a68g_string_size (p, a_prog));
  ASSERT (a_to_c_string (p, prog, a_prog) != NO_TEXT);
  char *argv[VECTOR_SIZE], *envp[VECTOR_SIZE];
  convert_string_vector (p, argv, a_args);
  convert_string_vector (p, envp, a_env);
  if (argv[0] == NO_TEXT) {
    diagnostic (A68G_RUNTIME_ERROR, p, ERROR_EMPTY_ARGUMENT);
    exit_genie (p, A68G_RUNTIME_ERROR);
  }
  int ret = execve (prog, argv, envp);
// execve only returns if it fails.
  free_vector (argv);
  free_vector (envp);
  a68g_free (prog);
  PUSH_VALUE (p, ret, A68G_INT);
}

//! @brief PROC execve child = (STRING, [] STRING, [] STRING) INT

void genie_exec_sub (NODE_T * p)
{
  errno = 0;
  A68G_REF a_prog, a_args, a_env;
// Pop parameters.
  POP_REF (p, &a_env);
  POP_REF (p, &a_args);
  POP_REF (p, &a_prog);
// Now create the pipes and fork.
  #if defined (BUILD_WINDOWS)
    int pid = -1;
    (void) pid;
    PUSH_VALUE (p, -1, A68G_INT);
    return;
  #else
    int pid = (int) fork ();
    if (pid == -1) {
      PUSH_VALUE (p, -1, A68G_INT);
    } else if (pid == 0) {
// Child process.
      char *prog = (char *) get_heap_space (1 + a68g_string_size (p, a_prog));
      ASSERT (a_to_c_string (p, prog, a_prog) != NO_TEXT);
      char *argv[VECTOR_SIZE], *envp[VECTOR_SIZE];
      convert_string_vector (p, argv, a_args);
      convert_string_vector (p, envp, a_env);
      if (argv[0] == NO_TEXT) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_EMPTY_ARGUMENT);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      (void) execve (prog, argv, envp);
// execve only returns if it fails - end child process.
      a68g_exit (EXIT_FAILURE);
      PUSH_VALUE (p, 0, A68G_INT);
    } else {
// parent process.
      PUSH_VALUE (p, pid, A68G_INT);
    }
  #endif
}

//! @brief PROC execve child pipe = (STRING, [] STRING, [] STRING) PIPE

void genie_exec_sub_pipeline (NODE_T * p)
{
// Child redirects STDIN and STDOUT.
// Return a PIPE that contains the descriptors for the parent.
// 
//        pipe ptoc
//        ->W...R->
//  PARENT         CHILD
//        <-R...W<-
//        pipe ctop
  errno = 0;
  A68G_REF a_prog, a_args, a_env;
  POP_REF (p, &a_env);
  POP_REF (p, &a_args);
  POP_REF (p, &a_prog);
  #if !defined (BUILD_UNIX)
    int pid = -1;
    (void) pid;
    genie_mkpipe (p, A68G_NO_FILE, A68G_NO_FILE, -1);
    return;
  #else
// Create the pipes and fork.
    int ptoc_fd[2], ctop_fd[2];
    if ((pipe (ptoc_fd) == -1) || (pipe (ctop_fd) == -1)) {
      genie_mkpipe (p, A68G_NO_FILE, A68G_NO_FILE, -1);
      return;
    }
    int pid = (int) fork ();
    if (pid == -1) {
// Fork failure.
      genie_mkpipe (p, A68G_NO_FILE, A68G_NO_FILE, -1);
      return;
    }
    if (pid == 0) {
// Child process.
// Convert  strings.
      char *prog = (char *) get_heap_space (1 + a68g_string_size (p, a_prog));
      ASSERT (a_to_c_string (p, prog, a_prog) != NO_TEXT);
      char *argv[VECTOR_SIZE], *envp[VECTOR_SIZE];
      convert_string_vector (p, argv, a_args);
      convert_string_vector (p, envp, a_env);
// Set up redirection.
      ASSERT (close (ctop_fd[FD_READ]) == 0);
      ASSERT (close (ptoc_fd[FD_WRITE]) == 0);
      ASSERT (close (A68G_STDIN) == 0);
      ASSERT (close (A68G_STDOUT) == 0);
      ASSERT (dup2 (ptoc_fd[FD_READ], A68G_STDIN) != A68G_NO_FILE);
      ASSERT (dup2 (ctop_fd[FD_WRITE], A68G_STDOUT) != A68G_NO_FILE);
      if (argv[0] == NO_TEXT) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_EMPTY_ARGUMENT);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      (void) execve (prog, argv, envp);
// execve only returns if it fails - end child process.
      a68g_exit (EXIT_FAILURE);
      genie_mkpipe (p, A68G_NO_FILE, A68G_NO_FILE, -1);
    } else {
// Parent process.
      ASSERT (close (ptoc_fd[FD_READ]) == 0);
      ASSERT (close (ctop_fd[FD_WRITE]) == 0);
      genie_mkpipe (p, ctop_fd[FD_READ], ptoc_fd[FD_WRITE], pid);
    }
  #endif
}

//! @brief PROC execve output = (STRING, [] STRING, [] STRING, REF_STRING) INT

void genie_exec_sub_output (NODE_T * p)
{
// Child redirects STDIN and STDOUT.
// 
//        pipe ptoc
//        ->W...R->
//  PARENT         CHILD
//        <-R...W<-
//       pipe ctop
  errno = 0;
  A68G_REF a_prog, a_args, a_env, dest;
  POP_REF (p, &dest);
  POP_REF (p, &a_env);
  POP_REF (p, &a_args);
  POP_REF (p, &a_prog);
  #if !defined (BUILD_UNIX)
    int pid = -1;
    (void) pid;
    PUSH_VALUE (p, -1, A68G_INT);
    return;
  #else
// Create the pipes and fork.
    int ptoc_fd[2], ctop_fd[2];
    if ((pipe (ptoc_fd) == A68G_NO_FILE) || (pipe (ctop_fd) == A68G_NO_FILE)) {
      PUSH_VALUE (p, -1, A68G_INT);
      return;
    }
    int pid = (int) fork ();
    if (pid == -1) {
// Fork failure.
      PUSH_VALUE (p, -1, A68G_INT);
      return;
    }
    if (pid == 0) {
      char *prog = (char *) get_heap_space (1 + a68g_string_size (p, a_prog));
      ASSERT (a_to_c_string (p, prog, a_prog) != NO_TEXT);
      char *argv[VECTOR_SIZE], *envp[VECTOR_SIZE];
      convert_string_vector (p, argv, a_args);
      convert_string_vector (p, envp, a_env);
// Set up redirection.
      ASSERT (close (ctop_fd[FD_READ]) == 0);
      ASSERT (close (ptoc_fd[FD_WRITE]) == 0);
      ASSERT (close (A68G_STDIN) == 0);
      ASSERT (close (A68G_STDOUT) == 0);
      ASSERT (dup2 (ptoc_fd[FD_READ], A68G_STDIN) != A68G_NO_FILE);
      ASSERT (dup2 (ctop_fd[FD_WRITE], A68G_STDOUT) != A68G_NO_FILE);
      if (argv[0] == NO_TEXT) {
        diagnostic (A68G_RUNTIME_ERROR, p, ERROR_EMPTY_ARGUMENT);
        exit_genie (p, A68G_RUNTIME_ERROR);
      }
      (void) execve (prog, argv, envp);
// execve only returns if it fails - end child process.
      a68g_exit (EXIT_FAILURE);
      PUSH_VALUE (p, -1, A68G_INT);
    } else {
// Parent process.
      char ch;
      ASSERT (close (ptoc_fd[FD_READ]) == 0);
      ASSERT (close (ctop_fd[FD_WRITE]) == 0);
      reset_transput_buffer (INPUT_BUFFER);
      int pipe_read, ret, status;
      do {
        pipe_read = (int) io_read_conv (ctop_fd[FD_READ], &ch, 1);
        if (pipe_read > 0) {
          plusab_transput_buffer (p, INPUT_BUFFER, ch);
        }
      } while (pipe_read > 0);
      do {
        ret = (int) waitpid ((a68g_pid_t) pid, &status, 0);
      } while (ret == -1 && errno == EINTR);
      if (ret == pid) {
        if (!IS_NIL (dest)) {
          *DEREF (A68G_REF, &dest) = c_to_a_string (p, get_transput_buffer (INPUT_BUFFER), get_transput_buffer_index (INPUT_BUFFER));
        }
        if (WIFEXITED (status)) {
          PUSH_VALUE (p, WEXITSTATUS (status), A68G_INT);
        } else {
          PUSH_VALUE (p, -1, A68G_INT);
        }
      } else {
        PUSH_VALUE (p, -1, A68G_INT);
      }
      ASSERT (close (ptoc_fd[FD_WRITE]) == 0);
      ASSERT (close (ctop_fd[FD_READ]) == 0);
    }
  #endif
}

//! @brief PROC create pipe = PIPE

void genie_create_pipe (NODE_T * p)
{
  errno = 0;
  genie_stand_in (p);
  genie_stand_out (p);
  PUSH_VALUE (p, -1, A68G_INT);
}

//! @brief PROC wait pid = (INT) VOID

void genie_waitpid (NODE_T * p)
{
  A68G_INT k;
  POP_OBJECT (p, &k, A68G_INT);
  #if defined (BUILD_UNIX)
    errno = 0;
    int rc, status;
    do {
      rc = (int) waitpid ((a68g_pid_t) VALUE (&k), &status, 0);
    } while (rc == -1 && errno == EINTR);
    PUSH_VALUE (p, status, A68G_INT);  
  #else
    errno = ENOTSUP;
    PUSH_VALUE (p, -1, A68G_INT);  
  #endif
}
