#ifndef DAVIS_SLANG_H_
#define DAVIS_SLANG_H_
/* 
 * Copyright (c) 1992, 1994 John E. Davis 
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 *
 * IN NO EVENT SHALL JOHN E. DAVIS BE LIABLE TO ANY PARTY FOR DIRECT,
 * INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF
 * THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF JOHN E. DAVIS
 * HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * JOHN E. DAVIS SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 * PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
 * BASIS, AND JOHN E. DAVIS HAS NO OBLIGATION TO PROVIDE MAINTENANCE,
 * SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */


#ifdef USE_DOUBLE
#define FLOAT double
#else
#define FLOAT float
#endif

typedef struct SLang_User_Object_Type
  {
     unsigned short type;
     long value;
  }
SLang_User_Object_Type;

/* The first 8 bits of type specify the basic type, e.g., intrinsic, block,
   etc...  The next 8 bits (high byte) are extended attributes which 
   are specific to the type, e.g., local variable of type string.
   
   For Lang_Functions, the higher order byte of type is the number of
   local variables 0->255 */
      
	 
	    
#define LANG_MAX_NAME_LEN 30
/* maximum length of an identifier */
/* first char in identifiers is the hash */

typedef struct SLang_Name_Type
  {
#ifdef SLANG_STATS
     int n;			       /* number of times referenced */
#endif
     char name[LANG_MAX_NAME_LEN + 2]; /* [0] is hash */
     SLang_User_Object_Type obj;
  }
SLang_Name_Type;

typedef struct SLang_Load_Type
{
   int type;			       /* 'F' = file, 'S' = String, etc.. */
   long name;			       /* file name, string address, ... */
   long handle;			       /* FILE *, string address, etc... */
   char *buf;			       /* buffer for file, etc... */
   char *(*read)(struct SLang_Load_Type *);   /* function to call to read obj */
   int n;			       /* line number, etc... */
   char token[256];		       /* token to be parsed */
   char *ptr;			       /* input pointer */
} SLang_Load_Type;

  extern volatile int SLang_Error;
  /* Non zero if error occurs.  Must be reset to zero to continue. */

  extern int SLang_Traceback;
  /* If non-zero, dump an S-Lang traceback upon error.  Available as 
     _traceback in S-Lang. */

  extern char *SLang_User_Prompt;
  /* Prompt to use when reading from stdin */
  extern char SLang_Version[];

  extern int (*SLang_Error_Routine)(char *);
  /* Pointer to application dependent error messaging routine.  By default,
     messages are displayed on stderr. */

  extern void (*SLang_Dump_Routine)(char *);
  /* Called if S-Lang traceback is enabled as well as other debugging 
     routines (e.g., trace).  By default, these messages go to stderr. */
  
  extern void (*SLang_Interrupt)(void);
  /* function to call whenever inner interpreter is entered.  This is 
     a good place to set SLang_Error to USER_BREAK. */

  extern void (*user_clear_error)(void);
  /* function that gets called when '_clear_error' is called. */
  extern int (*user_open_slang_object)(SLang_Load_Type *); 
  extern int (*user_close_slang_object)(SLang_Load_Type *);
  /* user defined loading routines. */


  /* If non null, these call C functions before and after a slang function. */
  extern void (*SLang_Enter_Function)(char *);
  extern void (*SLang_Exit_Function)(char *);


