nohermes.src

        Copyright (c) Kapteyn Laboratorium Groningen 1993
        All Rights Reserved.

Name:         nohermes.src
Creator:      kgb
Host:         huygens
Date:         Jul 7, 1993
Contents:     nohermes.c outpmgr.c parmgr.c replymgr.c statmgr.c
              parse.shl SA_recv_msg.dc3 SA_send_msg.dc3 ctrlc_handler.dc3 delete_par.dc3
              err_uca.dc3 find_par.dc3 init_par.dc3 insert_par.dc3 namstatus.dc3
              nohermes.dc1 nohermes.dc3 parse.dc3 pidstatus.dc3 put_coa.dc3
              put_log.dc3 put_psa.dc3 put_uca.dc3 reply_clear.dc3 reply_put.dc3
              reply_ready.dc3 reply_send.dc3 replymgr.dc3 satisfy.dc3 use_par.dc3

#>            nohermes.c
#include "hercom.h"

#include "ctype.h"
#include "string.h"
#include "stdio.h"
#include "stdlib.h"
#include "dcdint.h"
#include "dcdlog.h"
#include "dcdreal.h"
#include "dcddble.h"
#include "dcdchar.h"
#include "dcdcharu.h"
#include "dcdcharl.h"

#define  NOTIMPL reply_send(curstat,ERRNOTIMP);
#define RPYLEN 8192

static void   init    (TaskStatus,InitRequest);
static void   finis   (TaskStatus);
static void   cancel  (TaskStatus,CancelRequest);
static void   pause   (TaskStatus,PauseRequest);
static void   userinp (TaskStatus,UserinpRequest);
static void   anyout  (TaskStatus,AnyoutRequest);
static void   canall  (TaskStatus);
static void   myname  (TaskStatus);
static void   error   (TaskStatus,ErrorRequest);
static void   status  (TaskStatus,StatusRequest);
static void   wkey    (TaskStatus,WkeyRequest);
static void   reject  (TaskStatus,RejectRequest);

volatile static int    ctrlc_count=0;


void SA_send_msg(RequestMessage *message)
{
TaskStatus  curstat;
Request     curreq;

/* In this stand-alone implementation the requests are immediately
   processed. In implementations with a master-control program (Hermes), 
   code equivalent to the code following below is included in the
   master-control program.
*/
   curstat = pidstatus(message->pid);
   if (ctrlc_count>0) {                  /* CTRL-C typed? */
      ctrlc_count = 0;
      (void)prompter(">",FREE);          /* user wants attention. give it. */
   }
   /* process if matching task found, else ignore request */
   if (curstat->pid == message->pid) {
      curreq = (Request)message->request;
      reply_clear();
      switch (curreq->code) {
         case INIT    :   init(curstat,(InitRequest)curreq); break;
         case FINIS   :   finis(curstat); break;
         case CANCEL  :   cancel(curstat,(CancelRequest)curreq); break;
         case PAUSE   :   pause(curstat,(PauseRequest)curreq); break;
         case USERINP :   userinp(curstat,(UserinpRequest)curreq); break;
         case DEPUTY  :   NOTIMPL; break;
         case XEQ     :   NOTIMPL; break;
         case SUBST   :   NOTIMPL; break;
         case ANYOUT  :   anyout(curstat,(AnyoutRequest)curreq); break;
         case CANALL  :   canall(curstat); break;
         case MYNAME  :   myname(curstat); break;
         case RAWPAR  :   NOTIMPL; break;
         case ERROR   :   error(curstat,(ErrorRequest)curreq); break;
         case STATUS  :   status(curstat,(StatusRequest)curreq); break;
         case WKEY    :   wkey(curstat,(WkeyRequest)curreq); break;
         case XEQXIT  :   NOTIMPL; break;
         case TYPE    :   NOTIMPL; break;
         case REJECT  :   reject(curstat,(RejectRequest)curreq); break;
         default      :   NOTIMPL;
      }
      while (!reply_ready()) {
         (void) prompter(">",FREE);
      }
   }
}

static void init(TaskStatus curstat, InitRequest request)
{
   if (request->version == VERSION) {
      curstat->state = RUNNING;
      put_psa(curstat,"WAITING TO BE RUN",PLUSTERM);
      do ; while (prompter(">",FREE)>0);
      put_psa(curstat,"RUNNING",PLUSTERM);
      reply_send(curstat,0);
   } else {
      reply_send(curstat,BADVERSION);
   }
}

static void finis(TaskStatus curstat)
{
   put_psa(curstat,"+++ FINISHED +++\n",PLUSTERM);   /* later: remove \n */
   reply_send(curstat,0);
   curstat->pid = 0;
}

static void cancel(TaskStatus curstat, CancelRequest request)
{
   delete_par(curstat,request->key);
   reply_send(curstat,0);
}

static void reject(TaskStatus curstat, RejectRequest request)
{
   
   delete_par(curstat,request->key);
   err_uca(request->message);
   reply_send(curstat,0);
}

static void pause(TaskStatus curstat, PauseRequest request)
{
   char paumsg[]=" - PAUSING";
   char message[MSGLEN+sizeof(paumsg)];
    
   (void)strcpy(message,request->message);
   (void)strcat(message,paumsg);
   put_psa(curstat,message,PLUSPAUSE);
   curstat->state = PAUSING;
}

static void userinp(TaskStatus curstat, UserinpRequest request)
{
   char prompt[NAMLEN+KEYLEN+1];

   if (!satisfy(curstat,request,KEYPROMPT)) {
      curstat->userinp = *request;
      curstat->state = WAITINP;
      put_psa(curstat,request->message,PLUSINP);
      do {
         (void)strcpy(prompt,curstat->name);
         (void)strcat(prompt,",");
         (void)strcat(prompt,request->key);
         prompter(prompt,KEYPROMPT);
      } while (curstat->state==WAITINP);
   }
}

static void anyout(TaskStatus curstat, AnyoutRequest request)
{
   if (request->devmask == 0) request->devmask = SCREEN | LOGFILE;
   if ( (request->devmask & SCREEN) ||
        (request->devmask & NOEXPERT) && curstat->output_mode >= NORMAL ||
        (request->devmask & SCREENTEST) && curstat->output_mode >= TEST )
        put_coa(curstat,request->line);
   if ( request->devmask & LOGFILE ) put_log(curstat,request->line);
   reply_send(curstat,0);
}

static void canall(TaskStatus curstat)
{
   init_par(curstat);
   reply_send(curstat,0);
}

static void myname(TaskStatus curstat)
{
   reply_put(curstat->name,strlen(curstat->name));
   reply_send(curstat,0);
}

static void error(TaskStatus curstat, ErrorRequest request)
{
   char fatalmsg[]=" - FATAL";
   char errormsg[]=" - ERROR";   
   char message[MSGLEN+sizeof(fatalmsg)]; /* use largest suffix in sizeof! */
   int  result=0;
    
   (void)strcpy(message,request->message);
   if (request->level >= curstat->errlev) {
      (void)strcat(message,fatalmsg);
      put_coa(curstat,message);
      result = ERRLEVEXC;
   } else if (request->level >= curstat->meslev) {
      (void)strcat(message,errormsg);
      put_coa(curstat,message);
   }
   reply_send(curstat,result);
}

static void status(TaskStatus curstat, StatusRequest request)
{
   put_psa(curstat,request->message,ALL);
   reply_send(curstat,0);
}

