#error FIXME, FGC: I don't have fixed the const propagation in this code.
Yep, you must run into this error. Please, fix all errors the compiler tells
you. You may do the work in this order:
0) Comment off this lines until the next true comment.

1) Ignore errors for the first time. Look for each "static" function. Change
   all "xxx *" into "const xxx *" and every typedef'ed type (e.g.
   paramboxptr) into the c(onst) variant (e.g cparamboxptr). ONLY do this
   in the arguments.
   Recompile and check for error messages in the the static function.
   Remove all "const" from the parameters where an "readonly l-value
   assignment" is the error.
   In the other cases try to fix the errors with changing local variables
   in the static functions. In nearly all cases you have to change a running
   variable from types like "xxx *" to "const xxx *".
   Recompile.
   Remove the bogus const declarations from all arguments in the static which
   you don't have fixed.
   You are ready.

2) AFTER STEP 1:
   You have to redo the above work for the global functions. Don't process
   this step before step 1.
   There is one exception to step 1: Don't try to change any parameters. Only
   try to fix local variables.

3) Send back all changes to Mark Hessling if you are not Mark Hessling :-)




/*
 *  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.3 2001/01/25 22:22:48 mark Exp $
 */

#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

typedef struct { /* vms_tsd: static variables of this module (thread-safe) */
   volatile int       ichan ;
   volatile int       ochan ;
   volatile int       pid ;
   volatile int       oflag ;
   volatile int       comp_stat ;
   int                dead ;
   volatile int       queue ;
   char               buffer[BUFSIZE] ;
   struct mbox_status ostat ;
   struct mbox_status istat ;
   streng *           kill ;
} vms_tsd_t; /* thread-specific but only needed by this module. see
              * init_vms
              */


/* init_vms initializes the module.
 * Currently, we set up the thread specific data.
 * The function returns 1 on success, 0 if memory is short.
 */
int init_vms( tsd_t *TSD )
{
   vms_tsd_t *vt;

   if (TSD->vms_tsd != NULL)
      return(1);

   if ((vt = TSD->vms_tsd = MallocTSD(sizeof(vms_tsd_t))) == NULL)
      return(0);
   memset(vt,0,sizeof(vms_tsd_t));  /* correct for all values */
   return(1);
}

static void vms_error (int error_code)
{
   LIB$SIGNAL(error_code);
   return;
}

static void complain (tsd_t *TSD, int rc)
{
   vms_tsd_t *vt;

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

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

/*
   if (vt->ochan) sys$dassgn ((short)vt->ochan), vt->ochan=0 ;
*/
   if (vt->ichan) sys$dassgn ((short)vt->ichan), vt->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 ;
}

static void read_in_ast( int read )
{
   streng *ptr ;
   int rc ;
   tsd_t *TSD;
   vms_tsd_t *vt;

   TSD = __regina_get_tsd(); /* This seems to be a system callback function.
                              * The TSD must be fetched directly.
                              */
   vt = TSD->vms_tsd;

   if (read) {
      switch ( vt->ostat.status ) {
         case SS$_NORMAL:
            if (vt->ostat.size >= BUFSIZE)
               complain( TSD, SS$_NORMAL ) ;
            ptr = Str_makeTSD( vt->ostat.size ) ;
            ptr = Str_ncatstrTSD( ptr, vt->buffer, vt->ostat.size ) ;
            tmp_stack( TSD, ptr, 1 ) ;
            break ;

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

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

            complain( TSD, rc ) ;
      }
   }

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

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

   return;
}

static void write_out_ast()
{
   int rc, len ;
   tsd_t *TSD;
   vms_tsd_t *vt;

   TSD = __regina_get_tsd(); /* This seems to be a system callback function.
                              * The TSD must be fetched directly.
                              */
   vt = TSD->vms_tsd;

   if (vt->queue++)
      return ;

   start:

   if (vt->kill) {
      FreeTSD( vt->kill ) ;
      vt->kill = NULL ;
   }

   if (! stack_empty( TSD )) {
      vt->kill = popline( TSD, NULL, NULL, 0 ) ;

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

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

   if (--vt->queue) goto start ;

   return;
}

int vms_do_command( tsd_t *TSD, const 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 ;
   vms_tsd_t *vt;

   vt = TSD->vms_tsd;
   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 ;

   vt->ichan = vt->ochan = 0 ;
   if (in) {
      vt->dead = vt->queue = 0 ;
      rc = sys$crembx(0, &vt->ichan, BUFSIZE, BUFSIZE*NUMBUFS, 0, 0, 0) ;
      if (rc != SS$_NORMAL) complain( TSD, rc ) ;
      strval[0] = sizeof(ibuf) ;
      strval[1] = (int) ibuf ;
      rc = lib$getdvi( &DVI$_DEVNAM, &vt->ichan, 0, 0, strval, &ilen) ;
      if (rc != SS$_NORMAL) complain( TSD, 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,&vt->ochan,BUFSIZE,BUFSIZE*NUMBUFS,0,0,0) ;
      if (rc != SS$_NORMAL) complain( TSD, rc ) ;

#     ifdef VMS_DEBUG
         printf( "sys$crembx() ochan=%d, rc=%d\n", vt->ochan, rc ) ;
#     endif

      strval[0] = sizeof(obuf) ;
      strval[1] = (int) obuf ;
      rc=lib$getdvi( &DVI$_DEVNAM, &vt->ochan, 0, 0, strval, &olen) ;
      if (rc != SS$_NORMAL) complain( TSD, 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( &vt->oflag ) ;
      if (rc != SS$_NORMAL) complain( TSD, rc ) ;

      rc = sys$clref( vt->oflag ) ;
/*      if (rc != SS$_NORMAL) complain( TSD, rc ) ; */
   }

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

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

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

   if (rc != SS$_NORMAL) complain( TSD, 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, vt->ochan ) ;
#  endif

   if (vt->ichan) {
      rc = sys$dassgn( (short)vt->ichan ) ;
      vt->ichan = 0 ;
      if (rc != SS$_NORMAL) complain( TSD, rc ) ;
   }

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

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

      rc = lib$free_ef( &vt->oflag ) ;
      if (rc != SS$_NORMAL) complain( TSD, rc ) ;
   }

   rc = lib$free_ef( &eflag ) ;
   if (rc != SS$_NORMAL) complain( TSD, 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( TSD, 0 ) ;

   if (out || fout)
      flush_stack( TSD, 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 ((vt->comp_stat & 0x0fffffff) == CLI$_NORMAL) vt->comp_stat = SS$_NORMAL ;
   return (((vt->comp_stat & 0x0fffffff)==SS$_NORMAL) ? 0 : vt->comp_stat) ;
}

int vms_killproc( tsd_t *TSD )
{
   vms_tsd_t *vt;

   vt = TSD->vms_tsd;
   if (vt->pid)
      sys$delprc( &vt->pid, NULL ) ;

   vt->pid = 0 ;
   return 0;
}

streng *vms_resolv_symbol( tsd_t *TSD, 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 ;
   vms_tsd_t *vt;

   vt = TSD->vms_tsd;
   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_makeTSD( length ) ;
   Str_ncatstrTSD( old, buffer, length ) ;
   return(old) ;
}