slstd.c

一个C格式的脚本处理函数库源代码,可让你的C程序具有执行C格式的脚本文件

	str_len += len;
     }

   fclose (fp);

   (void) SLang_push_malloced_string (str);
}

static int push_string_array_elements (SLang_Array_Type *at)
{
   char **strs;
   unsigned int num;
   unsigned int i;

   if (at == NULL)
     return -1;
   
   strs = (char **)at->data;
   num = at->num_elements;
   for (i = 0; i < num; i++)
     {
	if (-1 == SLang_push_string (strs[i]))
	  {
	     SLdo_pop_n (i);
	     return -1;
	  }
     }
   SLang_push_integer ((int) num);
   return 0;
}

	
static void intrin_apropos (void)
{
   int num_args;
   char *pat;
   char *namespace_name;
   unsigned int flags;
   SLang_Array_Type *at;

   num_args = SLang_Num_Function_Args;

   if (-1 == SLang_pop_uinteger (&flags))
     return;
   if (-1 == SLang_pop_slstring (&pat))
     return;
   
   namespace_name = NULL;
   at = NULL;
   if (num_args == 3)
     {
	if (-1 == SLang_pop_slstring (&namespace_name))
	  goto free_and_return;
     }

   at = _SLang_apropos (namespace_name, pat, flags);
   if (num_args == 3)
     {
	(void) SLang_push_array (at, 0);
	goto free_and_return;
     }

   /* Maintain compatibility with old version of the function.  That version
    * did not take three arguments and returned everything to the stack.
    * Yuk.
    */
   (void) push_string_array_elements (at);

   free_and_return:
   /* NULLs ok */
   SLang_free_slstring (namespace_name);
   SLang_free_slstring (pat);
   SLang_free_array (at);
}

static int intrin_get_defines (void)
{
   int n = 0;
   char **s = _SLdefines;

   while (*s != NULL)
     {
	if (-1 == SLang_push_string (*s))
	  {
	     SLdo_pop_n ((unsigned int) n);
	     return -1;
	  }
	s++;
	n++;
     }
   return n;
}

static void intrin_get_reference (char *name)
{
   _SLang_push_ref (1, (VOID_STAR) _SLlocate_name (name));
}

static void intrin_get_namespaces (void)
{
   SLang_push_array (_SLns_list_namespaces (), 1);
}

#ifdef HAVE_SYS_UTSNAME_H
# include <sys/utsname.h>
#endif

static void uname_cmd (void)
{
#ifdef HAVE_UNAME
   struct utsname u;
   char *field_names [6];
   unsigned char field_types[6];
   VOID_STAR field_values [6];
   char *ptrs[6];
   int i;

   if (-1 == uname (&u))
     (void) SLang_push_null ();

   field_names[0] = "sysname"; ptrs[0] = u.sysname;
   field_names[1] = "nodename"; ptrs[1] = u.nodename;
   field_names[2] = "release"; ptrs[2] = u.release;
   field_names[3] = "version"; ptrs[3] = u.version;
   field_names[4] = "machine"; ptrs[4] = u.machine;

   for (i = 0; i < 5; i++)
     {
	field_types[i] = SLANG_STRING_TYPE;
	field_values[i] = (VOID_STAR) &ptrs[i];
     }

   if (0 == SLstruct_create_struct (5, field_names, field_types, field_values))
     return;
#endif

   SLang_push_null ();
}

static void uninitialize_ref_intrin (SLang_Ref_Type *ref)
{
   (void) _SLang_uninitialize_ref (ref);
}

static int class_type_intrinsic (void)
{
   unsigned char type;

   if (-1 == SLang_pop_datatype (&type))
     return -1;
   return _SLclass_get_class (type)->cl_class_type;
}

static int class_id_intrinsic (void)
{
   unsigned char type;

   if (-1 == SLang_pop_datatype (&type))
     return -1;
   return _SLclass_get_class (type)->cl_data_type;
}

static int eqs_intrinsic (void)
{
   int eqs;
   SLang_Object_Type a, b;
   
   if (-1 == SLang_pop (&b))
     return -1;
   
   if (-1 == SLang_pop (&a))
     {
	SLang_free_object (&b);
	return -1;
     }
   
   eqs = (a.data_type == b.data_type);
   if (eqs)
     {
	SLang_Class_Type *cl = _SLclass_get_class (a.data_type);
	unsigned int sizeof_type = cl->cl_sizeof_type;

	switch (cl->cl_class_type)
	  {
	   case SLANG_CLASS_TYPE_MMT:
	   case SLANG_CLASS_TYPE_PTR:
	     eqs = (a.v.ptr_val == b.v.ptr_val);
	     break;

	   case SLANG_CLASS_TYPE_SCALAR:
	     eqs = !memcmp (&a.v, &b.v, sizeof_type);
	     break;

	   case SLANG_CLASS_TYPE_VECTOR:
	     eqs = !memcmp (a.v.ptr_val, b.v.ptr_val, sizeof_type);
	     break;
	  }
     }
   
   SLang_free_object (&a);
   SLang_free_object (&b);
   return eqs;
}

