/* * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit * procedure for Tcl applications (without Tk). * * Copyright (C) 2000 USC/ISI * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * SCCS: @(#) tclAppInit.c 1.17 96/03/26 12:45:29 */ #include "config.h" extern void init_misc(void); extern EmbeddedTcl et_ns_lib; extern EmbeddedTcl et_ns_ptypes; /* MSVC requires this global var declaration to be outside of 'extern "C"' */ #ifdef MEMDEBUG_SIMULATIONS #include "mem-trace.h" MemTrace *globalMemTrace; #endif #define NS_BEGIN_EXTERN_C extern "C" { #define NS_END_EXTERN_C } NS_BEGIN_EXTERN_C #ifdef HAVE_FENV_H #include #endif /* HAVE_FENV_H */ /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef TCL_TEST EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TCL_TEST */ /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. * * Results: * None: Tcl_Main never returns here, so this procedure never * returns either. * * Side effects: * Whatever the application does. * *---------------------------------------------------------------------- */ int main(int argc, char **argv) { Tcl_Main(argc, argv, Tcl_AppInit); return 0; /* Needed only to prevent compiler warning. */ } #if defined(__i386__) && defined(__GNUC__) #define HAVE_NS_SETUP_FPU /* convenience flag to check on later */ /* This function is supposed to set up a uniform FPU state on all i386 * platforms. It may (should) be called instead of functions in the * fe- family. */ static void ns_setup_fpu() { static const int NS_FPU_CW_IC = 0x1000; /* Infty control(12): support +/- infinity */ static const int NS_FPU_CW_RC = 0x0000; /* Round control(11,10): to nearest */ static const int NS_FPU_CW_PC = 0x0200; /* Precision control(9,8): 53 bits */ static const int NS_FPU_CW_IEM = 0x0000; /* Interrupt enable mask(7): enabled */ static const int NS_FPU_CW_B6 = 0x0040; /* undefined, set to one in my FPU */ static const int NS_FPU_CW_PM = 0x0020; /* Precision mask(5), inexact exception: disabled */ static const int NS_FPU_CW_UM = 0x0010; /* Underflow mask(4): disabled */ static const int NS_FPU_CW_OM = 0x0000; /* Overflow mask(3): enabled */ static const int NS_FPU_CW_ZM = 0x0000; /* Zero divide mask(2): enabled */ static const int NS_FPU_CW_DM = 0x0002; /* Denormalized operand(1): disabled */ static const int NS_FPU_CW_IM = 0x0000; /* Invalid operation mask(0): enabled */ static const int NS_FPU_CW = NS_FPU_CW_IC | NS_FPU_CW_RC | NS_FPU_CW_PC | NS_FPU_CW_IEM | NS_FPU_CW_B6 | NS_FPU_CW_PM | NS_FPU_CW_UM | NS_FPU_CW_OM | NS_FPU_CW_ZM | NS_FPU_CW_DM | NS_FPU_CW_IM; unsigned short _cw = NS_FPU_CW; asm ("fldcw %0" : : "m" (*&_cw)); } #endif /* !HAVE_NS_SETUP_FPU && __i386__ && __GNUC__ */ #if !defined(HAVE_FESETPRECISION) && defined(__i386__) && defined(__GNUC__) // use our own! #define HAVE_FESETPRECISION /* * From: | Floating-point environment | | Copyright (C) 1996, 1997, 1998, 1999 | | W. Metzenthen, 22 Parker St, Ormond, Vic 3163, | | Australia. | | E-mail billm@melbpc.org.au | * used here with permission. */ #define FE_FLTPREC 0x000 #define FE_INVALIDPREC 0x100 #define FE_DBLPREC 0x200 #define FE_LDBLPREC 0x300 /* * From: * fenvwm.c | Copyright (C) 1999 | | W. Metzenthen, 22 Parker St, Ormond, Vic 3163, | | Australia. E-mail billm@melbpc.org.au | * used here with permission. */ /* Set the precision to prec if it is a valid floating point precision macro. Returns 1 if precision set, 0 otherwise. */ static inline int fesetprecision(int prec) { if ( !(prec & ~FE_LDBLPREC) && (prec != FE_INVALIDPREC) ) { unsigned short cw; asm ("fnstcw %0":"=m" (*&cw)); asm ("fwait"); cw = (cw & ~FE_LDBLPREC) | (prec & FE_LDBLPREC); asm volatile ("fldcw %0" : /* Don't push these colons together */ : "m" (*&cw)); return 1; } else return 0; } #endif /* !HAVE_FESETPRECISION && __i386__ && __GNUC__ */ /* * setup_floating_point_environment * * Set up the floating point environment to be as standard as possible. * * For example: * Linux i386 uses 60-bit floats for calculation, * not 56-bit floats, giving different results. * Fix that. * * See * for why we do this fix. * * This function is derived from wmexcep * */ static inline void setup_floating_point_environment() { #ifdef HAVE_NS_SETUP_FPU ns_setup_fpu(); #else /* !HAVE_NS_SETUP_FPU */ // In general, try to use the C99 standards to set things up. // If we can't do that, do nothing and hope the default is right. #ifdef HAVE_FESETPRECISION fesetprecision(FE_DBLPREC); #endif #ifdef HAVE_FEENABLEEXCEPT /* * In general we'd like to catch some serious exceptions (div by zero) * and ignore the boring ones (overflow/underflow). * We set up that up here. * This depends on feenableexcept which is (currently) GNU * specific. */ int trap_exceptions = 0; #ifdef FE_DIVBYZERO trap_exceptions |= FE_DIVBYZERO; #endif #ifdef FE_INVALID trap_exceptions |= FE_INVALID; #endif #ifdef FE_OVERFLOW trap_exceptions |= FE_OVERFLOW; #endif //#ifdef FE_UNDERFLOW // trap_exceptions |= FE_UNDERFLOW; //#endif feenableexcept(trap_exceptions); #endif /* HAVE_FEENABLEEXCEPT */ #endif /* !HAVE_NS_SETUP_FPU */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. * Most applications, especially those that incorporate additional * packages, will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in interp->result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit(Tcl_Interp *interp) { #ifdef MEMDEBUG_SIMULATIONS extern MemTrace *globalMemTrace; globalMemTrace = new MemTrace; #endif setup_floating_point_environment(); if (Tcl_Init(interp) == TCL_ERROR || Otcl_Init(interp) == TCL_ERROR) return TCL_ERROR; #ifdef HAVE_LIBTCLDBG extern int Tcldbg_Init(Tcl_Interp *); // hackorama if (Tcldbg_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #endif Tcl_SetVar(interp, "tcl_rcFileName", "~/.ns.tcl", TCL_GLOBAL_ONLY); Tcl::init(interp, "ns"); init_misc(); et_ns_ptypes.load(); et_ns_lib.load(); #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, (Tcl_PackageInitProc *) NULL); #endif /* TCL_TEST */ return TCL_OK; } #ifndef WIN32 void abort() { Tcl& tcl = Tcl::instance(); tcl.evalc("[Simulator instance] flush-trace"); #ifdef abort #undef abort abort(); #else exit(1); #endif /*abort*/ /*NOTREACHED*/ } #endif NS_END_EXTERN_C