static void wkey(TaskStatus curstat, WkeyRequest request)
{
   char key[KEYLEN];
   char val[CMDLEN];
   int  i;
   char *bp=request->command;
    
   for (;;) {
      i = 0;
      while(*bp) {
         key[i] = *(bp++);
         if (key[i++]=='=') break;
      }
      key[i] = 0;
      i = 0;
      while (*bp) {
         val[i] = *(bp++);
         if (val[i++]=='=') {
            i--;
            bp--;
            while(*(--bp) !=' ' && *bp != '=') --i;
            break;
         }
      }
      val[i] = 0;
      insert_par(curstat,key,val);
      if (!*bp) break;
   }
   reply_send(curstat,0);
}

extern bool satisfy(TaskStatus status, UserinpRequest request, int context)
{
   char  value[CMDLEN];
   char  result[RPYLEN];
   int   length, typlen, count;
   fint  error;
   fchar cvalue, cresult;
   
   length = find_par(status,request->key,value,CMDLEN);
   if (length<0) {                                         /* key absent     */
      if (request->level == 2) {
         reply_send(status,0);
         status->state = RUNNING;
         return 1;
      } else {
         return 0;
      }
   }
   if (length == 0) {                               /* key present but empty */
      if (request->level>0) {
         reply_send(status,0);
         status->state = RUNNING;
         return 1;
      } else {
         if (context==KEYPROMPT) err_uca("NO DEFAULT");
         return 0;
      }
   }
   
   cvalue.a = value;
   cvalue.l = length;
   switch (request->type) {
      case USERINT   :
           typlen = sizeof(fint);
           length = dcdint_c( cvalue, (fint*)result, (fint*)&request->number,
                             &error);
           break;
           
      case USERLOG   :
           typlen = sizeof(bool);
           length = dcdlog_c(cvalue, (bool*)result, (fint*)&request->number,
                             &error);
           break;
           
      case USERREAL  :
           typlen = sizeof(float);
           length = dcdreal_c(cvalue, (float*)result, (fint*)&request->number,
                              &error);
           break;
           
      case USERDBLE  :
           typlen = sizeof(double);
           length = dcddble_c(cvalue, (double*)result, (fint*)&request->number,
                              &error);
           break;
           
      case USERCHAR  :
           typlen = request->width;
           cresult.a = result;
           cresult.l = typlen;
           length = dcdchar_c(cvalue, cresult, (fint*)&request->number, &error);
           break;
           
      case USERCHARU :
           typlen = request->width;
           cresult.a = result;
           cresult.l = typlen;
           length = dcdcharu_c(cvalue, cresult, (fint*)&request->number,&error);
           break;
           
      case USERCHARL :
           typlen = request->width;
           cresult.a = result;
           cresult.l = typlen;
           length = dcdcharl_c(cvalue, cresult, (fint*)&request->number,&error);
           break;
           
      case USERTEXT  :
           typlen = 1;
           for (count=0; count<length; count++) result[count] = value[count];
           error = 0;
           break;
   }
   if (error<0) {                                   /* error in decoding? */
      if (context==KEYPROMPT) {
         switch (error) {
            case -11 :  err_uca("BAD INPUT: bad call"); break;
            case -12 :  err_uca("BAD INPUT: unknown function"); break;
            case -13 :  err_uca("BAD INPUT: syntax error"); break;
            case -14 :  err_uca("BAD INPUT: illegal character"); break;
            case -15 :  err_uca("BAD INPUT: wrong repeat argument"); break;
            case -16 :  err_uca("BAD INPUT: wrong number of arguments"); break;
            case -17 :  err_uca("BAD INPUT: arithmetic error"); break;
            case -18 :  err_uca("BAD INPUT: not enough internal memory"); break;
            case -19 :  err_uca("BAD INPUT: conversion error"); break;
            case -20 :  err_uca("BAD INPUT: unequal list length"); break;
            case -21 :  err_uca("BAD INPUT: empty list"); break;
            case -22 :  err_uca("BAD INPUT: nested lists"); break;
            case -23 :  err_uca("BAD INPUT: output buffer overflow"); break;
            case -24 :  err_uca("BAD INPUT: floating overflow/underflow");
                        break;
            default:    err_uca("BAD INPUT");
         }
      }
      return 0;
   }
   if (length==0) {                                 /* interpreted as empty? */
      if (request->level>0) {
         reply_send(status,0);
         status->state = RUNNING;
         return 1;
      } else {
         if (context==KEYPROMPT) err_uca("NO DEFAULT");
         return 0;
      }
   }
   /* !!! EXACT option still to be implemented */
   reply_put(result,length*typlen);
   reply_send(status,0);
   status->state = RUNNING;
   return 1;
}

#include "signal.h"


void ctrlc_handler(int sig)
/* Increment ctrlc_count when ^C is typed. The handler is declared by
   initstatus in statmgr.c. The count is checked and cleared in the routine 
   SA_send_msg in this file.
*/
{
   if (sig == SIGINT) {
      signal(SIGINT,ctrlc_handler);
      if (++ctrlc_count > CTRLCMAX) exit(0);
      if (ctrlc_count== CTRLCMAX) printf("\nNext CTRL-C will abort task.\n");
   }
}
#<

#>            outpmgr.c
/* outpmgr.c
                              COPYRIGHT (c) 1990
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Module:        outpmgr

Purpose:       Private to nohermes. Collection of routines handling
               screen and log file output.
               
File:          nohermes.src

Author:        J.P. Terlouw

Description:   Five routines are available:
               - put_coa   for writing to the common output area;
               - put_uca   for writing to the user command area;
               - err_uca   for writing error messages to the user
                           command area;
               - put_psa   for writing to the process status area;
               - put_log   for writing to the log file.
               
Updates:       26-Feb-90  --  original document
                7-Feb-91  --  unwanted external variables changed into statics

*/
#include	"errno.h"	/* <errno.h> */

#define	fcntl	FCNTL
#define	open	OPEN

#include <sys/types.h>
#include <sys/file.h>
#include <sys/stat.h>
#ifndef	O_RDONLY
#include	<fcntl.h>
#endif
#include "hercom.h"
#include "string.h"

#undef	fcntl
#undef	open

#if	!defined(S_IREAD) && defined(_S_IREAD)
#define	S_IREAD		_S_IREAD
#endif
#if	!defined(S_IWRITE) && defined(_S_IWRITE)
#define	S_IWRITE	_S_IWRITE
#endif

extern	int      write( );
extern	int      open ( );
extern	int      fsync( );
extern	int      fcntl( );

static enum { COA=1, PSA=2, UCA=4 } lastop;

void put_coa(TaskStatus status, char *line)
{
   if (!(status->devmask & SCREEN)) return;
   if (lastop == PSA) (void)write(1,"\n",1);
   (void)write(1,line,strlen(line));
   (void)write(1,"\n",1);
   lastop = COA;
}

void put_log(TaskStatus status, char *line)
{
   static int fd=0;
   static struct flock setlock={0,0,0,0,0};
    
   if (!(status->devmask & LOGFILE)) return;
   if (!fd) fd = open("GIPSY.LOG",O_CREAT|O_RDWR|O_APPEND, S_IREAD|S_IWRITE );
   setlock.l_type = F_WRLCK;
   do ; while ( fcntl(fd,F_SETLKW,(int)&setlock)==-1 && errno==EINTR);
   (void)write(fd,line,strlen(line));
   (void)write(fd,"\n",1);
   fsync(fd);
   setlock.l_type = F_UNLCK;
   do ; while ( fcntl(fd,F_SETLKW,(int)&setlock)==-1 && errno==EINTR);

}

