/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library 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
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 * $Id: vmscmd.c,v 1.1 1993/02/09 19:05:49 anders Exp anders $
 */

#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <processes.h>
#include <descrip.h>
#include <dvidef.h>
#include <clidef.h>
#include <climsgdef.h>
#include <ssdef.h>
#include <iodef.h>
#include <jpidef.h>
#include <rmsdef.h>

#include "rexx.h"
#include "strings.h"

struct mbox_status {
   unsigned short status ;
   unsigned short size ;
   int pid ; 
 } ;

#define BUFSIZE 128
#define NUMBUFS  1

/* #define VMS_DEBUG */

#define MAX(a,b) (((a)>(b))?(a):(b))
#define MIN(a,b) (((a)<(b))?(a):(b))

#define MAX_SYM_LENGTH 256

volatile static int ichan=0, ochan=0, pid=0, oflag=0 ;
volatile static int comp_stat=0 ;

static void read_in_ast( int read )
{
   static char buffer[BUFSIZE] ;
   static struct mbox_status ostat ;
   streng *ptr ;
   int rc ;

/* fprintf( stderr, "read_in_ast() status=%d, size=%d, read=%d\n", ostat.status,
                ostat.size, read ) ; */

   if (read) 
   {
      switch ( ostat.status ) 
      {
         case SS$_NORMAL:
            if (ostat.size >= BUFSIZE) 
               complain( SS$_NORMAL ) ;
            ptr = Str_make( ostat.size ) ;
            ptr = Str_ncatstr( ptr, buffer, ostat.size ) ;
            tmp_stack( ptr ) ;
            break ;

         case SS$_ENDOFFILE:
            rc = sys$dassgn( (short)ochan ) ;
            if (rc != SS$_NORMAL) complain( rc ) ;
            ochan = 0 ;
            rc = sys$setef( oflag ) ;
            if (rc != SS$_NORMAL) complain( rc ) ;
            break ;

         default: 
            fprintf( stderr, 
                "sys$qio() return unexpected status value %d\n", 
                ostat.status ) ;

            complain( rc ) ;
      }
   }

   if (ochan)
   {   
      rc = sys$qio(0, (short)ochan, IO$_READVBLK, &ostat, 
                    read_in_ast, 1,
                    buffer, BUFSIZE, 0, 0, 0, 0 ) ;
#ifdef VMS_DEBUG
      printf( "I" ) ;
      fflush( stdout ) ;
#endif

      if (rc != SS$_NORMAL) complain( rc ) ;
   }
}

static int dead=0 ;
volatile static int queue=0 ;

static void write_out_ast()
{
   static struct mbox_status istat ;
   static streng *kill=NULL ;
   static char buffer[BUFSIZE] ;
   int rc, len ;

   if (queue++)
      return ;

   start:
   if (kill)
   {
      Free( kill ) ;
      kill = NULL ;
   }

      if (! stack_empty())
      {
          kill = popline() ;

          if (!ichan) return ;
          rc = sys$qio(0, ichan, IO$_WRITEVBLK, &istat,  
                       write_out_ast, 0,
                       kill->value, Str_len(kill), 0, 0, 0, 0 ) ; 
#ifdef VMS_DEBUG
          printf( "O" ) ;
          fflush( stdout ) ;
#endif

          if (rc != SS$_NORMAL) complain( rc ) ;
      }
      else 
      {
          if (dead++ >= 5) 
          {
             dead = 0 ; 
             return ;
          }
          if (!ichan) return ;
          rc = sys$qio(0, ichan, IO$_WRITEOF, &istat, 
                       write_out_ast, 0, 0, 0, 0, 0, 0, 0 ) ;
          if (rc == SS$_IVCHAN) return ;
          if (rc != SS$_NORMAL) complain( rc ) ;
      }

   if (--queue)
      goto start ;

}