/* Functions: */

   extern int init_SLang(void);   
   /* This function is mandatory and must be called by all applications */
   extern int init_SLfiles(void);
   /* called if fputs, fgets, etc are need in S-Lang */
   extern int init_SLmath(void);
   /* called if math functions sin, cos, etc... are needed. */

   extern int init_SLunix(void);
   /* unix system functions chmod, stat, etc... */
   
   int SLang_add_table(SLang_Name_Type *, char *);
   /* add application dependent function table p1 to S-Lang.  A name p2 less 
      than 32 characters must also be supplied.      
      Returns 0 upon failure or 1 upon success. */

   extern int SLang_load_object(SLang_Load_Type *);
   extern int SLang_load_file(char *);
   /* Load a file of S-Lang code for interpreting.  If the parameter is
   NULL, input comes from stdin. */

   extern void SLang_restart(int);
   /* should be called if an error occurs.  If the passed integer is
   non-zero, items are popped off the stack; otherwise, the stack is 
   left intact.  Any time the stack is believed to be trashed, this routine
   should be called with a non-zero argument (e.g., if setjmp/longjmp is
   called). */ 

   extern void SLang_byte_compile_file(char *, int *);
   /* takes a file of S-Lang code and ``byte-compiles'' it for faster
   loading.  The new filename is equivalent to the old except that a `c' is
   appended to the name.  (e.g., init.sl --> init.slc).  If the second 
   parameter is non-zero, preprocess the file only.
   */

   extern void SLang_autoload(char *, char *);
   /* Automatically load S-Lang function p1 from file p2.  This function
      is also available via S-Lang */
   
   extern char *SLang_load_string(char *);
   /* Like SLang_load_file except input is from a null terminated string. */
   
   extern void SLang_do_pop(void);
   /* pops item off stack and frees any memory associated with it */
   
   extern int SLang_pop_integer(int *);
   /* pops integer *p0 from the stack.  Returns 0 upon success and non-zero
      if the stack is empty or a type mismatch occurs, setting SLang_Error.
      */

   extern int SLang_pop_string(char **, int *);
   /* pops string *p0 from stack.  If *p1 is non-zero, the string must be
      freed after its use.  DO NOT FREE p0 if *p1 IS ZERO! Returns 0 upon
      success */
      
   extern int SLang_pop_float(FLOAT *, int *, int *);
   /* Pops float *p1 from stack.  If *p3 is non-zero, *p1 was derived
      from the integer *p2. Returns zero upon success. */
      
   extern long *SLang_pop_pointer(unsigned short *, int *);
   /* Returns a pointer to object of type *p1 on top of stack. 
      If *p2 is non-zero, the Object must be freed after use. */

   
   extern void SLang_push_string(char *);
   /* Push string p1 onto stack */
   
   extern void SLang_push_integer(int);
   /* push integer p1 on stack */

   extern void SLang_push_malloced_string(char *);
   /* The normal SLang_push_string mallocs space for the string.  This one
      does not.  DO NOT FREE IT IF YOU USE THIS ROUTINE */

   extern int SLdefine_for_ifdef (char *);
   /* Adds a string to the SLang #ifdef preparsing defines. SLang already
      defines MSDOS, UNIX, and VMS on the appropriate system. */
      
   extern int SLang_is_defined(char *);
   /* Return non-zero is p1 is defined otherwise returns 0. */
   
   extern int SLang_run_hooks(char *, char *, char *);
   /* calls S-Lang function p1 pushing strings p2 and p3 onto the stack
      first.  If either string is NULL, it is not pushed. If p1 is not
      defined, 0 is returned. */

   extern int SLang_execute_function(char *);
   /* Call S-Lang function p1 */

   extern char *SLang_find_name(char *);
   /* Return a pointer to p1 in table if it is defined.  Returns NULL
   otherwise.  This is useful when one wants to avoid redundant strings. 
   */

   extern char *SLang_rpn_interpret(char *);
   /* Interpret string as reverse polish notation */

   extern void SLang_doerror(char *);
   /* set SLang_Error and display p1 as error message */
   
   extern int SLang_add_array(char *, long *, int, int, int, int, 
			      unsigned char, unsigned char);
   /* This function has not been tested thoroughly yet.  Its purpose is to 
    * allow a S-Lang procedure to access a C array. For example, suppose that 
    * you have an array of 100 ints defined as:
    *  
    *  int c_array[100];
    *
    * By calling something like:
    *
    *   SLang_add_array ("array_name", (long *) c_array, 1, 100, 0, 0,
			 'i', LANG_IVARIABLE);
    *
    * the array can be accessed by the name 'array_name'.  This function 
    * returns -1 upon failure.  The 3rd argument specifies the dimension 
    * of the array, the 4th, and 5th arguments specify how many elements
    * there are in the x,y, and z directions.  The last argument must 
    * be one of: 
    * 
    *        LANG_IVARIABLE:  indicates array is writable
    *        LANG_IVARIABLE:  indicates array is read only
    */

   extern char *SLang_extract_list_element(char *, int *, int*);
   extern void SLexpand_escaped_string (register char *, register char *, 
					register char *);

/* subtypes of literal (static) and data (dynamic)*/
#define VOID_TYPE	1
#define INT_TYPE 	2
#define STRING_TYPE 	3
#define ARRAY_TYPE	4
#ifdef FLOAT_TYPE
#undef FLOAT_TYPE
#define FLOAT_TYPE	5
#endif
#define LANG_OBJ_TYPE	6
#define CHAR_TYPE	7


