tclAppInit.cc
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:8k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tclAppInit.c --
  3.  *
  4.  * Provides a default version of the main program and Tcl_AppInit
  5.  * procedure for Tcl applications (without Tk).
  6.  *
  7.  * Copyright (C) 2000 USC/ISI
  8.  * Copyright (c) 1993 The Regents of the University of California.
  9.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tclAppInit.c 1.17 96/03/26 12:45:29
  15.  */
  16. #include "config.h"
  17. extern void init_misc(void);
  18. extern EmbeddedTcl et_ns_lib;
  19. extern EmbeddedTcl et_ns_ptypes;
  20. /* MSVC requires this global var declaration to be outside of 'extern "C"' */
  21. #ifdef MEMDEBUG_SIMULATIONS
  22. #include "mem-trace.h"
  23. MemTrace *globalMemTrace;
  24. #endif
  25. #define NS_BEGIN_EXTERN_C extern "C" {
  26. #define NS_END_EXTERN_C }
  27. NS_BEGIN_EXTERN_C
  28. #ifdef HAVE_FENV_H
  29. #include <fenv.h>
  30. #endif /* HAVE_FENV_H */
  31. /*
  32.  * The following variable is a special hack that is needed in order for
  33.  * Sun shared libraries to be used for Tcl.
  34.  */
  35. #ifdef TCL_TEST
  36. EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  37. #endif /* TCL_TEST */
  38. /*
  39.  *----------------------------------------------------------------------
  40.  *
  41.  * main --
  42.  *
  43.  * This is the main program for the application.
  44.  *
  45.  * Results:
  46.  * None: Tcl_Main never returns here, so this procedure never
  47.  * returns either.
  48.  *
  49.  * Side effects:
  50.  * Whatever the application does.
  51.  *
  52.  *----------------------------------------------------------------------
  53.  */
  54. extern "C" int
  55. nslibmain(int argc, char **argv)
  56. {
  57.     Tcl_Main(argc, argv, Tcl_AppInit);
  58.     return 0; /* Needed only to prevent compiler warning. */
  59. }
  60. #if defined(__i386__) && defined(__GNUC__)
  61. #define HAVE_NS_SETUP_FPU /* convenience flag to check on later */
  62. /* This function is supposed to set up a uniform FPU state on all i386
  63.  * platforms.  It may (should) be called instead of functions in the
  64.  * fe- family.
  65.  */
  66. static void ns_setup_fpu() {
  67. static const int NS_FPU_CW_IC  = 0x1000; /* Infty control(12): support +/- infinity */
  68. static const int NS_FPU_CW_RC  = 0x0000; /* Round control(11,10): to nearest */
  69. static const int NS_FPU_CW_PC  = 0x0200; /* Precision control(9,8): 53 bits */
  70. static const int NS_FPU_CW_IEM = 0x0000; /* Interrupt enable mask(7): enabled */
  71. static const int NS_FPU_CW_B6  = 0x0040; /* undefined, set to one in my FPU */
  72. static const int NS_FPU_CW_PM  = 0x0020; /* Precision mask(5), inexact exception: disabled */
  73. static const int NS_FPU_CW_UM  = 0x0010; /* Underflow mask(4): disabled */
  74. static const int NS_FPU_CW_OM  = 0x0000; /* Overflow mask(3): enabled */
  75. static const int NS_FPU_CW_ZM  = 0x0000; /* Zero divide mask(2): enabled */
  76. static const int NS_FPU_CW_DM  = 0x0002; /* Denormalized operand(1): disabled */
  77. static const int NS_FPU_CW_IM  = 0x0000; /* Invalid operation mask(0): enabled */
  78. static const int NS_FPU_CW    = NS_FPU_CW_IC
  79. | NS_FPU_CW_RC
  80. | NS_FPU_CW_PC  
  81. | NS_FPU_CW_IEM 
  82. | NS_FPU_CW_B6  
  83. | NS_FPU_CW_PM  
  84. | NS_FPU_CW_UM  
  85. | NS_FPU_CW_OM  
  86. | NS_FPU_CW_ZM
  87. | NS_FPU_CW_DM  
  88. | NS_FPU_CW_IM;
  89. unsigned short _cw = NS_FPU_CW;
  90. asm ("fldcw %0" : : "m" (*&_cw));
  91. }
  92. #endif /* !HAVE_NS_SETUP_FPU && __i386__ && __GNUC__ */
  93. #if !defined(HAVE_FESETPRECISION) && defined(__i386__) && defined(__GNUC__)
  94. // use our own!
  95. #define HAVE_FESETPRECISION
  96. /*
  97.  * From:
  98.  |  Floating-point environment <fenvwm.h>                                    |
  99.  | Copyright (C) 1996, 1997, 1998, 1999                                      |
  100.  |                     W. Metzenthen, 22 Parker St, Ormond, Vic 3163,        |
  101.  |                     Australia.                                            |
  102.  |                     E-mail   billm@melbpc.org.au                          |
  103.  * used here with permission.
  104.  */
  105. #define FE_FLTPREC       0x000
  106. #define FE_INVALIDPREC   0x100
  107. #define FE_DBLPREC       0x200
  108. #define FE_LDBLPREC      0x300
  109. /*
  110.  * From:
  111.  * fenvwm.c
  112.  | Copyright (C) 1999                                                        |
  113.  |                     W. Metzenthen, 22 Parker St, Ormond, Vic 3163,        |
  114.  |                     Australia.  E-mail   billm@melbpc.org.au              |
  115.  * used here with permission.
  116.  */
  117. /*
  118.   Set the precision to prec if it is a valid
  119.   floating point precision macro.
  120.   Returns 1 if precision set, 0 otherwise.
  121.   */
  122. static inline int fesetprecision(int prec)
  123. {
  124.   if ( !(prec & ~FE_LDBLPREC) && (prec != FE_INVALIDPREC) )
  125.     {
  126.       unsigned short cw;
  127.       asm ("fnstcw %0":"=m" (*&cw));
  128.       asm ("fwait");
  129.       cw = (cw & ~FE_LDBLPREC) | (prec & FE_LDBLPREC);
  130.       asm volatile ("fldcw %0" : /* Don't push these colons together */ : "m" (*&cw));
  131.       return 1;
  132.     }
  133.   else
  134.     return 0;
  135. }
  136. #endif /* !HAVE_FESETPRECISION && __i386__ && __GNUC__ */
  137. /*
  138.  * setup_floating_point_environment
  139.  *
  140.  * Set up the floating point environment to be as standard as possible.
  141.  *
  142.  * For example:
  143.  * Linux i386 uses 60-bit floats for calculation,
  144.  * not 56-bit floats, giving different results.
  145.  * Fix that.
  146.  *
  147.  * See <http://www.linuxsupportline.com/~billm/faq.html>
  148.  * for why we do this fix.
  149.  *
  150.  * This function is derived from wmexcep
  151.  *
  152.  */
  153. static inline void
  154. setup_floating_point_environment()
  155. {
  156. #ifdef HAVE_NS_SETUP_FPU
  157. ns_setup_fpu();
  158. #else /* !HAVE_NS_SETUP_FPU */
  159. // In general, try to use the C99 standards to set things up.
  160. // If we can't do that, do nothing and hope the default is right.
  161. #ifdef HAVE_FESETPRECISION
  162. fesetprecision(FE_DBLPREC);
  163. #endif
  164. #ifdef HAVE_FEENABLEEXCEPT
  165. /*
  166.  * In general we'd like to catch some serious exceptions (div by zero)
  167.  * and ignore the boring ones (overflow/underflow).
  168.  * We set up that up here.
  169.  * This depends on feenableexcept which is (currently) GNU
  170.  * specific.
  171.  */
  172. int trap_exceptions = 0;
  173. #ifdef FE_DIVBYZERO
  174. trap_exceptions |= FE_DIVBYZERO;
  175. #endif
  176. #ifdef FE_INVALID
  177. trap_exceptions |= FE_INVALID;
  178. #endif
  179. #ifdef FE_OVERFLOW
  180. trap_exceptions |= FE_OVERFLOW;
  181. #endif
  182. //#ifdef FE_UNDERFLOW
  183. // trap_exceptions |= FE_UNDERFLOW;
  184. //#endif
  185. feenableexcept(trap_exceptions);
  186. #endif /* HAVE_FEENABLEEXCEPT */
  187. #endif /* !HAVE_NS_SETUP_FPU */
  188. }
  189. /*
  190.  *----------------------------------------------------------------------
  191.  *
  192.  * Tcl_AppInit --
  193.  *
  194.  * This procedure performs application-specific initialization.
  195.  * Most applications, especially those that incorporate additional
  196.  * packages, will have their own version of this procedure.
  197.  *
  198.  * Results:
  199.  * Returns a standard Tcl completion code, and leaves an error
  200.  * message in interp->result if an error occurs.
  201.  *
  202.  * Side effects:
  203.  * Depends on the startup script.
  204.  *
  205.  *----------------------------------------------------------------------
  206.  */
  207. int
  208. Tcl_AppInit(Tcl_Interp *interp)
  209. {
  210. #ifdef MEMDEBUG_SIMULATIONS
  211.         extern MemTrace *globalMemTrace;
  212.         globalMemTrace = new MemTrace;
  213. #endif
  214. setup_floating_point_environment();
  215.        
  216. if (Tcl_Init(interp) == TCL_ERROR ||
  217.     Otcl_Init(interp) == TCL_ERROR)
  218. return TCL_ERROR;
  219. #ifdef HAVE_LIBTCLDBG
  220. extern int Tcldbg_Init(Tcl_Interp *);   // hackorama
  221. if (Tcldbg_Init(interp) == TCL_ERROR) {
  222. return TCL_ERROR;
  223. }
  224. #endif
  225. Tcl_SetVar(interp, "tcl_rcFileName", "~/.ns.tcl", TCL_GLOBAL_ONLY);
  226. Tcl::init(interp, "ns");
  227. init_misc();
  228.         et_ns_ptypes.load();
  229. et_ns_lib.load();
  230. #ifdef TCL_TEST
  231. if (Tcltest_Init(interp) == TCL_ERROR) {
  232. return TCL_ERROR;
  233. }
  234. Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
  235.   (Tcl_PackageInitProc *) NULL);
  236. #endif /* TCL_TEST */
  237. return TCL_OK;
  238. }
  239. #ifndef WIN32
  240. void
  241. abort()
  242. {
  243. Tcl& tcl = Tcl::instance();
  244. tcl.evalc("[Simulator instance] flush-trace");
  245. #ifdef abort
  246. #undef abort
  247. abort();
  248. #else
  249. exit(1);
  250. #endif /*abort*/
  251. /*NOTREACHED*/
  252. }
  253. #endif
  254. NS_END_EXTERN_C