#ifndef DAVIS_SLANG_H_
#define DAVIS_SLANG_H_
/* 

   Copyright (C) 1993 John E. Davis (davis@amy.tch.harvard.edu)
   All rights reserved.

   This file is part of S-Lang.

   S-Lang is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY.  No author or distributor accepts responsibility to
   anyone for the consequences of using it or for whether it serves any
   particular purpose or works at all, unless he says so in writing.
   Refer to the S-Lang General Public License for full details.

   Everyone is granted permission to copy, modify and redistribute
   S-Lang, but only under the conditions described in the S-Lang General
   Public License.  A copy of this license is supposed to have been given
   to you along with S-Lang so you can know your rights and
   responsibilities.  It should be in a file named COPYING.  Among other
   things, the copyright notice and this notice must be preserved on all
   copies.

*/


typedef struct SLang_Object_Type
  {
     unsigned short type;
     long value;
  }
SLang_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_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. */

/* 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. */
   
   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 *);
   /* 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). */

   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 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 long *SLang_add_array(char *, long *, int, int, int, int, char);
   /* Undocumented */

   extern char *SLang_extract_list_element(char *, int *, int*);

/* 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_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 bpos;			       /* offset of pointer to start of match */
   int epos;			       /* offset of pointer to end of match */
   int must_match;		       /* 1 if line must contain substring */
   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];		       /* offset of end of \) expression */
} SLRegexp_Type;

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

/* _davis_slang_h_ */
#endif 