/* Note LANG_CMP and LANG_BINARY MUST!! be in this position!!!! */
#define LANG_CMP	0x01
#define LANG_BINARY	0x02
#define LANG_LVARIABLE	0x03
#define LANG_LITERAL	0x04           /* constant objects */
#define LANG_INTRINSIC 	0x05
#define LANG_DIRECTIVE	0x06
#define LANG_UNARY	0x07

/* items below here in the switch statement */
#define LANG_BLOCK      0x08
#define LANG_GVARIABLE 	0x09
#define LANG_DATA	0x0A           /* real objects which may be destroyed */
#define LANG_FUNCTION  	0x0B
#define LANG_IVARIABLE 	0x0C           /* intrinsic variables */
/* Note!!! For Macro MAKE_VARIABLE below to work, LANG_IVARIABLE Must
   be 1 less than LANG_RVARIABLE!!! */
#define LANG_RVARIABLE	0x0D	       /* read only variable */
#define LANG_RETURN	0x0E
#define LANG_BREAK	0x0F
#define LANG_CONTINUE	0x10
#define LANG_LABEL	0x11
#define LANG_EXCH	0x12
#define LANG_X_ERROR	0x13
#define LANG_GOBJPTR	0x14
#define LANG_LOBJPTR	0x15

/* error codes, severe errors are less than 0 */
#define SL_INVALID_PARM		-6
#define SL_MALLOC_ERROR		-5
#define INTERNAL_ERROR		-4
#define UNKNOWN_ERROR		-3
#define STACK_OVERFLOW		-1
#define STACK_UNDERFLOW		-2
#define INTRINSIC_ERROR		1
/* Intrinsic error is an error generated by intrinsic functions */
#define USER_BREAK		2
#define UNDEFINED_NAME		3
#define SYNTAX_ERROR		4
#define DUPLICATE_DEFINITION	5
#define TYPE_MISMATCH		6
#define READONLY_ERROR		7
#define DIVIDE_ERROR		8
/* object could not be opened */
#define SL_OBJ_NOPEN		9
/* unknown object */
#define SL_OBJ_UNKNOWN		10






#ifdef SLANG_STATS

#define MAKE_INTRINSIC(n, f, out, in)        \
    {0, n, {((out | (in << 4)) << 8) | LANG_INTRINSIC, (long) f}}
       
#define MAKE_VARIABLE(n, v, t, r)     \
    {0, n, {(LANG_IVARIABLE + r) | (t << 8), (long) v}}

#else
#define MAKE_INTRINSIC(n, f, out, in)        \
    {n, {((out | (in << 4)) << 8) | LANG_INTRINSIC, (long) f}}
       
#define MAKE_VARIABLE(n, v, t, r)     \
    {n, {(LANG_IVARIABLE + r) | (t << 8), (long) v}}
#endif

#define SLANG_END_TABLE  MAKE_INTRINSIC("", 0, 0, 0)

/* Uppercase, lowercase macros */
extern void SLang_define_case(int *, int *);

extern unsigned char Chg_UCase_Lut[256];
extern unsigned char Chg_LCase_Lut[256];
#define UPPER_CASE(x) (Chg_UCase_Lut[(unsigned char) (x)])
#define LOWER_CASE(x) (Chg_LCase_Lut[(unsigned char) (x)])
#define CHANGE_CASE(x) (((x) == Chg_LCase_Lut[(unsigned char) (x)]) ?\
			Chg_UCase_Lut[(unsigned char) (x)] : Chg_LCase_Lut[(unsigned char) (x)])


typedef struct
{
   unsigned char *pat;		       /* regular expression pattern */
   unsigned char *buf;		       /* buffer for compiled regexp */
   int buf_len;			       /* length of buffer */
   int case_sensitive;		       /* 1 if match is case sensitive  */
   int must_match;		       /* 1 if line must contain substring */
   int must_match_bol;		       /* true if it must match beginning of line */
   unsigned char must_match_str[16];   /* 15 char null term substring */
   int osearch;			       /* 1 if ordinary search suffices */
   int beg_matches[10];		       /* offset of start of \( */
   int end_matches[10];		       /* length of nth submatch
					* Note that the entire match corresponds
					* to \0 
					*/
   int offset;			       /* offset to be added to beg_matches */
} SLRegexp_Type;

extern unsigned char *SLang_regexp_match(unsigned char *, int, SLRegexp_Type *);
extern int SLang_regexp_compile (SLRegexp_Type *);

#ifdef SLKEYMAPS
/* Keymap routines and definitions */
typedef
{
   char *name;
   int (*f) (void);
}
SLKeymap_Fun_Type;
#endif

/* _davis_slang_h_ */
#endif 