void put_psa(TaskStatus status, char *line, int level)
{
   char logline[LINLEN];
   
   (void)write(1,status->name,strlen(status->name));
   (void)write(1," - ",3);
   (void)write(1,line,strlen(line));
   (void)write(1,"\r",1);
   lastop = PSA;
   if (status->status_level >= level) {
      strcpy(logline,"<STATUS> ");
      strcat(logline,status->name);
      strcat(logline," - ");
      strcat(logline,line);
      put_log(status,logline);
   }
}

void err_uca(char *line)
{
   static char *bellblank=" \007                        ";
   
   if (lastop == PSA) (void)write(1,"\n",1);
   (void)write(1,bellblank,strlen(bellblank));
   (void)write(1,line,strlen(line));
   (void)write(1,"\n",1);
   lastop = COA;
}

void put_uca(char *line)
{
   if (lastop == PSA) (void)write(1,"\n",1);
   (void)write(1,line,strlen(line));
   lastop = COA;
}
#<

#>            parmgr.c
/* parmgr.c
                              COPYRIGHT (c) 1990
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Module:   parmgr

Purpose:  Private to nohermes. Collection of routines dealing with Userinp
          keywords.
          
File:     nohermes.src

Author:   J.P. Terlouw

Updates:  25-Feb-90  --  original document
           7-Feb-91  --  unwanted external variables changed into statics


*/

#include "hercom.h"
#include "string.h"

#include "gds_delete.h"
#include "gds_create.h"
#include "gds_exist.h"
#include "gdsd_write.h"
#include "gdsd_read.h"
#include "gdsd_delete.h"

static fint error;
static fint rbytes,dbytes;
static fint zero=0, one=1;

/*
*/
void init_par(TaskStatus status)
{
   error = 0; gds_delete_c(tofchar(status->parname),&error);
              gds_create_c(tofchar(status->parname),0);
}

/*
*/
void use_par(TaskStatus status)
{
   if (!gds_exist_c(tofchar(status->parname),0)) {
      put_coa(status,"!-no macro file exists -- created.");
      put_log(status,"!-no macro file exists -- created.");
      gds_create_c(tofchar(status->parname),0);
   }
}       

/*
*/
void insert_par(TaskStatus status, char* key, char* value)
{
   rbytes = strlen(value)+1;
   gdsd_write_c(tofchar(status->parname),tofchar(key),&zero,
                (fint*)value,&rbytes,&one,&dbytes,0);
}

/*
*/
void delete_par(TaskStatus status, char* key)
{
   error = 0; gdsd_delete_c(tofchar(status->parname),tofchar(key),&zero,&error);
}

int find_par(TaskStatus status, char* key, char *value, int nreq)
{
   rbytes = nreq;
   error = 0; gdsd_read_c(tofchar(status->parname),tofchar(key),&zero,
                          (fint*)value,&rbytes,&one,&dbytes,&error);
   if (error<0) {
      return -1;
   } else {
      return strlen(value);
   }
}
#<

#>            replymgr.c
/*
                              COPYRIGHT (c) 1990
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands
         

Module:      replymgr

Purpose:     Private to ("stand-alone") hermes. Collection of routines to 
             manage hermes' reply to a requesting servant.
             
File:        replymgr.c

Author:      J.P. Terlouw

Description: The following routines are available:

          a) services to Hermes:

             void reply_clear(void)   initializes the internal buffer.
             
             void reply_put(char *data, int number)
                                      appends 'number' bytes taken from
                                      'data' to the internal buffer.

              void reply_send(TaskStatus status, int result)
                                       writes the 'result' code to the
                                       buffer (0 = no error). 'Status'
                                       specifies the task status block
                                       of the requesting servant
                                       (currently not used).
                                       
               bool reply_ready(void)  returns true if buffer is ready
                                       to be sent to servant, i.e. if
                                       reply_send has been called.
                                       
          b) service to the requesting servant (after binding by bind_hermes
             called from srvreq):
              
              int SA_recv_msg(char *bufout, int number)
                                       obtain up to 'number' bytes from
                                       the buffer and store them in
                                       'bufout'. Return the actual number
                                       of bytes received. The first bytes
                                       form the result code.

Updates:     23-Feb-90  --  original document
             11-Oct-90  --  name of recv_msg changed to SA_recv_msg

*/

#include "hercom.h"
#define RPYLEN 8192

static   char buffer[RPYLEN];
static   int  in;
static   int  out;
static   bool ready;

void reply_clear(void)
{
   ready = 0;
   in    = sizeof(int);   /* make room for status word */
   out   = 0;
}

bool reply_ready(void)
{
   return ready;
}

void reply_send(TaskStatus status, int result)
{
   int i;
   
   union {
      int   result;
      char  bytes[sizeof(int)];
   } unistat;
   
  unistat.result = result;
  for (i=0; i<sizeof(int); i++) buffer[i] = unistat.bytes[i];
  ready = 1;
}

void reply_put(char *data, int number)
{
   for ( ; number>0 && in<RPYLEN; number--) {
      buffer[in++] = *data++;
   }
}

int SA_recv_msg(char *bufout, int number)
{
   int num;
   
   for (num = 0; (number--)>0 && out<in; num++) {
      *bufout++ = buffer[out++];
   }
   return num;
}
#<

#>            statmgr.c
/*
                              COPYRIGHT (c) 1990
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands


Module:      statmgr

Purpose:     Private to nohermes. Collection of routines dealing with
             task status blocks.
            
File:        nohermes.src

Author:      J.P. Terlouw

Description: There are two external routines: one to obtain a status
             block pointer given a process id number and another
             to obtain the pointer given the task name.
             
Declaration: TaskStatus pidstatus(int pid);
                  or
             TaskStatus namstatus(char *name);
             
Author:      J.P. Terlouw

Updates:     23-Feb-90  JPT --  original document
             10-Apr-90  PRR --  remove directory info from taskname

*/

#include "hercom.h"
#include "ctype.h"
#include "string.h"

int    getpid( ) ;

static struct _TaskStatus status[MAXACT+1];
static bool   initialized=0;

static void initstatus(void)
{
   int i;
   
   status[MAXACT].pid     = -1;
   status[MAXACT].errlev  =  4;
   status[MAXACT].meslev  =  1;
   status[MAXACT].devmask = DEFMASK;
   status[MAXACT].state   = WAITRUN;
   status[MAXACT].output_mode  = NORMAL;
   status[MAXACT].status_level = PLUSTERM;

   for (i=0; i<MAXACT; i++) {
      status[i].pid = 0;
      status[i].taskno = i;
   }
/* stand-alone initialization, remove for master control program version: */
   {
#include "signal.h"
#include "getcla.h"

   extern void ctrlc_handler(int);

   char   nam_buf[NAMLEN+80];
   fchar  name;
   fint   zero=0;
   int    index;
   int    len;
   int    count;

   status[0] = status[MAXACT];
   status[0].pid = getpid();
   name.a = nam_buf; name.l = sizeof( nam_buf );
   getcla_c(&zero,name);
   for (len = 0; len < name.l; len++) {
      if (name.a[len] == ' ') break;
   }
   for(index = len - 1; index >= 0; index--) {
      if (name.a[index] == '/') break;
   }
   index += 1;
   for (count = 0; count < NAMLEN; count++) {
      if (count + index >= len) {
         status[0].name[count] = 0;
         break;
      } else {
         status[0].name[count] = toupper(name.a[count + index]);
      }
   }
   strcpy(status[0].parname,status[0].name);
   if (strlen(status[0].name)+strlen(PAREXT)<NAMLEN) {
      strcat(status[0].parname,PAREXT);
   } else {
      strcpy(&status[0].parname[NAMLEN-strlen(PAREXT)],PAREXT);
   }
   signal(SIGINT,ctrlc_handler);
   initialized=1;
   }
/* end of stand-alone initialization */
}

