int SLang_init_slassoc (void)
{
SLang_Class_Type *cl;
if (SLclass_is_class_defined (SLANG_ASSOC_TYPE))
return 0;
if (NULL == (cl = SLclass_allocate_class ("Assoc_Type")))
return -1;
(void) SLclass_set_destroy_function (cl, assoc_destroy);
(void) SLclass_set_aput_function (cl, _pSLassoc_aput);
(void) SLclass_set_aget_function (cl, _pSLassoc_aget);
(void) SLclass_set_anew_function (cl, assoc_anew);
cl->cl_length = assoc_length;
cl->cl_foreach_open = cl_foreach_open;
cl->cl_foreach_close = cl_foreach_close;
cl->cl_foreach = cl_foreach;
if (-1 == SLclass_register_class (cl, SLANG_ASSOC_TYPE, sizeof (SLang_Assoc_Array_Type), SLANG_CLASS_TYPE_MMT))
return -1;
if (-1 == SLadd_intrin_fun_table (Assoc_Table, "__SLASSOC__"))
return -1;
return 0;
}
int SLang_init_posix_process (void)
{
if ((-1 == SLadd_intrin_fun_table (Process_Name_Table, "__POSIX_PROCESS__"))
|| (-1 == _pSLerrno_init ()))
return -1;
return 0;
}
int _SLang_init_bstring (void)
{
SLang_Class_Type *cl;
if (NULL == (cl = SLclass_allocate_class ("BString_Type")))
return -1;
(void) SLclass_set_destroy_function (cl, bstring_destroy);
(void) SLclass_set_push_function (cl, bstring_push);
(void) SLclass_set_string_function (cl, bstring_string);
if (-1 == SLclass_register_class (cl, SLANG_BSTRING_TYPE, sizeof (char *),
SLANG_CLASS_TYPE_PTR))
return -1;
if ((-1 == SLclass_add_typecast (SLANG_BSTRING_TYPE, SLANG_STRING_TYPE, bstring_to_string, 1))
|| (-1 == SLclass_add_typecast (SLANG_STRING_TYPE, SLANG_BSTRING_TYPE, string_to_bstring, 1))
|| (-1 == SLclass_add_binary_op (SLANG_STRING_TYPE, SLANG_BSTRING_TYPE, string_bstring_bin_op, bstring_bstring_bin_op_result))
|| (-1 == SLclass_add_binary_op (SLANG_BSTRING_TYPE, SLANG_STRING_TYPE, bstring_string_bin_op, bstring_bstring_bin_op_result))
|| (-1 == SLclass_add_binary_op (SLANG_BSTRING_TYPE, SLANG_BSTRING_TYPE, bstring_bstring_bin_op, bstring_bstring_bin_op_result)))
return -1;
if (-1 == SLadd_intrin_fun_table (BString_Table, NULL))
return -1;
return 0;
}
int SLang_init_ospath (void)
{
if (-1 == SLadd_intrin_fun_table(Path_Name_Table, "__OSPATH__"))
return -1;
return 0;
}
int _pSLang_init_sllist (void)
{
SLang_Class_Type *cl;
if (SLclass_is_class_defined (SLANG_LIST_TYPE))
return 0;
if (NULL == (cl = SLclass_allocate_class ("List_Type")))
return -1;
(void) SLclass_set_destroy_function (cl, cl_list_destroy);
(void) SLclass_set_push_function (cl, cl_list_push);
(void) SLclass_set_aput_function (cl, _pSLlist_aput);
(void) SLclass_set_aget_function (cl, _pSLlist_aget);
(void) SLclass_set_deref_function (cl, cl_list_dereference);
(void) SLclass_set_string_function (cl, string_method);
(void) SLclass_set_eqs_function (cl, eqs_method);
(void) SLclass_set_is_container (cl, 1);
cl->cl_length = list_length;
cl->cl_foreach_open = cl_foreach_open;
cl->cl_foreach_close = cl_foreach_close;
cl->cl_foreach = cl_foreach;
if (-1 == SLclass_register_class (cl, SLANG_LIST_TYPE, sizeof (SLang_List_Type), SLANG_CLASS_TYPE_PTR))
return -1;
if (-1 == SLadd_intrin_fun_table (Intrin_Table, NULL))
return -1;
return 0;
}
int SLrline_init (SLFUTURE_CONST char *appname, SLFUTURE_CONST char *user_initfile, SLFUTURE_CONST char *sys_initfile)
{
#ifdef __WIN32__
char *home_dir = getenv ("USERPROFILE");
#else
# ifdef VMS
char *home_dir = "SYS$LOGIN:"******"HOME");
# endif
#endif
char *file = NULL;
int status;
static char *appname_malloced;
if (sys_initfile == NULL)
sys_initfile = SLRLINE_SYS_INIT_FILE;
if (user_initfile == NULL)
user_initfile = SLRLINE_USER_INIT_FILE;
if (appname == NULL)
appname = "Unknown";
if (NULL == (appname_malloced = SLmake_string (appname)))
return -1;
if (-1 == SLadd_intrinsic_variable ("__RL_APP__", &appname_malloced, SLANG_STRING_TYPE, 1))
return -1;
if (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))
return -1;
if (-1 == init_keymap ())
return -1;
if (user_initfile != NULL)
{
file = SLpath_find_file_in_path (home_dir, user_initfile);
if (file != NULL)
{
status = SLns_load_file (file, NULL);
SLfree (file);
return status;
}
}
if (sys_initfile != NULL)
{
file = _pSLpath_find_file (sys_initfile, 0);
if (file != NULL)
{
status = SLns_load_file (file, NULL);
SLang_free_slstring (file);
return status;
}
}
return 0;
}
int jed_init_user_hooks (void)
{
if ((-1 == SLadd_intrin_fun_table (Hooks_Intrinsics, NULL))
|| (-1 == SLadd_iconstant_table (Hook_IConstants, NULL)))
return -1;
return 0;
}
int SLang_init_import (void)
{
#if SLANG_HAS_DYNAMIC_LINKING
(void) SLang_add_cleanup_function (delete_handles);
return SLadd_intrin_fun_table (Module_Intrins, "__IMPORT__");
#else
return 0;
#endif
}
int jed_init_userinfo (void)
{
(void) get_user_info ();
if (-1 == SLadd_intrin_fun_table (User_Intrinsics, NULL))
return -1;
return 0;
}
int SLang_init_array (void)
{
if (-1 == SLadd_intrin_fun_table (Array_Fun_Table, "__SLARRAY__"))
return -1;
#if SLANG_HAS_FLOAT
_pSLang_Matrix_Multiply = do_inner_product;
#endif
return 0;
}
int slsh_init_readline_intrinsics ()
{
if (-1 == register_rline_type ())
return -1;
if (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))
return -1;
return 0;
}
int _pSLang_init_exceptions (void)
{
_pSLerr_New_Exception_Hook = new_exception_hook;
if (-1 == _pSLerr_init_interp_exceptions ())
return -1;
if (-1 == SLadd_intrin_fun_table(Except_Table, NULL))
return -1;
return 0;
}
int _pSLang_init_sltime (void)
{
if (sizeof (time_t) > sizeof(_sltime_t))
{
SLang_exit_error ("S-Lang library not built properly. Fix _sltime_t in sltime.c");
}
#ifdef HAVE_TIMES
(void) tic_cmd ();
#endif
return SLadd_intrin_fun_table (Time_Funs_Table, NULL);
}
int init_smg_module (void)
{
if ((-1 == SLadd_intrin_fun_table (Smg_Intrinsics, "__SMG__"))
|| (-1 == SLadd_intrin_var_table (Smg_Variables, NULL))
|| (-1 == SLadd_iconstant_table (Smg_Constants, NULL)))
return -1;
SLtt_get_terminfo ();
Smg_Initialized = 0;
return 0;
}
static int init_slang (void)
{
if ((-1 == SLang_init_all ())
|| (-1 == SLang_init_array_extra ())
|| (-1 == SLang_init_import ()) /* dynamic linking */
|| (-1 == SLadd_intrin_fun_table (Intrinsics, NULL)))
{
SLang_verror (0, "Unable to initialize S-Lang.\n");
return -1;
}
return 0;
}
int SLang_init_signal (void)
{
Signal_Type *s;
if ((-1 == SLadd_intrin_fun_table(Intrin_Table, NULL))
|| (-1 == SLadd_iconstant_table (IConsts, NULL)))
return -1;
s = Signal_Table;
while (s->name != NULL)
{
if (-1 == SLns_add_iconstant (NULL, s->name, SLANG_INT_TYPE, s->sig))
return -1;
s++;
}
return 0;
}
int SLang_init_posix_io (void)
{
SLang_Class_Type *cl;
if (NULL == (cl = SLclass_allocate_class ("FD_Type")))
return -1;
cl->cl_destroy = destroy_fd_type;
(void) SLclass_set_push_function (cl, fd_push);
cl->cl_datatype_deref = fdtype_datatype_deref;
if ((-1 == SLclass_register_class (cl, SLANG_FILE_FD_TYPE, sizeof (SLFile_FD_Type), SLANG_CLASS_TYPE_PTR))
|| (-1 == SLclass_add_binary_op (SLANG_FILE_FD_TYPE, SLANG_FILE_FD_TYPE, fd_fd_bin_op, fd_fd_bin_op_result)))
return -1;
if ((-1 == SLadd_intrin_fun_table(Fd_Name_Table, "__POSIXIO__"))
|| (-1 == SLadd_iconstant_table (PosixIO_Consts, NULL))
|| (-1 == _pSLerrno_init ()))
return -1;
return 0;
}
int SLang_init_slmath (void)
{
SLtype *int_types;
#if SLANG_HAS_COMPLEX
if (-1 == _pSLinit_slcomplex ())
return -1;
#endif
int_types = _pSLarith_Arith_Types;
while (*int_types != SLANG_FLOAT_TYPE)
{
if (-1 == SLclass_add_math_op (*int_types, generic_math_op, double_math_op_result))
return -1;
int_types++;
}
if ((-1 == SLclass_add_math_op (SLANG_FLOAT_TYPE, float_math_op, double_math_op_result))
|| (-1 == SLclass_add_math_op (SLANG_DOUBLE_TYPE, double_math_op, double_math_op_result))
#if SLANG_HAS_COMPLEX
|| (-1 == SLclass_add_math_op (SLANG_COMPLEX_TYPE, complex_math_op, complex_math_op_result))
#endif
)
return -1;
if ((-1 == SLadd_math_unary_table (SLmath_Table, "__SLMATH__"))
|| (-1 == SLadd_intrin_fun_table (SLang_Math_Table, NULL))
|| (-1 == SLadd_dconstant_table (DConst_Table, NULL))
|| (-1 == SLadd_iconstant_table (IConsts, NULL))
|| (-1 == add_nan_and_inf ()))
return -1;
#if defined(__unix__)
(void) SLsignal (SIGFPE, math_floating_point_exception);
#endif
return 0;
}
int main (int argc, char **argv)
{
int i;
int utf8 = 0;
for (i = 1; i < argc; i++)
{
char *arg = argv[i];
if (*arg != '-')
break;
if (0 == strcmp (arg, "-utf8"))
{
utf8 = 1;
continue;
}
i = argc;
}
if (i >= argc)
{
fprintf (stderr, "Usage: %s [-utf8] FILE...\n", argv[0]);
return 1;
}
(void) SLutf8_enable (utf8);
if ((-1 == SLang_init_all ())
|| (-1 == SLang_init_array_extra ())
|| (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))
|| (-1 == add_test_classes ()))
return 1;
SLang_Traceback = 1;
if (-1 == SLang_set_argc_argv (argc, argv))
return 1;
#ifdef HAVE_FPSETMASK
# ifndef FP_X_OFL
# define FP_X_OFL 0
# endif
# ifndef FP_X_INV
# define FP_X_INV 0
# endif
# ifndef FP_X_DZ
# define FP_X_DZ 0
# endif
# ifndef FP_X_DNML
# define FP_X_DNML 0
# endif
# ifndef FP_X_UFL
# define FP_X_UFL 0
# endif
# ifndef FP_X_IMP
# define FP_X_IMP 0
# endif
fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP));
#endif
if (i + 1 < argc)
Ignore_Exit = 1;
while (i < argc)
{
char *file = argv[i];
if (0 == strncmp (SLpath_extname (file), ".slc", 4))
{
char *file_sl = SLmake_string (file);
file_sl[strlen(file_sl)-1] = 0;
if (-1 == SLang_byte_compile_file (file_sl, 0))
{
SLfree (file_sl);
return 1;
}
SLfree (file_sl);
}
if (-1 == SLang_load_file (file))
return 1;
i++;
}
return SLang_get_error ();
}
int SLang_init_slang (void) /*{{{*/
{
char name[3];
unsigned int i;
SLFUTURE_CONST char **s;
static SLFUTURE_CONST 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 == _pSLerr_init ())
return -1;
if (-1 == _pSLregister_types ()) return -1;
if ((-1 == SLadd_intrin_fun_table(SLang_Basic_Table, NULL))
|| (-1 == SLadd_intrin_var_table (Intrin_Vars, NULL))
|| (-1 == _pSLang_init_slstrops ())
|| (-1 == _pSLang_init_sltime ())
|| (-1 == _pSLang_init_sllist ())
|| (-1 == _pSLstruct_init ())
#if SLANG_HAS_ASSOC_ARRAYS
|| (-1 == SLang_init_slassoc ())
#endif
#if SLANG_HAS_BOSEOS
|| (-1 == _pSLang_init_boseos ())
#endif
|| (-1 == _pSLang_init_exceptions ())
)
return -1;
/* More nonsense for the windoze loader */
if ((-1 == SLadd_intrinsic_variable ("_NARGS", &SLang_Num_Function_Args, SLANG_INT_TYPE, 1))
|| (-1 == SLadd_intrinsic_variable ("_traceback", &SLang_Traceback, SLANG_INT_TYPE, 0))
|| (-1 == SLadd_intrinsic_variable ("_slang_version", &SLang_Version, SLANG_INT_TYPE, 1))
|| (-1 == SLadd_intrinsic_variable ("_slang_version_string", &SLang_Version_String, SLANG_STRING_TYPE, 1))
|| (-1 == SLadd_intrinsic_variable ("_slang_doc_dir", &SLang_Doc_Dir, SLANG_STRING_TYPE, 1)))
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_HAS_SIGNALS
if (-1 == SLang_add_interrupt_hook (_pSLang_check_signals_hook, NULL))
return -1;
#endif
if ((SLang_Doc_Dir != NULL)
&& (*SLang_Doc_Dir != 0))
{
char *docfile = SLpath_dircat (SLang_Doc_Dir, "slangfun.txt");
/* NULL ok */
(void) add_doc_file (docfile);
SLfree (docfile);
}
if (_pSLang_Error)
return -1;
return 0;
}
int _pSLang_init_boseos (void)
{
return SLadd_intrin_fun_table (Intrin_Funs, NULL);
}