static void lang_print_stack (void)
{
   (void) _SLang_dump_stack ();
}

static SLang_Intrin_Fun_Type SLang_Basic_Table [] = /*{{{*/
{
   MAKE_INTRINSIC_1("__is_initialized", _SLang_is_ref_initialized, SLANG_INT_TYPE, SLANG_REF_TYPE),
   MAKE_INTRINSIC_S("__get_reference", intrin_get_reference, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_1("__uninitialize", uninitialize_ref_intrin, SLANG_VOID_TYPE, SLANG_REF_TYPE),
   MAKE_INTRINSIC_0("__eqs", eqs_intrinsic, SLANG_INT_TYPE),
   MAKE_INTRINSIC_0("__class_type", class_type_intrinsic, SLANG_INT_TYPE),
   MAKE_INTRINSIC_0("__class_id", class_id_intrinsic, SLANG_INT_TYPE),
   MAKE_INTRINSIC_SS("get_doc_string_from_file",  get_doc_string, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_SS("autoload",  SLang_autoload, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("is_defined",  SLang_is_defined, SLANG_INT_TYPE),
   MAKE_INTRINSIC_0("string",  _SLstring_intrinsic, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("uname", uname_cmd, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("getenv",  intrin_getenv_cmd, SLANG_VOID_TYPE),
#ifdef HAVE_PUTENV
   MAKE_INTRINSIC_0("putenv",  intrin_putenv, SLANG_VOID_TYPE),
#endif
   MAKE_INTRINSIC_0("evalfile",  load_file, SLANG_INT_TYPE),
   MAKE_INTRINSIC_I("char",  char_cmd, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("eval",  load_string, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("dup",  do_dup, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("integer",  intrin_integer, SLANG_INT_TYPE),
   MAKE_INTRINSIC_S("system",  SLsystem, SLANG_INT_TYPE),
   MAKE_INTRINSIC_0("_apropos",  intrin_apropos, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("_get_namespaces", intrin_get_namespaces, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("_trace_function",  _SLang_trace_fun, SLANG_VOID_TYPE),
#if SLANG_HAS_FLOAT
   MAKE_INTRINSIC_S("atof", _SLang_atof, SLANG_DOUBLE_TYPE),
   MAKE_INTRINSIC_0("double", intrin_double, SLANG_VOID_TYPE),
#endif
   MAKE_INTRINSIC_0("int",  intrin_int, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("typecast", intrin_typecast, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("_stkdepth", _SLstack_depth, SLANG_INT_TYPE),
   MAKE_INTRINSIC_I("_stk_reverse", intrin_reverse_stack, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("typeof", intrin_type_info, VOID_TYPE),
   MAKE_INTRINSIC_0("_typeof", intrin_type_info1, VOID_TYPE),
   MAKE_INTRINSIC_I("_pop_n", intrin_pop_n, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("_print_stack", lang_print_stack, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_I("_stk_roll", intrin_roll_stack, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_SI("byte_compile_file", byte_compile_file, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("_clear_error", _SLang_clear_error, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("_function_name", intrin_function_name, SLANG_STRING_TYPE),
#if SLANG_HAS_FLOAT
   MAKE_INTRINSIC_S("set_float_format", _SLset_double_format, SLANG_VOID_TYPE),
#endif
   MAKE_INTRINSIC_S("_slang_guess_type", guess_type, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("error", intrin_error, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("message", intrin_message, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("__get_defined_symbols", intrin_get_defines, SLANG_INT_TYPE),
   MAKE_INTRINSIC_I("__pop_args", _SLstruct_pop_args, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_1("__push_args", _SLstruct_push_args, SLANG_VOID_TYPE, SLANG_ARRAY_TYPE),
   MAKE_INTRINSIC_0("usage", usage, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("implements", _SLang_implements_intrinsic, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_S("use_namespace", _SLang_use_namespace_intrinsic, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("current_namespace", _SLang_cur_namespace_intrinsic, SLANG_STRING_TYPE),
   MAKE_INTRINSIC_0("length", length_cmd, SLANG_INT_TYPE),
   SLANG_END_INTRIN_FUN_TABLE
};

/*}}}*/

#ifdef SLANG_DOC_DIR
char *SLang_Doc_Dir = SLANG_DOC_DIR;
#else
char *SLang_Doc_Dir = "";
#endif

static SLang_Intrin_Var_Type Intrin_Vars[] =
{
   MAKE_VARIABLE("_debug_info", &_SLang_Compile_Line_Num_Info, SLANG_INT_TYPE, 0),
   MAKE_VARIABLE("_auto_declare", &_SLang_Auto_Declare_Globals, SLANG_INT_TYPE, 0),
   MAKE_VARIABLE("_traceback", &SLang_Traceback, SLANG_INT_TYPE, 0),
   MAKE_VARIABLE("_slangtrace", &_SLang_Trace, SLANG_INT_TYPE, 0),
   MAKE_VARIABLE("_slang_version", &SLang_Version, SLANG_INT_TYPE, 1),
   MAKE_VARIABLE("_slang_version_string", &SLang_Version_String, SLANG_STRING_TYPE, 1),
   MAKE_VARIABLE("_NARGS", &SLang_Num_Function_Args, SLANG_INT_TYPE, 1),
   MAKE_VARIABLE("_slang_doc_dir", &SLang_Doc_Dir, SLANG_STRING_TYPE, 1),
   MAKE_VARIABLE("NULL", NULL, SLANG_NULL_TYPE, 1),
   SLANG_END_INTRIN_VAR_TABLE
};

int SLang_init_slang (void) /*{{{*/
{
   char name[3];
   unsigned int i;
   char **s;
   static char *sys_defines [] =
     {
#if defined(__os2__)
	"OS2",
#endif
#if defined(__MSDOS__)
	"MSDOS",
#endif
#if defined(__WIN16__)
	"WIN16",
#endif
#if defined (__WIN32__)
	"WIN32",
#endif
#if defined(__NT__)
	"NT",
#endif
#if defined (VMS)
	"VMS",
#endif
#ifdef REAL_UNIX_SYSTEM
	"UNIX",
#endif
#if SLANG_HAS_FLOAT
	"SLANG_DOUBLE_TYPE",
#endif
	NULL
     };

   if (-1 == _SLregister_types ()) return -1;

   if ((-1 == SLadd_intrin_fun_table(SLang_Basic_Table, NULL))
       || (-1 == SLadd_intrin_var_table (Intrin_Vars, NULL))
       || (-1 == _SLang_init_slstrops ())
       || (-1 == _SLang_init_sltime ())
       || (-1 == _SLstruct_init ())
#if SLANG_HAS_ASSOC_ARRAYS
       || (-1 == SLang_init_slassoc ())
#endif
       )
     return -1;

   SLadd_global_variable (SLANG_SYSTEM_NAME);

   s = sys_defines;
   while (*s != NULL)
     {
	if (-1 == SLdefine_for_ifdef (*s)) return -1;
	s++;
     }

   /* give temp global variables $0 --> $9 */
   name[2] = 0; name[0] = '$';
   for (i = 0; i < 10; i++)
     {
	name[1] = (char) (i + '0');
	SLadd_global_variable (name);
     }

   SLang_init_case_tables ();

   /* Now add a couple of macros */
   SLang_load_string (".(_NARGS 1 - Sprintf error)verror");
   SLang_load_string (".(_NARGS 1 - Sprintf message)vmessage");

   if (SLang_Error)
     return -1;

   return 0;
}

/*}}}*/

int SLang_set_argc_argv (int argc, char **argv)
{
   static int this_argc;
   static char **this_argv;
   int i;

   if (argc < 0) argc = 0;
   this_argc = argc;

   if (NULL == (this_argv = (char **) SLmalloc ((argc + 1) * sizeof (char *))))
     return -1;
   memset ((char *) this_argv, 0, sizeof (char *) * (argc + 1));

   for (i = 0; i < argc; i++)
     {
	if (NULL == (this_argv[i] = SLang_create_slstring (argv[i])))
	  goto return_error;
     }

   if (-1 == SLadd_intrinsic_variable ("__argc", (VOID_STAR)&this_argc,
				       SLANG_INT_TYPE, 1))
     goto return_error;

   if (-1 == SLang_add_intrinsic_array ("__argv", SLANG_STRING_TYPE, 1,
					(VOID_STAR) this_argv, 1, argc))
     goto return_error;

   return 0;

   return_error:
   for (i = 0; i < argc; i++)
     SLang_free_slstring (this_argv[i]);   /* NULL ok */
   SLfree ((char *) this_argv);

   return -1;
}