vms_do_command( streng *cmd, int in, int out, int fout, int envir )
{
   struct dsc$descriptor_s name, input, output, prc_name ;
   int fdin[2], fdout[2], strval[2], strval2[2], lim=0, max=0 ;
   int rc, rc1, child, status, fin, eflag, olen, ilen ;
   char line[128], obuf[32], buf2[32], ibuf[32], nbuf[32] ;
   struct mbox_status stat ;

   name.dsc$w_length = Str_len( cmd ) ;
   name.dsc$b_dtype = DSC$K_DTYPE_T ;
   name.dsc$b_class = DSC$K_CLASS_S ;
   name.dsc$a_pointer = cmd->value ; 

   ichan = ochan = 0 ;
   if (in)
   {
      dead = queue = 0 ;
      rc = sys$crembx(0, &ichan, BUFSIZE, BUFSIZE*NUMBUFS, 0, 0, 0) ;
      if (rc != SS$_NORMAL) complain( rc ) ;
      strval[0] = sizeof(ibuf) ;
      strval[1] = ibuf ;
      rc = lib$getdvi( &DVI$_DEVNAM, &ichan, 0, 0, strval, &ilen) ;
      if (rc != SS$_NORMAL) complain( rc ) ;

      input.dsc$w_length = ilen ;
      input.dsc$b_dtype = DSC$K_DTYPE_T ;
      input.dsc$b_class = DSC$K_CLASS_S ;
      input.dsc$a_pointer = ibuf ; 

   }

   if (out || fout)
   {
      rc = sys$crembx(0,&ochan,BUFSIZE,BUFSIZE*NUMBUFS,0,0,0) ;
      if (rc != SS$_NORMAL) complain( rc ) ;
#ifdef VMS_DEBUG
      printf( "sys$crembx() ochan=%d, rc=%d\n", ochan, rc ) ; 
#endif

      strval[0] = sizeof(obuf) ;
      strval[1] = obuf ;
      rc=lib$getdvi( &DVI$_DEVNAM, &ochan, 0, 0, strval, &olen) ;
      if (rc != SS$_NORMAL) complain( rc ) ;
#ifdef VMS_DEBUG
      printf( "lib$getdvi() name=(%d) <%s>\n", olen, obuf ) ; 
#endif

      output.dsc$w_length = olen ;
      output.dsc$b_dtype = DSC$K_DTYPE_T ;
      output.dsc$b_class = DSC$K_CLASS_S ;
      output.dsc$a_pointer = obuf ; 
   }

   sprintf( nbuf, "REXX-%d", getpid()) ; 
   prc_name.dsc$w_length = strlen( nbuf ) ;
   prc_name.dsc$b_dtype = DSC$K_DTYPE_T ;
   prc_name.dsc$b_class = DSC$K_CLASS_S ;
   prc_name.dsc$a_pointer = nbuf ; 

   if (out || fout)
   {
      rc = lib$get_ef( &oflag ) ;
      if (rc != SS$_NORMAL) complain( rc ) ;

      rc = sys$clref( oflag ) ;
/*      if (rc != SS$_NORMAL) complain( rc ) ; */
   }

   rc = lib$get_ef( &eflag ) ;
   if (rc != SS$_NORMAL) complain( rc ) ;

   rc = sys$clref( eflag ) ;
/*   if (rc != SS$_NORMAL) complain( rc ) ; */

   comp_stat = 0 ;
   rc = lib$spawn( &name, 
                   ((in) ? &input : NULL), 
                   ((out || fout) ? &output : NULL), 
                   &CLI$M_NOWAIT, &prc_name, &pid, &comp_stat, 
                   &eflag, NULL, NULL, NULL, NULL ) ;

   if (rc != SS$_NORMAL) complain( rc ) ;

#ifdef VMS_DEBUG
   printf( "lib$spawn() rc=%d\n", rc ) ;
#endif

   if (in)
      write_out_ast() ;

   if (out || fout)
      read_in_ast( 0 ) ;

#ifdef VMS_DEBUG
   printf( "Input and output asts started, synching on process\n" ) ;
#endif
   rc = sys$synch( eflag, NULL ) ;
#ifdef VMS_DEBUG
   printf( "sys$synch() rc=%d, ochan=%d\n", rc, ochan ) ;
#endif
   if (ichan)
   {
      rc = sys$dassgn( (short)ichan ) ;
      ichan = 0 ;
      if (rc != SS$_NORMAL) complain( rc ) ;
   }

   if (out || fout)
   {
      rc = sys$synch( oflag, NULL ) ;
      if (ochan)
         printf( "Warning ... output channel still exists ochan=%d\n",ochan);

      if (rc != SS$_NORMAL) 
         complain( rc ) ;

      rc = lib$free_ef( &oflag ) ;
      if (rc != SS$_NORMAL) complain( rc ) ;
   }

   rc = lib$free_ef( &eflag ) ;
   if (rc != SS$_NORMAL) complain( rc ) ;

   /* 
    * Warning, kludge ahead!!!   When a process under VMS exits, it 
    * seems like there is a little delay until the PRCCNT (process 
    * count) is decremented. So ... if we just continues without 
    * sync'ing up against the PRCCNT, we might get a 'quota exceeded' 
    * on the next command (if it is started very soon)
    */
   lib$getjpi( &JPI$_PRCLM, 0, 0, &max, 0, 0 ) ;
   for (lim=max; lim>=max; )
      lib$getjpi( &JPI$_PRCCNT, 0, 0, &lim, 0, 0 ) ;

   complain( 0 ) ;

   if (out || fout)
      flush_stack( fout ) ;

/*
 * I have no idea _why_, but bit 28 is sometimes set in the comp_stat.
 * Manuals indicate that this is an internal field, but at least it 
 * kills checking against the predefined symbols, so I strip it away.
 * This should most probably have been handled differently, can someone
 * educate me on this?   .... please???
 */
   if ((comp_stat & 0x0fffffff) == CLI$_NORMAL) comp_stat = SS$_NORMAL ;
   return (((comp_stat & 0x0fffffff)==SS$_NORMAL) ? (0) : (comp_stat)) ;
}