TaskStatus pidstatus(int pid)
{
   int i;
   
   if (!initialized) initstatus();   
   for (i=0; i<MAXACT; i++) {
      if (pid == status[i].pid) break;
   }
   return &status[i];
}

TaskStatus namstatus(char *name)
{
   /* !!! simple version, always returns the first and only status block */
   return &status[0];
}
#<

#>            parse.shl
C parse.shl
C
C
C     C to Fortran interface:
C
C@    subroutine parse( character, integer, integer, integer, integer,
C@                      integer, character, character, character,
C@                      character )
C
E   Description of the code.
C
C
C
C
C   Introduction
C
C   PARSE is a table-driven parser  designed  to  parse  command  lines.
C   Though  this  version  has  been coded to parse HERMES commands, the
C   framework is  quite  general  and  can  be  used  for  other  syntax
C   definitions.
C
C   For  PARSE,  parsing  is  breaking  down  a command line into syntax
C   elements and resolving the form, function and  interrelationship  of
C   these  elements.  PARSE  parses  command  lines  at  two  levels,  a
C   syntactical level and a semantic level.
C   At the syntactical level, PARSE evaluates each syntax element on the
C   command  line  based  on  a  predefined  arrangement of command line
C   elements. This arrangement of command line elements is defined by  a
C   state table that consists of states and transitions.
C   On  the  semantic  level, PARSE resolves the meaning of each element
C   based on definitions supplied in action  routines.  Action  routines
C   make use of built-in variables and user-supplied code.
C
C   PARSE  parses  command  lines using a table consisting of states and
C   transitions. A state delimits and represents a single syntax element
C   on  a command line. A transition defines the processing required for
C   parsing a given syntax element and provides  direction  for  further
C   parsing at another state.
C
C
C
C   The state table.
C
C   The  state  table  is  a two-dimensional byte array (TABLE(6,n); n =
C   number of table entries)  containing  all  information  to  parse  a
C   command  line  on the syntactical level. A line in this table can be
C   either  the  declaration  of  the  beginning  of  a  state  or   the
C   specification  of  a  transition. For convenience, the codes for the
C   state declaration and the transitions have been parametrized.
C
C   A state declaration has the following form:
C
C        STATE,   n,   0,   0,   0,   0
C
C         n   is a  unique  number  that  identifies  the  state.  State
C             numbers  need  not  be  contiguous  in  the table, but the
C             highest  state  number  must  not  exceed  the  value   of
C             parameter MAXSTA.
C
C   A transition is specified in the following form:
C
C        tcode,  next,  action,  qual1,  qual2,  qual3
C
C     tcode = code specifying the type of transition
C     next  = the number of the state to which control is directed after
C             the code for this transition is executed. If it  is  zero,
C             control drops through to the next STATE declaration in the
C             table. This is allowed only for the last transition  in  a
C             state;  the line following a transition specification with
C             "next" equal to zero must be a STATE declaration.
C     action= the number of the action routine for which code is present
C             in the second SELECT statement in the main loop.
C
C   If  a  transition  is successful, the action routine is executed and
C   then parsing continues at  the  state  specified  by  "next".  If  a
C   transition  fails,  PARSE attempts to match remaining transitions in
C   the same state. If there are no remaining transitions, PARSE  leaves
C   its main loop with SUCCES=.FALSE..
C
C
C
C   Types of transitions.
C
C
C   ANY    matches any single character
C
C   ALFA   matches any single alphabetic upper-case character (A-Z)
C
C   DIGIT  matches any single digit (0-9)
C
C   LAMDA  matches   an   empty   string.   This  transition  is  always
C          successful. LAMDA transitions are useful for  getting  action
C          routines called without passing any of the input string.
C
C   ONUMB  matches  an  octal  numnber.  An  octal  number consists of a
C          string of octal digits (0-7), terminated by  any  non-numeric
C          character.
C
C   DNUMB  matches a decimal number
C
C   STRNG  matches any alphanumeric string (0-9, A-Z)
C
C   STREXT matches any string built of ('0'..'9', 'A'..'Z','$','_')
C
C   BLANK  matches a string of blank characters
C
C   CHAR   matches a single character specified in "qual1"
C
C   KEYW   matches  a  string  in KEYTAB. "Qual1" points to the start of
C          the string; "qual2" contains the length.
C
C   EOS    matches the end of the input string. Once PARSE  has  reached
C          the  end of the input string, EOS matches as many times as it
C          is encountered.
C
C   EXIT   causes PARSE to leave its main loop with SUCCES=.TRUE..
C
C
C
C   Action routines.
C
C   Action routines  provide  the  means  for  processing  command  line
C   elements  at the semantic level. That is, a given syntax element can
C   have more than one meaning. Action routines provide a mechanism  for
C   determining and validating the meaning of the syntax elements.
C   They can make use of the following built-in variables:
C
C   QUAL1  "qualifiers" as present in the transition specification
C
C   QUAL2                           ,,
C
C   QUAL3                           ,,
C
C   ICP    pointer to the remainder of the input string
C
C   NCHT   character count of the portion of the input string matched by
C          this transition.
C
C   NUMBR  contains the value of the number obtained  by  the  ONUMB  or
C          DNUMB transitions.
C
C   Action routines can also be used to reject a transition by executing
C   the statement "PERFORM REJECT". This technique allows  extension  of
C   the syntax types beyond the set provided by PARSE.
C
C
E     Subroutine PARSE
      SUBROUTINE PARSE( STRING, TYPE, STYPE, Q1, Q2, Q3,
     #                  S1, S2, S3, S4 )
C
C     Parameter declarations:
C
      INTEGER ANY, ALFA, DIGIT, LAMDA, ONUMB, DNUMB, STRNG,
     #        STREXT, BLANK, EOS, CHAR, KEYW, STATE,
     #        EXIT
N     Symbolic transition types
      PARAMETER (ANY=1,ALFA=2,DIGIT=3,LAMDA=4,ONUMB=5,DNUMB=6,STRNG=7,
     #           STREXT=8,BLANK=9,EOS=10,CHAR=11,KEYW=12,STATE=13,
     #           EXIT=14)
      INTEGER TTYP, NEXTST, ACTION
N     Positions in transition table
      PARAMETER (TTYP=1,NEXTST=2,ACTION=3)
N     Dimensions
      INTEGER THI, TWI, KTLEN, MAXSTA
      PARAMETER (THI=123,TWI=6,KTLEN=60,MAXSTA=50)
C
C     Arguments:
C
      CHARACTER*(*) STRING, S1, S2, S3, S4
      INTEGER       TYPE, STYPE, Q1, Q2, Q3
C
C     Locals:
C
N     save last search string
      CHARACTER*1  KEYTAB(KTLEN)
      CHARACTER*20 S1_SAVE
      INTEGER      LS1_SAVE
      LOGICAL      SUCCES
      LOGICAL      INIT_34, INIT_36
      INTEGER      TABLE(TWI,0:THI), QUAL1, QUAL2, QUAL3
      INTEGER      STATAB(MAXSTA)
C
C     Save statements:
C
      SAVE S1_SAVE, LS1_SAVE, TABLE, KEYTAB, NSTATE, STATAB
C
C     Data statements:
C      
      DATA NSTATE  / 0 /
      DATA STATAB  / MAXSTA*0 /
      DATA S1_SAVE / '                    '/
      DATA LS1_SAVE/ 0 /
E     Transition table
      DATA ((TABLE(I,J),I=1,TWI),J=0,18) /
C       TRANS   NEXT    ACTION  QUAL1   QUAL2   QUAL3
C     ---------------------------------------------
N     Trap for unspecified states
     -  STATE,  1,      0,      0,      0,      0,
     -  STATE,  1,      0,      0,      0,      0,
     -  CHAR,   2,      0,      42,     0,      0,
     -  LAMDA,  5,      0,      0,      0,      0,
     -  STATE,  2,      0,      0,      0,      0,
     -  CHAR,   3,      1,      43,     0,      0,
     -  CHAR,   3,      2,      45,     0,      0,
     -  LAMDA,  0,      3,      0,      0,      0,
     -  STATE,  3,      0,      0,      0,      0,
     -  DNUMB,  0,      4,      0,      0,      0,
     -  STATE,  4,      0,      0,      0,      0,
     -  EOS,    22,     0,      0,      0,      0,
     -  STATE,  5,      0,      0,      0,      0,
     -  CHAR,   6,      6,      43,     0,      0,
     -  CHAR,   6,      7,      45,     0,      0,
     -  LAMDA,  6,      0,      0,      0,      0,
     -  STATE,  6,      0,      0,      0,      0,
     -  CHAR,   7,      0,      61,     0,      0,
     -  LAMDA,  26,     0,      0,      0,      0/
      DATA ((TABLE(I,J),I=1,TWI),J=19,37) /
     -  STATE,  7,      0,      0,      0,      0,
     -  EOS,    22,     8,      0,      0,      0,
     -  ANY,    7,      9,      0,      0,      0,
     -  STATE,  26,     0,      0,      0,      0,
     -  CHAR,   27,     23,     36,     0,      0,
     -  CHAR,   27,     26,     94,     0,      0,
     -  LAMDA,  28,     0,      0,      0,      0,
     -  STATE,  27,     0,      0,      0,      0,
     -  EOS,    22,     25,     0,      0,      0,
     -  ANY,    27,     24,     0,      0,      0,
     -  STATE,  28,     0,      0,      0,      0,
     -  CHAR,   25,     27,     38,     0,      0,
     -  LAMDA,  25,     0,      0,      0,      0,
     -  STATE,  25,     0,      0,      0,      0,
     -  STREXT, 8,      22,     0,      0,      0,
     -  LAMDA,  0,      0,      0,      0,      0,
     -  STATE,  8,      0,      0,      0,      0,
     -  CHAR,   9,      10,     91,     0,      0,
     -  LAMDA,  23,     0,      0,      0,      0/
      DATA ((TABLE(I,J),I=1,TWI),J=38,56) /
     -  STATE,  9,      0,      0,      0,      0,
     -  STRNG,  0,      11,     0,      0,      0,
     -  STATE,  10,     0,      0,      0,      0,
     -  CHAR,   11,     0,      46,     0,      0,
     -  LAMDA,  12,     0,      0,      0,      0,
     -  STATE,  11,     0,      0,      0,      0,
     -  STRNG,  10,     11,     0,      0,      0,
     -  STATE,  12,     0,      0,      0,      0,
     -  CHAR,   0,      12,     93,     0,      0,
     -  STATE,  23,     0,      0,      0,      0,
     -  STRNG,  0,      13,     0,      0,      0,
     -  CHAR,   0,      32,     41,     0,      0,
     -  CHAR,   25,     31,     40,     0,      0,
     -  LAMDA,  24,     30,     0,      0,      0,
     -  LAMDA,  14,     0,      0,      0,      0,
     -  STATE,  24,     0,      0,      0,      0,
     -  EOS,    22,     0,      0,      0,      0,
     -  ANY,    22,     29,     0,      0,      0,
     -  STATE,  14,     0,      0,      0,      0/
      DATA ((TABLE(I,J),I=1,TWI),J=57,75) /
     -  EOS,    22,     0,      0,      0,      0,
     -  BLANK,  14,     0,      0,      0,      0,
     -  CHAR,   14,     29,     44,     0,      0,
     -  CHAR,   15,     20,     47,     0,      0,
     -  LAMDA,  19,     0,      0,      0,      0,
     -  STATE,  15,     0,      0,      0,      0,
     -  KEYW,   22,     14,     36,     3,      1,
     -  KEYW,   22,     14,     39,     4,      2,
     -  KEYW,   22,     14,     43,     2,      3,
     -  KEYW,   22,     14,     45,     3,      4,
     -  KEYW,   16,     14,     1,      2,      5,
     -  KEYW,   17,     14,     3,      4,      6,
     -  KEYW,   22,     14,     7,      3,      7,
     -  KEYW,   18,     14,     10,     2,      8,
     -  KEYW,   18,     14,     12,     3,      9,
     -  KEYW,   17,     14,     15,     6,      10,
     -  KEYW,   17,     14,     21,     6,      11,
     -  KEYW,   17,     14,     32,     4,      12,
     -  KEYW,   17,     14,     48,     3,      13/
      DATA ((TABLE(I,J),I=1,TWI),J=76,94) /
     -  KEYW,   29,     14,     51,     3,      14,
     -  KEYW,   31,     14,     54,     3,      15,
     -  KEYW,   31,     14,     57,     4,      16,
     -  STATE,  29,     0,      0,      0,      0,
     -  BLANK,  29,     0,      0,      0,      0,
     -  CHAR,   29,     0,      44,     0,      0,
     -  ALFA,   29,     34,     0,      0,      0,
     -  DIGIT,  29,     34,     0,      0,      0,
     -  CHAR,   30,     35,     61,     0,      0,
     -  EOS,    13,     0,      0,      0,      0,
     -  STATE,  30,     0,      0,      0,      0,
     -  ANY,    30,     36,     0,      0,      0,
     -  EOS,    14,     0,      0,      0,      0,
     -  STATE,  31,     0,      0,      0,      0,
     -  BLANK,  31,     0,      0,      0,      0,
     -  CHAR,   31,     0,      44,     0,      0,
     -  CHAR,   31,     34,     42,     0,      0,
     -  ALFA,   31,     34,     0,      0,      0,
     -  DIGIT,  31,     34,     0,      0,      0/
      DATA ((TABLE(I,J),I=1,TWI),J=95,113) /
     -  EOS,    14,     0,      0,      0,      0,
     -  STATE,  16,     0,      0,      0,      0,
     -  CHAR,   16,     0,      44,     0,      0,
     -  BLANK,  16,     0,      0,      0,      0,
     -  DNUMB,  0,      15,     0,      0,      0,
     -  STATE,  20,     0,      0,      0,      0,
     -  CHAR,   20,     0,      58,     0,      0,
     -  CHAR,   20,     0,      44,     0,      0,
     -  BLANK,  20,     0,      0,      0,      0,
     -  DNUMB,  22,     16,     0,      0,      0,
     -  STATE,  17,     0,      0,      0,      0,
     -  CHAR,   17,     0,      44,     0,      0,
     -  BLANK,  17,     0,      0,      0,      0,
     -  DNUMB,  22,     15,     0,      0,      0,
     -  STATE,  18,     0,      0,      0,      0,
     -  BLANK,  18,     0,      0,      0,      0,
     -  CHAR,   18,     0,      44,     0,      0,
     -  KEYW,   18,     17,     27,     2,      0,
     -  KEYW,   18,     18,     29,     3,      0/
      DATA ((TABLE(I,J),I=1,TWI),J=114,THI) /
     -  EOS,    22,     0,      0,      0,      0,
     -  STATE,  19,     0,      0,      0,      0,
     -  STRNG,  21,     19,     0,      0,      0,
     -  LAMDA,  22,     0,      0,      0,      0,
     -  STATE,  21,     0,      0,      0,      0,
     -  CHAR,   22,     28,     61,     0,      0,
     -  LAMDA,  22,     0,      0,      0,      0,
     -  STATE,  22,     0,      0,      0,      0,
     -  LAMDA,  0,      33,     0,      0,      0,
     -  EXIT,   0,      0,      0,      0,      0/
N     table for KEYW transition
      DATA KEYTAB/
     -  'H','C',
     -  'S','T','A','T',
     -  'E','N','D',
     -  'O','N',
     -  'O','F','F',
     -  'E','R','R','L','E','V',
     -  'M','E','S','L','E','V',
     -  'T','T',
     -  'L','O','G',
     -  'M','O','D','E',
     -  'I','N','P',
     -  'W','A','I','T',
     -  'G','O',
     -  'A','B','O',
     -  'P','R','I',
     -  'D','E','F',
     -  'C','A','N',
     -  'S','H','O','W'/
C
C     Executable code:
C
      IF ( NSTATE.EQ.0 )
      THEN
N     Initialise state table
      FOR I=1,THI
      IF TABLE(TTYP,I).EQ.STATE
      THEN
      NSTATE=NSTATE+1
      STATAB(TABLE(NEXTST,I))=I
      CIF
      CFOR
      CIF
N
N     Traps holes in parser
      TYPE=-1
      STYPE=0
      Q1=0
      Q2=0
      Q3=0
      LS1=0
      LS2=0
      LS3=0
      LS4=0
N!RST
      INIT_34=.FALSE.
      INIT_36=.FALSE.
C
N     Length of string
      N = LEN(STRING)
N     Pointer in string
      ICP=1
      IT=2
N     Main loop
      WHILE .TRUE.
      QUAL1=TABLE(4,IT)
      QUAL2=TABLE(5,IT)
      QUAL3=TABLE(6,IT)
      SUCCES=.FALSE.
E     Transition routines
      SELECT TABLE(TTYP,IT)
N     ANY
      CASE 1
      SUCCES=ICP.LE.N
      ICP=MIN(ICP+1,N+1)
      NCHT=1
N
N     ALFA
      CASE 2
      SUCCES=STRING(ICP:ICP).GE.'A'
     -  .AND.  STRING(ICP:ICP).LE.'Z'
     -  .AND.  ICP.LE.N
      IF SUCCES
      THEN
      ICP=ICP+1
      NCHT=1
      CIF
N
N     DIGIT
      CASE 3
      IF ICP.LE.N
      THEN
      SUCCES=(STRING(ICP:ICP).GE.'0'.AND.STRING(ICP:ICP).LE.'9')
      CIF
      IF SUCCES
      THEN
      ICP=ICP+1
      NCHT=1
      CIF
N
N     LAMDA
      CASE 4
      SUCCES=.TRUE.
      NCHT=0
N
N     ONUMB
      CASE 5
      NUMBR=0
      K=ICP
      WHILE K.LE.N
      IDIF=ICHAR(STRING(K:K))-ICHAR('0')
      IF IDIF.GE.0.AND.IDIF.LE.7
      THEN
      K=K+1
      NUMBR=8*NUMBR+IDIF
      ELSE
      XWHILE
      CIF
      CWHILE
      IF IDIF.NE.8.AND.IDIF.NE.9.AND.K.NE.ICP
      THEN
      NCHT=K-ICP
      ICP=K
      SUCCES=.TRUE.
      CIF
N
N     DNUMB
      CASE 6
      NUMBR=0
      K=ICP
      WHILE K.LE.N
      IDIF=ICHAR(STRING(K:K))-ICHAR('0')
      IF IDIF.GE.0.AND.IDIF.LE.9
      THEN
      K=K+1
      NUMBR=10*NUMBR+IDIF
      ELSE
      XWHILE
      CIF
      CWHILE
      IF K.NE.ICP
      THEN
      NCHT=K-ICP
      ICP=K
      SUCCES=.TRUE.
      CIF
N
N     STRNG
      CASE 7
      K=ICP
      WHILE K.LE.N
      IF (STRING(K:K).GE.'0'.AND.STRING(K:K).LE.'9' .OR.
     #    STRING(K:K).GE.'A'.AND.STRING(K:K).LE.'Z' )
      THEN
      K=K+1
      ELSE
      XWHILE
      CIF
      CWHILE
      IF K.GT.ICP
      THEN
      SUCCES=.TRUE.
      NCHT=K-ICP
      ICP=K
      CIF
N
N     STREXT
      CASE 8
N     STRNG,$,_
      K=ICP
      WHILE K.LE.N
      IF (STRING(K:K).GE.'0'.AND.STRING(K:K).LE.'9' .OR.
     -    STRING(K:K).GE.'A'.AND.STRING(K:K).LE.'Z' .OR.
     -    STRING(K:K).EQ.'$'                        .OR.
     -    STRING(K:K).EQ.'_' )
      THEN
      K=K+1
      ELSE
      XWHILE
      CIF
      CWHILE
      IF K.GT.ICP
      THEN
      SUCCES=.TRUE.
      NCHT=K-ICP
      ICP=K
      CIF
N
N     BLANK
      CASE 9
      K=ICP
      WHILE K.LE.N
      IF STRING(K:K).EQ.' '
      THEN
      K=K+1
      ELSE
      XWHILE
      CIF
      CWHILE
      IF K.GT.ICP
      THEN
      SUCCES=.TRUE.
      NCHT=K-ICP
      ICP=K
      CIF
N
N     EOS
      CASE 10
      SUCCES=ICP.GT.N
      NCHT=0
N
N     CHAR
      CASE 11
      IF ICP.LE.N
      THEN
      IF (QUAL1.EQ.ICHAR(STRING(ICP:ICP)))
      THEN
      SUCCES=.TRUE.
      NCHT=1
      ICP=ICP+1
      CIF
      CIF
N
N     KEYW
      CASE 12
      K=ICP
      IKTP=QUAL1
      WHILE K.LE.N
      IF (STRING(K:K).EQ.KEYTAB(IKTP+K-ICP))
      THEN
      K=K+1
      ELSE
      XWHILE
      CIF
      CWHILE
      IF K-ICP.EQ.QUAL2
      THEN
      SUCCES=.TRUE.
      NCHT=K-ICP
      ICP=K
      CIF
N
N     STATE
      CASE 13
      SUCCES=.FALSE.
      XWHILE
N
N     EXIT
      CASE 14
      SUCCES=.TRUE.
      XWHILE
N
N
      OTHER
N
N
      CSELECT
E       Action routines
      IF SUCCES
      THEN
      SELECT TABLE(ACTION,IT)
N     *+
      CASE 1
      TYPE=1
      Q1=1
N     *-
      CASE 2
      TYPE=1
      Q1=-1
N     *
      CASE 3
      TYPE=1
      Q1=0
N     page number
      CASE 4
      Q2=NUMBR
      CASE 5
N     +
      CASE 6
      Q1=1
N     -
      CASE 7
      Q1=-1
      CASE 8
      TYPE=2
N     Default direction?
      IF Q1 .EQ. 0
      THEN
      Q1=1
      CIF
N     empty string?
      IF LS1.EQ.0
      THEN
          STYPE=1
          IF LS1_SAVE.EQ.0 
          THEN
            PERFORM REJECT
          ELSE
            LS1=LS1_SAVE
            FOR I=1,LS1_SAVE
              S1(I:I)=S1_SAVE(I:I)
            CFOR
          CIF
        ELSE
          STYPE=0
      CIF
      CASE 9
      LS1=LS1+1
        LS1_SAVE=LS1
N     string too long?
      IF LS1.GT.20
      THEN
      PERFORM REJECT
      ELSE
N     store next element
      S1(LS1:LS1)=STRING(ICP-1:ICP-1)
      S1_SAVE(LS1:LS1)=S1(LS1:LS1)
      CIF
      CASE 10
      IF Q3 .NE. 0 .AND. LS2 .NE. 0
      THEN
      SUCCES=.FALSE.
      XWHILE
      CIF
      LS2=ICP-1
      CASE 11
N     (Sub)directory name less than 9 chars
      IF NCHT.GT.9
      THEN
      PERFORM REJECT
      CIF
N     copy UIC to S2
      CASE 12
      FOR I=LS2,ICP-1
      S2(I-LS2+1:I-LS2+1)=STRING(I:I)
      CFOR
      LS2=ICP-LS2
N     copy task name
      CASE 13
      TYPE=3
      IF NCHT.LE.9
      THEN
      K=NCHT
      I=ICP-K
      J=1
      WHILE K.GT.0
      S1(J:J)=STRING(I:I)
      J=J+1
      I=I+1
      K=K-1
      CWHILE
      LS1=NCHT
      IF Q3 .NE. 0
      THEN
      WHILE (STRING(ICP:ICP) .EQ. ' ')
      ICP=ICP+1
      CWHILE
      CIF
      ELSE
      PERFORM REJECT
      CIF
      CASE 14
      STYPE=QUAL3
      CASE 15
      Q1=NUMBR
      CASE 16
      Q2=NUMBR
      CASE 17
N     TT
C      Q1=Q1.OR."31
      Q1=IORF(Q1,25)
      CASE 18
N     LOG
C      Q1=Q1.OR."2
      Q1=IORF(Q1,2)
      CASE 19
N     Start of keywords
      Q1=ICP-NCHT
      Q2=1
      CASE 20
      TYPE=4
      CASE 21
      CASE 22
      IF (STRING(ICP:ICP) .EQ. ':')
      THEN
      IF Q3 .NE. 0 .AND. LS3 .NE. 0
      THEN
      SUCCES=.FALSE.
      XWHILE
      CIF
      ICP=ICP+1
      LS3=NCHT+1
      K=LS3
      I=ICP-K
      J=1
      WHILE K .GT. 0
      S3(J:J)=STRING(I:I)
      J=J+1
      I=I+1
      K=K-1
      CWHILE
      ELSE
      PERFORM REJECT
      CIF
      CASE 23
      TYPE=5
      LS1=1
      S1(LS1:LS1)='$'
      CASE 24
      LS1=LS1+1
      S1(LS1:LS1)=STRING(ICP-1:ICP-1)
      CASE 25
      IF LS1 .EQ. 1 .AND. TYPE .NE. 6
      THEN
      TYPE=-1
      LS1=0
      CIF
      CASE 26
      TYPE=6
      LS1=1
      S1(LS1:LS1)='$'       
      CASE 27
      STYPE=1
      CASE 28
      Q2=0
      CASE 29
      Q1=ICP
      Q2=1
      CASE 30
      IF STYPE .NE. 1
      THEN
      PERFORM REJECT
      CIF
      CASE 31
      FOR I=1,LS1
      S4(I:I)=S1(I:I)
      CFOR
      LS4=LS1
      Q3=-1
      IF Q3 .NE. 0
      THEN
      WHILE (STRING(ICP:ICP) .EQ. ' ')
      ICP=ICP+1
      CWHILE
      CIF
      CASE 32
      Q3=1
      CASE 33
      IF Q3 .EQ. -1
      THEN
      SUCCES=.FALSE.
      XWHILE
      CIF
N!RST   global name in s1
      CASE 34
      IF .NOT.INIT_34
      THEN
        LS1=0
        INIT_34=.TRUE.
      CIF
      LS1=LS1+1
      S1(LS1:LS1)=STRING(ICP-1:ICP-1)
N!RST   '=' in s2
      CASE 35
      LS2=1
      S2(LS2:LS2)='='
N!RST   value of global name in s3
      CASE 36
      IF .NOT.INIT_36
      THEN
        LS3=0
        INIT_36=.TRUE.
      CIF
      LS3=LS3+1
      S3(LS3:LS3)=STRING(ICP-1:ICP-1)
N
      OTHER
      CSELECT
      CIF
E     Next state
      IF SUCCES.AND.TABLE(NEXTST,IT).NE.0
      THEN
N     Obtain entry number from table
      IT=STATAB(TABLE(NEXTST,IT))
      ELSE
N     Next entry (drop through)
      IT=IT+1
      CIF
      IF SUCCES.AND.TABLE(TTYP,IT).EQ.STATE
      THEN
N     Bypass "state handler"
      IT=IT+1
      CIF
      CWHILE
      IF .NOT.SUCCES
      THEN
      TYPE=-1
      CIF
      RETURN
      PROC REJECT
      SUCCES=.FALSE.
      ICP=ICP-NCHT
      CPROC
      END
#<

#>            SA_recv_msg.dc3
Name:         SA_recv_msg

Purpose:      Private to stand-alone hermes. Obtain reply.

File:         replymgr.c

Author:       J.P. Terlouw

Use:          int recv_msg(char* buffer_out, int number_requested);

Updates:      25-Feb-90  --  original document
              11-Oct-90  --  name changed from recv_msg to SA_recv_msg

#<

#>            SA_send_msg.dc3
Name:         SA_send_msg

Purpose:      Private. Send a request message to noHermes.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          SA_send_msg(RequestMessage *message);

Updates:      25-Feb-90  --  original document
              11-Oct-90  --  name changed from send_msg to SA_send_msg
               9-Sep-90  --  included in nohermes.src
#<

#>            ctrlc_handler.dc3
Function:       ctrlc_handler

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            delete_par.dc3
Name:     delete_par

Purpose:  Private to nohermes. Delete parameter from Userinp table.

Category: USER-INTERFACE

File:     nohermes.src

Author:   J.P. Terlouw
#<

#>            err_uca.dc3
Function:       err_uca

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            find_par.dc3
Function:       find_par

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            init_par.dc3
Name:     init_par

Purpose:  Private to nohermes. Initialize Userinp parameter table.

Category: USER-INTERFACE

File:     nohermes.src

Author:   J.P. Terlouw
#<

#>            insert_par.dc3
Name:     insert_par

Purpose:  Private to nohermes. Insert parameter in Userinp table.

Category: USER-INTERFACE

File:     nohermes.src

Author:   J.P. Terlouw
#<

#>            namstatus.dc3
Function:       namstatus

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            nohermes.dc1
Module:        nohermes

Purpose:       Provide user communication and process control functions
               to GIPSY programs.

Category:      USER-INTERFACE

File:          nohermes.src

Author:        J.P. Terlouw

Description:   This is a limited implementation of the Hermes functionality
               to be used on Unix systems until a complete implementation
               is available. It is linked as a set of subroutines to 
               individual programs which are started directly from the
               shell command line.
               When started, the prompt ">" appears which allows the user
               to specify a number of things, of which the most important
               probably will be the "hidden keywords". In this stage, the
               ">" prompt is repeated until an empty line is entered, after
               which processing starts.
               Parameter lists are stored as GDS descriptor files with a
               name of the form "TASKNAME_parm.descr". If the user types
               "!" at the first ">" prompt, the existing parameter file 
               is used if one exists. This mechanism simulates the automatic 
               macro's in the old GIPSY.
               
               The following commands are available (for a description see
               the VAX/VMS Hermes User's manual):
               
                  keyword=values         (only one keyword per line)
                  
                  /ABO
                  /ERRLEV n
                  /GO
                  /MESLEV n
                  /OFF dev
                  /ON dev
                  /MODE n
                  /STAT n
                
               When the program calls one of the routines of the Userinp
               family, the user is prompted in the usual way (depending
               on the default level). Input can then be given in the 
               usual way. If the user wants to give another command
               (including the specification of other keywords) first, 
               then he should first type ESC (followed by RETURN), after
               which the ">" prompt appears and any command can be given.
               If "?" is typed at the ">" prompt, the Userinp prompt will 
               re-appear. 
               When a program loops, e.g. until a hidden keyword is
               given, the user can type ^C to get the attention of Hermes.
               At the first occasion the ">" prompt will then appear.
               If ^C is typed repeatedly, the program simply stops.
                
               To the programmer the following routines are available:
                
                   INIT
                   FINIS
                   CANCEL
                   USERINT, USERREAL, etc.
                   ANYOUT
                   CANALL
                   MYNAME
                   ERROR
                   STATUS
                   
               The routines DEPUTY, XEQ, XEQXIT, SUBST, RAWPAR and TYPE
               have not been implemented and give an error message when
               called.

Updates:       25-Feb-90  --  original document
               11-Oct-90  --  send_msg replaced by SA_send_msg
               17-Dec-90  --  code for REJECT added
                7-Feb-91  --  code for WKEY added
                9-Sep-91  --  changed from "hermes" to "nohermes"
#<

#>            nohermes.dc3
Module:        nohermes

Purpose:       Provide user communication and process control functions
               to GIPSY programs.

Category:      USER-INTERFACE

File:          nohermes.src

Author:        J.P. Terlouw

See also:      nohermes.dc1

Updates:       10-Sep-91: JPT, original document
#<

#>            parse.dc3

Function:     PARSE

Purpose:      Parse HERMES command line. Private to nohermes.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          CALL PARSE( STRING ,     Input     CHARACTER*(*)
                          TYPE   ,     Output    INTEGER
                          STYPE  ,     Output    INTEGER
                          Q1     ,     Output    INTEGER
                          Q2     ,     Output    INTEGER
                          Q3     ,     Output    INTEGER
                          S1     ,     Output    CHARACTER*(*)
                          S2     ,     Output    CHARACTER*(*)
                          S3     ,     Output    CHARACTER*(*)
                          S4     )     Output    CHARACTER*(*)

              STRING     Character string containing input line
              TYPE       Type of command:
                         -1  syntax error
                          1  page command (*n *+n *-n)
                             q1 contains n;
                             q2= 0 for absolute page
                               =+1 for relative forward
                                -1 for relative backward
                          2  text search command
                             (=xxxx  -=xxxx  +=xxxx)
                             q1 contains length of text;
                             q2 = -1 for back search
                                = +1 for forward search
                             s1  contains text
                          3  task start command or specify keywords
                             for active task
                             q1 contains length of taskname
                             s1 contains taskname
                             q2 contains length of uic if any
                             s2 contains uic string
                             q3 contains startposition of
                                keywordstring if any
                          4  Control or Informational Command (CIC)
              STYPE       Subtype, used in combination with type 4
                          1      /INP
                          2      /WAIT
                          3      /GO
                          4      /ABO
                          5      /HC
                                 q3 and q2 contain start- and
                                 end-page numbers
                          6      /STAT
                                 q1 contains status level
                          7      /END
                          8      /ON
                                 q3 contains device bit map
                          9      /OFF
                                 q3 contains device bit map
                          10     /ERRLEV
                                 q3 contains level
                          11     /MESLEV
                                 q3 contains level
                          12     /MODE
                                 q1 contains mode.
                          14     /DEF
                                 s1 contains global name
                                 s2 contains '='
                                 s3 contains global value
                          15     /CAN
                                 s1 contains global name
                          16     /SHOW
                                 s1 contains global name or '*'  
              Q1          Return value depends on STYPE
              Q2          Return value depends on STYPE
              Q3          Return value depends on STYPE
              S1          Return value depends on STYPE
              S2          Return value depends on STYPE
              S3          Return value depends on STYPE
              S4          Return value depends on STYPE

Notes:        If a taskname is allowed in a CIC, it is stored in s1
              and the length is stored in q1.

Updates:      Feb 16, 1982: JPT, Original document
              Oct  7, 1983: RST, added /DEF, /CAN, /SHOW
              Feb 20, 1990: JPT, installed on ALLIANT, unchanged
              Jul 10, 1990: KGB, changed code to ANSI S77
              Sep  9, 1991: JPT, includen in nohermes

#<

#>            pidstatus.dc3
Function:       pidstatus

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            put_coa.dc3
Function:       put_coa

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            put_log.dc3
Function:       put_log

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            put_psa.dc3
Function:       put_psa

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            put_uca.dc3
Function:       put_uca

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            reply_clear.dc3
Name:         reply_clear

Purpose:      Private to nohermes. Clear reply buffer.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          reply_clear();

Updates:      25-Feb-90  --  original document
               9-Sep-91  --  included in nohermes
#<

#>            reply_put.dc3
Name:         reply_put

Purpose:      Private to nohermes. Store reply data in buffer.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          reply_put(char *data, int number);

Updates:      25-Feb-90  --  original document
               9-Sep-91  --  included in nohermes
#<

#>            reply_ready.dc3
Name:         reply_ready

Purpose:      Private to hermes. Check whether reply available.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          bool reply_ready();

Updates:      25-Feb-90  --  original document
               9-Sep-91  --  included in nohermes
#<

#>            reply_send.dc3
Name:         reply_send

Purpose:      Private to hermes. Set error code and declare reply availability.

Category:     USER-INTERFACE

File:         nohermes.src

Author:       J.P. Terlouw

Use:          bool reply_send(TaskStatus status, int result_code);

Updates:      25-Feb-90  --  original document
               9-Sep-91  --  included in nohermes
#<

#>            replymgr.dc3
Module:      replymgr

Purpose:     Private to ("stand-alone") hermes. Collection of routines to 
             manage hermes' reply to a requesting servant.
             
File:        replymgr.c

Author:      J.P. Terlouw

Description: The following routines are available:

          a) services to Hermes:

             void reply_clear(void)   initializes the internal buffer.
             
             void reply_put(char *data, int number)
                                      appends 'number' bytes taken from
                                      'data' to the internal buffer.

              void reply_send(TaskStatus status, int result)
                                       writes the 'result' code to the
                                       buffer (0 = no error). 'Status'
                                       specifies the task status block
                                       of the requesting servant
                                       (currently not used).
                                       
               bool reply_ready(void)  returns true if buffer is ready
                                       to be sent to servant, i.e. if
                                       reply_send has been called.
                                       
          b) service to the requesting servant (after binding by bind_hermes
             called from srvreq):
              
              int SA_recv_msg(char *bufout, int number)
                                       obtain up to 'number' bytes from
                                       the buffer and store them in
                                       'bufout'. Return the actual number
                                       of bytes received. The first bytes
                                       form the result code.

Updates:     23-Feb-90  --  original document
             11-Oct-90  --  name of recv_msg changed to SA_recv_msg
#<

#>            satisfy.dc3
Function:       satisfy

Purpose:        Private to nohermes.

Category:       USER-INTERFACE

File:           nohermes.src

Author:         J.P. Terlouw

Updates:        Sep 9, 1991: JPT, document created.
#<

#>            use_par.dc3
Name:     use_par

Purpose:  Private to nohermes. Use existing Userinp parameter table, if any.

Category: USER-INTERFACE

File:     nohermes.src

Author:   J.P. Terlouw
#<