int vms_killproc()
{
   if (pid)
      sys$delprc( &pid, NULL ) ;

   pid = 0 ;
}



int complain( int rc ) 
{

#ifdef VMS_DEBUG
   printf( "About to complain ... rc=%d, pid=%d, ochan=%d, ichan=%d\n", 
           rc, pid, ochan, ichan ) ; 
#endif

    if ((rc != SS$_NORMAL) && pid)
       sys$delprc( &pid, NULL ), pid=0 ; 

/*
    if (ochan)
       sys$dassgn( (short)ochan ), ochan=0 ;
 */
    if (ichan)
       sys$dassgn( (short)ichan ), ichan=0 ;

#ifdef VMS_DEBUG
   printf( "No more complains left ...about to give error\n" ) ;
#endif
   if (rc && (rc != SS$_NORMAL))
      vms_error( rc ) ;

#ifdef VMS_DEBUG
   printf( "Exiting complain\n" ) ; 
#endif
    return ;
}



streng *vms_resolv_symbol( streng *name, streng *new, streng *pool ) 
{
   struct dsc$descriptor_s sym_name, sym_val, new_val ;
   char buffer[MAX_SYM_LENGTH] ;
   unsigned int length=0 ;
   int rc ;
   streng *old ;

   sym_name.dsc$w_length = Str_len( name ) ;
   sym_name.dsc$b_dtype = DSC$K_DTYPE_T ;
   sym_name.dsc$b_class = DSC$K_CLASS_S ;
   sym_name.dsc$a_pointer = name->value ; 
   
   if (new) 
   {
      new_val.dsc$w_length = Str_len( new ) ;
      new_val.dsc$b_dtype = DSC$K_DTYPE_T ;
      new_val.dsc$b_class = DSC$K_CLASS_S ;
      new_val.dsc$a_pointer = new->value ; 
   }
   
   sym_val.dsc$w_length = MAX_SYM_LENGTH ;
   sym_val.dsc$b_dtype = DSC$K_DTYPE_T ;
   sym_val.dsc$b_class = DSC$K_CLASS_S ;
   sym_val.dsc$a_pointer = buffer ; 
   
   if (strncmp( pool->value, "SYMBOL", MAX(6,Str_len(pool))) ||
       strncmp( pool->value, "SYSTEM", MAX(6,Str_len(pool))))
   {
      rc = lib$get_symbol( &sym_name, &sym_val, &length ) ;
      if (new) 
         lib$set_symbol( &sym_name, &new_val ) ;
   }
   else if (strncmp( pool->value, "LOGICAL", MAX(7, Str_len(pool))))
   {
/*    rc = lib$get_logical( ... ) */
      if (new)
         lib$set_symbol( &sym_name, &new_val ) ;
      else
         lib$delete_logical( &sym_name ) ;
   }
   else 
      return(NULL) ;

   old = Str_make( length ) ;
   Str_ncatstr( old, buffer, length ) ;
   return(old) ;
}



int vms_set_defdir( streng *newdir ) 
{
    int rc ;
    struct dsc$descriptor_s dir = {
       newdir->len, DSC$K_DTYPE_T, DSC$K_CLASS_S, &newdir->value } ;

    rc = sys$setddir( &dir ) ;
    return (rc==RMS$_NORMAL) ;
}
