src/clipsrules/core/sysdep.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*             CLIPS Version 6.24  05/17/06            */
00005    /*                                                     */
00006    /*               SYSTEM DEPENDENT MODULE               */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose: Isolation of system dependent routines.          */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Gary D. Riley                                        */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*      Brian L. Dantes                                      */
00017 /*                                                           */
00018 /* Revision History:                                         */
00019 /*      6.23: Modified GenOpen to check the file length      */
00020 /*            against the system constant FILENAME_MAX.      */
00021 /*                                                           */
00022 /*      6.24: Support for run-time programs directly passing */
00023 /*            the hash tables for initialization.            */
00024 /*                                                           */
00025 /*            Made gensystem functional for Xcode.           */ 
00026 /*                                                           */
00027 /*            Added BeforeOpenFunction and AfterOpenFunction */
00028 /*            hooks.                                         */
00029 /*                                                           */
00030 /*            Added environment parameter to GenClose.       */
00031 /*            Added environment parameter to GenOpen.        */
00032 /*                                                           */
00033 /*            Updated UNIX_V gentime functionality.          */
00034 /*                                                           */
00035 /*            Removed GenOpen check against FILENAME_MAX.    */
00036 /*                                                           */
00037 /*************************************************************/
00038 
00039 #define _SYSDEP_SOURCE_
00040 
00041 #include "setup.h"
00042 
00043 #include <stdio.h>
00044 #define _STDIO_INCLUDED_
00045 #include <string.h>
00046 
00047 #include <stdlib.h>
00048 #include <time.h>
00049 #include <stdarg.h>
00050 
00051 #if   VAX_VMS
00052 #include timeb
00053 #include <descrip.h>
00054 #include <ssdef.h>
00055 #include <stsdef.h>
00056 #include signal
00057 extern int LIB$SPAWN();
00058 #endif
00059 
00060 #if MAC_MCW || MAC_XCD
00061 #include <Carbon/Carbon.h> 
00062 #define kTwoPower32 (4294967296.0)      /* 2^32 */
00063 #endif
00064 
00065 #if MAC_MCW || MAC_XCD
00066 #include <strings.h>
00067 #endif
00068 
00069 #if MAC_MCW || WIN_MCW || MAC_XCD 
00070 #include <unistd.h>
00071 #endif
00072 
00073 #if WIN_MVC || WIN_BTC
00074 #define _UNICODE
00075 #define UNICODE 
00076 #include <Windows.h>
00077 #endif
00078 
00079 #if WIN_MVC
00080 #include <sys\types.h>
00081 #include <sys\timeb.h>
00082 #include <io.h>
00083 #include <fcntl.h>
00084 #include <limits.h>
00085 #include <process.h>
00086 #include <signal.h>
00087 #endif
00088 
00089 #if WIN_BTC
00090 #include <io.h>
00091 #include <fcntl.h>
00092 #include <limits.h>
00093 #include <signal.h>
00094 #endif
00095 
00096 #if WIN_MCW
00097 #include <io.h>
00098 #include <limits.h>
00099 #endif
00100 
00101 #if   UNIX_7 || WIN_GCC
00102 #include <sys/types.h>
00103 #include <sys/timeb.h>
00104 #include <signal.h>
00105 #endif
00106 
00107 #if   UNIX_V || LINUX || DARWIN
00108 #include <sys/types.h>
00109 #include <sys/time.h>
00110 #include <sys/times.h>
00111 #include <unistd.h>
00112 #include <signal.h>
00113 #endif
00114 
00115 #include "argacces.h"
00116 #include "bmathfun.h"
00117 #include "commline.h"
00118 #include "conscomp.h"
00119 #include "constrnt.h"
00120 #include "constrct.h"
00121 #include "cstrcpsr.h"
00122 #include "emathfun.h"
00123 #include "envrnmnt.h"
00124 #include "filecom.h"
00125 #include "iofun.h"
00126 #include "memalloc.h"
00127 #include "miscfun.h"
00128 #include "multifld.h"
00129 #include "multifun.h"
00130 #include "parsefun.h"
00131 #include "prccode.h"
00132 #include "prdctfun.h"
00133 #include "proflfun.h"
00134 #include "prcdrfun.h"
00135 #include "router.h"
00136 #include "sortfun.h"
00137 #include "strngfun.h"
00138 #include "textpro.h"
00139 #include "utility.h"
00140 #include "watch.h"
00141 
00142 #include "sysdep.h"
00143 
00144 #if DEFFACTS_CONSTRUCT
00145 #include "dffctdef.h"
00146 #endif
00147 
00148 #if DEFRULE_CONSTRUCT
00149 #include "ruledef.h"
00150 #endif
00151 
00152 #if DEFGENERIC_CONSTRUCT
00153 #include "genrccom.h"
00154 #endif
00155 
00156 #if DEFFUNCTION_CONSTRUCT
00157 #include "dffnxfun.h"
00158 #endif
00159 
00160 #if DEFGLOBAL_CONSTRUCT
00161 #include "globldef.h"
00162 #endif
00163 
00164 #if DEFTEMPLATE_CONSTRUCT
00165 #include "tmpltdef.h"
00166 #endif
00167 
00168 #if OBJECT_SYSTEM
00169 #include "classini.h"
00170 #endif
00171 
00172 #include "moduldef.h"
00173 
00174 #if EMACS_EDITOR
00175 #include "ed.h"
00176 #endif
00177 
00178 #if DEVELOPER
00179 #include "developr.h"
00180 #endif
00181 
00182 /***************/
00183 /* DEFINITIONS */
00184 /***************/
00185 
00186 #define NO_SWITCH         0
00187 #define BATCH_SWITCH      1
00188 #define BATCH_STAR_SWITCH 2
00189 #define LOAD_SWITCH       3
00190 
00191 /********************/
00192 /* ENVIRONMENT DATA */
00193 /********************/
00194 
00195 #define SYSTEM_DEPENDENT_DATA 58
00196 
00197 struct systemDependentData
00198   { 
00199    void (*RedrawScreenFunction)(void *);
00200    void (*PauseEnvFunction)(void *);
00201    void (*ContinueEnvFunction)(void *,int);
00202 /*
00203 #if ! WINDOW_INTERFACE
00204 #if WIN_BTC
00205    void interrupt (*OldCtrlC)(void);
00206    void interrupt (*OldBreak)(void);
00207 #endif
00208 #if WIN_MVC
00209    void (interrupt *OldCtrlC)(void);
00210    void (interrupt *OldBreak)(void);
00211 #endif
00212 #endif
00213 */
00214 #if WIN_BTC || WIN_MVC
00215    int BinaryFileHandle;
00216    unsigned char getcBuffer[7];
00217    int getcLength;
00218    int getcPosition;
00219 #endif
00220 #if (! WIN_BTC) && (! WIN_MVC)
00221    FILE *BinaryFP;
00222 #endif
00223    int (*BeforeOpenFunction)(void *);
00224    int (*AfterOpenFunction)(void *);
00225    jmp_buf *jmpBuffer;
00226   };
00227 
00228 #define SystemDependentData(theEnv) ((struct systemDependentData *) GetEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA))
00229 
00230 /****************************************/
00231 /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */
00232 /****************************************/
00233 
00234    extern void                    UserFunctions(void);
00235    extern void                    EnvUserFunctions(void *);
00236 
00237 /***************************************/
00238 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
00239 /***************************************/
00240 
00241    static void                    InitializeSystemDependentData(void *);
00242    static void                    SystemFunctionDefinitions(void *);
00243    static void                    InitializeKeywords(void *);
00244    static void                    InitializeNonportableFeatures(void *);
00245 #if   (VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_BTC || WIN_MVC) && (! WINDOW_INTERFACE)
00246    static void                    CatchCtrlC(int);
00247 #endif
00248 /*
00249 #if   (WIN_MVC) && (! WINDOW_INTERFACE)
00250    static void interrupt          CatchCtrlC(void);
00251    static void                    RestoreInterruptVectors(void);
00252 #endif
00253 */
00254 
00255 /********************************************************/
00256 /* InitializeSystemDependentData: Allocates environment */
00257 /*    data for system dependent routines.               */
00258 /********************************************************/
00259 static void InitializeSystemDependentData(
00260   void *theEnv)
00261   {
00262    AllocateEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA,sizeof(struct systemDependentData),NULL);
00263   }
00264 
00265 /**************************************************/
00266 /* InitializeEnvironment: Performs initialization */
00267 /*   of the KB environment.                       */
00268 /**************************************************/
00269 #if ALLOW_ENVIRONMENT_GLOBALS
00270 globle void InitializeEnvironment()
00271    {
00272     if (GetCurrentEnvironment() == NULL)
00273       { CreateEnvironment(); }
00274    }
00275 #endif
00276 
00277 /*****************************************************/
00278 /* EnvInitializeEnvironment: Performs initialization */
00279 /*   of the KB environment.                          */
00280 /*****************************************************/
00281 globle void EnvInitializeEnvironment(
00282   void *vtheEnvironment,
00283   struct symbolHashNode **symbolTable,
00284   struct floatHashNode **floatTable,
00285   struct integerHashNode **integerTable,
00286   struct bitMapHashNode **bitmapTable,
00287   struct externalAddressHashNode **externalAddressTable)
00288   {
00289    struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment;
00290    
00291    /*================================================*/
00292    /* Don't allow the initialization to occur twice. */
00293    /*================================================*/
00294 
00295    if (theEnvironment->initialized) return;
00296      
00297    /*================================*/
00298    /* Initialize the memory manager. */
00299    /*================================*/
00300 
00301    InitializeMemory(theEnvironment);
00302 
00303    /*===================================================*/
00304    /* Initialize environment data for various features. */
00305    /*===================================================*/
00306    
00307    InitializeCommandLineData(theEnvironment);
00308 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00309    InitializeConstructCompilerData(theEnvironment);
00310 #endif
00311    InitializeConstructData(theEnvironment);
00312    InitializeEvaluationData(theEnvironment);
00313    InitializeExternalFunctionData(theEnvironment);
00314    InitializeMultifieldData(theEnvironment);
00315    InitializePrettyPrintData(theEnvironment);
00316    InitializePrintUtilityData(theEnvironment);
00317    InitializeScannerData(theEnvironment);
00318    InitializeSystemDependentData(theEnvironment);
00319    InitializeUserDataData(theEnvironment);
00320    InitializeUtilityData(theEnvironment);
00321 #if DEBUGGING_FUNCTIONS
00322    InitializeWatchData(theEnvironment);
00323 #endif
00324    
00325    /*===============================================*/
00326    /* Initialize the hash tables for atomic values. */
00327    /*===============================================*/
00328 
00329    InitializeAtomTables(theEnvironment,symbolTable,floatTable,integerTable,bitmapTable,externalAddressTable);
00330 
00331    /*=========================================*/
00332    /* Initialize file and string I/O routers. */
00333    /*=========================================*/
00334 
00335    InitializeDefaultRouters(theEnvironment);
00336 
00337    /*=========================================================*/
00338    /* Initialize some system dependent features such as time. */
00339    /*=========================================================*/
00340 
00341    InitializeNonportableFeatures(theEnvironment);
00342 
00343    /*=============================================*/
00344    /* Register system and user defined functions. */
00345    /*=============================================*/
00346 
00347    SystemFunctionDefinitions(theEnvironment);
00348    UserFunctions();
00349    EnvUserFunctions(theEnvironment);
00350 
00351    /*====================================*/
00352    /* Initialize the constraint manager. */
00353    /*====================================*/
00354 
00355    InitializeConstraints(theEnvironment);
00356 
00357    /*==========================================*/
00358    /* Initialize the expression hash table and */
00359    /* pointers to specific functions.          */
00360    /*==========================================*/
00361 
00362    InitExpressionData(theEnvironment);
00363 
00364    /*===================================*/
00365    /* Initialize the construct manager. */
00366    /*===================================*/
00367 
00368 #if ! RUN_TIME
00369    InitializeConstructs(theEnvironment);
00370 #endif
00371 
00372    /*=====================================*/
00373    /* Initialize the defmodule construct. */
00374    /*=====================================*/
00375 
00376    AllocateDefmoduleGlobals(theEnvironment);
00377 
00378    /*===================================*/
00379    /* Initialize the defrule construct. */
00380    /*===================================*/
00381 
00382 #if DEFRULE_CONSTRUCT
00383    InitializeDefrules(theEnvironment);
00384 #endif
00385 
00386    /*====================================*/
00387    /* Initialize the deffacts construct. */
00388    /*====================================*/
00389 
00390 #if DEFFACTS_CONSTRUCT
00391    InitializeDeffacts(theEnvironment);
00392 #endif
00393 
00394    /*=====================================================*/
00395    /* Initialize the defgeneric and defmethod constructs. */
00396    /*=====================================================*/
00397 
00398 #if DEFGENERIC_CONSTRUCT
00399    SetupGenericFunctions(theEnvironment);
00400 #endif
00401 
00402    /*=======================================*/
00403    /* Initialize the deffunction construct. */
00404    /*=======================================*/
00405 
00406 #if DEFFUNCTION_CONSTRUCT
00407    SetupDeffunctions(theEnvironment);
00408 #endif
00409 
00410    /*=====================================*/
00411    /* Initialize the defglobal construct. */
00412    /*=====================================*/
00413 
00414 #if DEFGLOBAL_CONSTRUCT
00415    InitializeDefglobals(theEnvironment);
00416 #endif
00417 
00418    /*=======================================*/
00419    /* Initialize the deftemplate construct. */
00420    /*=======================================*/
00421 
00422 #if DEFTEMPLATE_CONSTRUCT
00423    InitializeDeftemplates(theEnvironment);
00424 #endif
00425 
00426    /*=============================*/
00427    /* Initialize COOL constructs. */
00428    /*=============================*/
00429 
00430 #if OBJECT_SYSTEM
00431    SetupObjectSystem(theEnvironment);
00432 #endif
00433 
00434    /*=====================================*/
00435    /* Initialize the defmodule construct. */
00436    /*=====================================*/
00437 
00438    InitializeDefmodules(theEnvironment);
00439 
00440    /*======================================================*/
00441    /* Register commands and functions for development use. */
00442    /*======================================================*/
00443 
00444 #if DEVELOPER
00445    DeveloperCommands(theEnvironment);
00446 #endif
00447 
00448    /*=========================================*/
00449    /* Install the special function primitives */
00450    /* used by procedural code in constructs.  */
00451    /*=========================================*/
00452 
00453    InstallProcedurePrimitives(theEnvironment);
00454 
00455    /*==============================================*/
00456    /* Install keywords in the symbol table so that */
00457    /* they are available for command completion.   */
00458    /*==============================================*/
00459 
00460    InitializeKeywords(theEnvironment);
00461 
00462    /*========================*/
00463    /* Issue a clear command. */
00464    /*========================*/
00465    
00466    EnvClear(theEnvironment);
00467 
00468    /*=============================*/
00469    /* Initialization is complete. */
00470    /*=============================*/
00471 
00472    theEnvironment->initialized = TRUE;
00473   }
00474 
00475 /******************************************************/
00476 /* SetRedrawFunction: Sets the redraw screen function */
00477 /*   for use with a user interface that may be        */
00478 /*   overwritten by execution of a command.           */
00479 /******************************************************/
00480 globle void SetRedrawFunction(
00481   void *theEnv,
00482   void (*theFunction)(void *))
00483   {
00484    SystemDependentData(theEnv)->RedrawScreenFunction = theFunction;
00485   }
00486 
00487 /******************************************************/
00488 /* SetPauseEnvFunction: Set the normal state function */
00489 /*   which puts terminal in a normal state.           */
00490 /******************************************************/
00491 globle void SetPauseEnvFunction(
00492   void *theEnv,
00493   void (*theFunction)(void *))
00494   {
00495    SystemDependentData(theEnv)->PauseEnvFunction = theFunction;
00496   }
00497 
00498 /*********************************************************/
00499 /* SetContinueEnvFunction: Sets the continue environment */
00500 /*   function which returns the terminal to a special    */
00501 /*   screen interface state.                             */
00502 /*********************************************************/
00503 globle void SetContinueEnvFunction(
00504   void *theEnv,
00505   void (*theFunction)(void *,int))
00506   {
00507    SystemDependentData(theEnv)->ContinueEnvFunction = theFunction;
00508   }
00509 
00510 /*******************************************************/
00511 /* GetRedrawFunction: Gets the redraw screen function. */
00512 /*******************************************************/
00513 globle void (*GetRedrawFunction(void *theEnv))(void *)
00514   {
00515    return SystemDependentData(theEnv)->RedrawScreenFunction;
00516   }
00517 
00518 /*****************************************************/
00519 /* GetPauseEnvFunction: Gets the normal state function. */
00520 /*****************************************************/
00521 globle void (*GetPauseEnvFunction(void *theEnv))(void *)
00522   {
00523    return SystemDependentData(theEnv)->PauseEnvFunction;
00524   }
00525 
00526 /*********************************************/
00527 /* GetContinueEnvFunction: Gets the continue */
00528 /*   environment function.                   */
00529 /*********************************************/
00530 globle void (*GetContinueEnvFunction(void *theEnv))(void *,int)
00531   {
00532    return SystemDependentData(theEnv)->ContinueEnvFunction;
00533   }
00534 
00535 /*************************************************/
00536 /* RerouteStdin: Processes the -f, -f2, and -l   */
00537 /*   options available on machines which support */
00538 /*   argc and arv command line options.          */
00539 /*************************************************/
00540 globle void RerouteStdin(
00541   void *theEnv,
00542   int argc,
00543   char *argv[])
00544   {
00545    int i;
00546    int theSwitch = NO_SWITCH;
00547 
00548    /*======================================*/
00549    /* If there aren't enough arguments for */
00550    /* the -f argument, then return.        */
00551    /*======================================*/
00552 
00553    if (argc < 3)
00554      { return; }
00555 
00556    /*=====================================*/
00557    /* If argv was not passed then return. */
00558    /*=====================================*/
00559 
00560    if (argv == NULL) return;
00561 
00562    /*=============================================*/
00563    /* Process each of the command line arguments. */
00564    /*=============================================*/
00565 
00566    for (i = 1 ; i < argc ; i++)
00567      {
00568       if (strcmp(argv[i],"-f") == 0) theSwitch = BATCH_SWITCH;
00569 #if ! RUN_TIME
00570       else if (strcmp(argv[i],"-f2") == 0) theSwitch = BATCH_STAR_SWITCH;
00571       else if (strcmp(argv[i],"-l") == 0) theSwitch = LOAD_SWITCH;
00572 #endif
00573       else if (theSwitch == NO_SWITCH)
00574         {
00575          PrintErrorID(theEnv,"SYSDEP",2,FALSE);
00576          EnvPrintRouter(theEnv,WERROR,"Invalid option\n");
00577         }
00578 
00579       if (i > (argc-1))
00580         {
00581          PrintErrorID(theEnv,"SYSDEP",1,FALSE);
00582          EnvPrintRouter(theEnv,WERROR,"No file found for ");
00583 
00584          switch(theSwitch)
00585            {
00586             case BATCH_SWITCH:
00587                EnvPrintRouter(theEnv,WERROR,"-f");
00588                break;
00589 
00590             case BATCH_STAR_SWITCH:
00591                EnvPrintRouter(theEnv,WERROR,"-f2");
00592                break;
00593 
00594             case LOAD_SWITCH:
00595                EnvPrintRouter(theEnv,WERROR,"-l");
00596            }
00597 
00598          EnvPrintRouter(theEnv,WERROR," option\n");
00599          return;
00600         }
00601 
00602       switch(theSwitch)
00603         {
00604          case BATCH_SWITCH:
00605             OpenBatch(theEnv,argv[++i],TRUE);
00606             break;
00607 
00608 #if (! RUN_TIME) && (! BLOAD_ONLY)
00609          case BATCH_STAR_SWITCH:
00610             EnvBatchStar(theEnv,argv[++i]);
00611             break;
00612 
00613          case LOAD_SWITCH:
00614             EnvLoad(theEnv,argv[++i]);
00615             break;
00616 #endif
00617         }
00618      }
00619   }
00620 
00621 /**************************************************/
00622 /* SystemFunctionDefinitions: Sets up definitions */
00623 /*   of system defined functions.                 */
00624 /**************************************************/
00625 static void SystemFunctionDefinitions(
00626   void *theEnv)
00627   {
00628    ProceduralFunctionDefinitions(theEnv);
00629    MiscFunctionDefinitions(theEnv);
00630 
00631 #if IO_FUNCTIONS
00632    IOFunctionDefinitions(theEnv);
00633 #endif
00634 
00635    PredicateFunctionDefinitions(theEnv);
00636    BasicMathFunctionDefinitions(theEnv);
00637    FileCommandDefinitions(theEnv);
00638    SortFunctionDefinitions(theEnv);
00639 
00640 #if DEBUGGING_FUNCTIONS
00641    WatchFunctionDefinitions(theEnv);
00642 #endif
00643 
00644 #if MULTIFIELD_FUNCTIONS
00645    MultifieldFunctionDefinitions(theEnv);
00646 #endif
00647 
00648 #if STRING_FUNCTIONS
00649    StringFunctionDefinitions(theEnv);
00650 #endif
00651 
00652 #if EXTENDED_MATH_FUNCTIONS
00653    ExtendedMathFunctionDefinitions(theEnv);
00654 #endif
00655 
00656 #if TEXTPRO_FUNCTIONS || HELP_FUNCTIONS
00657    HelpFunctionDefinitions(theEnv);
00658 #endif
00659 
00660 #if EMACS_EDITOR
00661    EditorFunctionDefinition(theEnv);
00662 #endif
00663 
00664 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00665    ConstructsToCCommandDefinition(theEnv);
00666 #endif
00667 
00668 #if PROFILING_FUNCTIONS
00669    ConstructProfilingFunctionDefinitions(theEnv);
00670 #endif
00671 
00672    ParseFunctionDefinitions(theEnv);
00673   }
00674   
00675 /*********************************************************/
00676 /* gentime: A function to return a floating point number */
00677 /*   which indicates the present time. Used internally   */
00678 /*   for timing rule firings and debugging.              */
00679 /*********************************************************/
00680 globle double gentime()
00681   {
00682 #if   MAC_XCD || MAC_MCW
00683    UnsignedWide result;
00684 
00685    Microseconds(&result);
00686 
00687    return(((((double) result.hi) * kTwoPower32) + result.lo) / 1000000.0);
00688 
00689 #elif WIN_MCW
00690    unsigned long int result;
00691 
00692    result = GetTickCount();
00693 
00694    return((double) result / 1000.0);
00695 /*
00696 #elif   WIN_BTC && (! WINDOW_INTERFACE)
00697    unsigned long int result;
00698 
00699    result = biostime(0,(long int) 0);
00700 
00701    return((double) result / 18.2);
00702 */
00703 #elif UNIX_V || DARWIN
00704 #if defined(_POSIX_TIMERS) && (_POSIX_TIMERS > 0)
00705    struct timespec now;
00706    clock_gettime(
00707 
00708 #if defined(_POSIX_MONOTONIC_CLOCK)
00709        CLOCK_MONOTONIC,
00710 #else
00711        CLOCK_REALTIME,
00712 #endif
00713        &now);
00714   return (now.tv_nsec / 1000000000.0) + now.tv_sec;
00715 #else
00716    struct timeval now;
00717    gettimeofday(&now, 0);
00718    return (now.tv_usec / 1000000.0) + now.tv_sec;
00719 #endif
00720 
00721 #elif LINUX
00722 #if defined(_POSIX_TIMERS) && (_POSIX_TIMERS > 0) && defined(_POSIX_C_SOURCE) && (_POSIX_C_SOURCE >= 199309L)
00723    struct timespec now;
00724    clock_gettime(
00725 
00726 #if defined(_POSIX_MONOTONIC_CLOCK)
00727        CLOCK_MONOTONIC,
00728 #else
00729        CLOCK_REALTIME,
00730 #endif
00731        &now);
00732   return (now.tv_nsec / 1000000000.0) + now.tv_sec;
00733 #else
00734    struct timeval now;
00735    gettimeofday(&now, 0);
00736    return (now.tv_usec / 1000000.0) + now.tv_sec;
00737 #endif
00738 
00739 #elif UNIX_7
00740    struct timeval now;
00741    gettimeofday(&now, 0);
00742    return (now.tv_usec / 1000000.0) + now.tv_sec;
00743 
00744 #else
00745    return((double) clock() / (double) CLOCKS_PER_SEC);
00746 #endif
00747   }
00748 
00749 /*****************************************************/
00750 /* gensystem: Generic routine for passing a string   */
00751 /*   representing a command to the operating system. */
00752 /*****************************************************/
00753 globle void gensystem(
00754   void *theEnv)
00755   {
00756    char *commandBuffer = NULL;
00757    size_t bufferPosition = 0;
00758    size_t bufferMaximum = 0;
00759    int numa, i;
00760    DATA_OBJECT tempValue;
00761    char *theString;
00762 
00763    /*===========================================*/
00764    /* Check for the corret number of arguments. */
00765    /*===========================================*/
00766 
00767    if ((numa = EnvArgCountCheck(theEnv,"system",AT_LEAST,1)) == -1) return;
00768 
00769    /*============================================================*/
00770    /* Concatenate the arguments together to form a single string */
00771    /* containing the command to be sent to the operating system. */
00772    /*============================================================*/
00773 
00774    for (i = 1 ; i <= numa; i++)
00775      {
00776       EnvRtnUnknown(theEnv,i,&tempValue);
00777       if ((GetType(tempValue) != STRING) &&
00778           (GetType(tempValue) != SYMBOL))
00779         {
00780          SetHaltExecution(theEnv,TRUE);
00781          SetEvaluationError(theEnv,TRUE);
00782          ExpectedTypeError2(theEnv,"system",i);
00783          return;
00784         }
00785 
00786      theString = DOToString(tempValue);
00787 
00788      commandBuffer = AppendToString(theEnv,theString,commandBuffer,&bufferPosition,&bufferMaximum);
00789     }
00790 
00791    if (commandBuffer == NULL) return;
00792 
00793    /*=======================================*/
00794    /* Execute the operating system command. */
00795    /*=======================================*/
00796 
00797 #if VAX_VMS
00798    if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv);
00799    VMSSystem(commandBuffer);
00800    putchar('\n');
00801    if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1);
00802    if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv);
00803 #endif
00804 
00805 #if   UNIX_7 || UNIX_V || LINUX || DARWIN || WIN_MVC || WIN_BTC || WIN_MCW || WIN_GCC || MAC_XCD
00806    if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv);
00807    system(commandBuffer);
00808    if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1);
00809    if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv);
00810 #else
00811 
00812 #if ! VAX_VMS
00813    EnvPrintRouter(theEnv,WDIALOG,
00814             "System function not fully defined for this system.\n");
00815 #endif
00816 
00817 #endif
00818 
00819    /*==================================================*/
00820    /* Return the string buffer containing the command. */
00821    /*==================================================*/
00822 
00823    rm(theEnv,commandBuffer,bufferMaximum);
00824 
00825    return;
00826   }
00827 
00828 #if   VAX_VMS
00829 /*************************************************/
00830 /* VMSSystem: Implements system command for VMS. */
00831 /*************************************************/
00832 globle void VMSSystem(
00833   char *cmd)
00834   {
00835    long status, complcode;
00836    struct dsc$descriptor_s cmd_desc;
00837 
00838    cmd_desc.dsc$w_length = strlen(cmd);
00839    cmd_desc.dsc$a_pointer = cmd;
00840    cmd_desc.dsc$b_class = DSC$K_CLASS_S;
00841    cmd_desc.dsc$b_dtype = DSC$K_DTYPE_T;
00842 
00843    status = LIB$SPAWN(&cmd_desc,0,0,0,0,0,&complcode,0,0,0);
00844   }
00845 
00846 #endif
00847 
00848 /*******************************************/
00849 /* gengetchar: Generic routine for getting */
00850 /*    a character from stdin.              */
00851 /*******************************************/
00852 globle int gengetchar(
00853   void *theEnv)
00854   {
00855 #if WIN_BTC || WIN_MVC
00856    if (SystemDependentData(theEnv)->getcLength ==
00857        SystemDependentData(theEnv)->getcPosition)
00858      {
00859       TCHAR tBuffer = 0;
00860       DWORD count = 0;
00861       WCHAR wBuffer = 0;
00862 
00863       ReadConsole(GetStdHandle(STD_INPUT_HANDLE),&tBuffer,1,&count,NULL);
00864       
00865       wBuffer = tBuffer;
00866       
00867       SystemDependentData(theEnv)->getcLength = 
00868          WideCharToMultiByte(CP_UTF8,0,&wBuffer,1,
00869                              (char *) SystemDependentData(theEnv)->getcBuffer,
00870                              7,NULL,NULL);
00871                              
00872       SystemDependentData(theEnv)->getcPosition = 0;
00873      }
00874      
00875    return SystemDependentData(theEnv)->getcBuffer[SystemDependentData(theEnv)->getcPosition++];
00876 #else
00877    return(getc(stdin));
00878 #endif
00879   }
00880 
00881 /***********************************************/
00882 /* genungetchar: Generic routine for ungetting */
00883 /*    a character from stdin.                  */
00884 /***********************************************/
00885 globle int genungetchar(
00886   void *theEnv,
00887   int theChar)
00888   {
00889 #if WIN_BTC || WIN_MVC
00890    if (SystemDependentData(theEnv)->getcPosition > 0)
00891      { 
00892       SystemDependentData(theEnv)->getcPosition--;
00893       return theChar;
00894      }
00895    else
00896      { return EOF; }
00897 #else
00898    return(ungetc(theChar,stdin));
00899 #endif
00900   }
00901 
00902 /****************************************************/
00903 /* genprintfile: Generic routine for print a single */
00904 /*   character string to a file (including stdout). */
00905 /****************************************************/
00906 globle void genprintfile(
00907   void *theEnv,
00908   FILE *fptr,
00909   char *str)
00910   {
00911    if (fptr != stdout)
00912      {
00913       fprintf(fptr,"%s",str);
00914       fflush(fptr);
00915      }
00916    else
00917      {
00918 #if WIN_MVC
00919 /*
00920       int rv;
00921       wchar_t *wbuffer;
00922       size_t len = strlen(str);
00923 
00924       wbuffer = genalloc(theEnv,sizeof(wchar_t) * (len + 1));
00925       rv = MultiByteToWideChar(CP_UTF8,MB_ERR_INVALID_CHARS,str,-1,wbuffer,len+1);
00926       
00927       fwprintf(fptr,L"%ls",wbuffer);
00928       fflush(fptr);
00929       genfree(theEnv,wbuffer,sizeof(wchar_t) * (len + 1));
00930 */
00931       fprintf(fptr,"%s",str);
00932       fflush(fptr);
00933 #else
00934       fprintf(fptr,"%s",str);
00935       fflush(fptr);
00936 #endif
00937      }
00938   }
00939   
00940 /***********************************************************/
00941 /* InitializeNonportableFeatures: Initializes non-portable */
00942 /*   features. Currently, the only non-portable feature    */
00943 /*   requiring initialization is the interrupt handler     */
00944 /*   which allows execution to be halted.                  */
00945 /***********************************************************/
00946 #if WIN_BTC
00947 #pragma argsused
00948 #endif
00949 static void InitializeNonportableFeatures(
00950   void *theEnv)
00951   {
00952 #if MAC_MCW || WIN_MCW || MAC_XCD
00953 #pragma unused(theEnv)
00954 #endif
00955 #if ! WINDOW_INTERFACE
00956 
00957 #if VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_BTC || WIN_MVC
00958    signal(SIGINT,CatchCtrlC);
00959 #endif
00960 
00961 /*
00962 #if WIN_BTC
00963    SystemDependentData(theEnv)->OldCtrlC = getvect(0x23);
00964    SystemDependentData(theEnv)->OldBreak = getvect(0x1b);
00965    setvect(0x23,CatchCtrlC);
00966    setvect(0x1b,CatchCtrlC);
00967    atexit(RestoreInterruptVectors);
00968 #endif
00969 */
00970 /*
00971 #if WIN_MVC
00972    SystemDependentData(theEnv)->OldCtrlC = _dos_getvect(0x23);
00973    SystemDependentData(theEnv)->OldBreak = _dos_getvect(0x1b);
00974    _dos_setvect(0x23,CatchCtrlC);
00975    _dos_setvect(0x1b,CatchCtrlC);
00976    atexit(RestoreInterruptVectors);
00977 #endif
00978 */
00979 #endif
00980   }
00981 
00982 /*************************************************************/
00983 /* Functions For Handling Control C Interrupt: The following */
00984 /*   functions handle interrupt processing for several       */
00985 /*   machines. For the Macintosh control-c is not handle,    */
00986 /*   but a function is provided to call periodically which   */
00987 /*   calls SystemTask (allowing periodic tasks to be handled */
00988 /*   by the operating system).                               */
00989 /*************************************************************/
00990 
00991 #if ! WINDOW_INTERFACE
00992 
00993 #if   VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_BTC || WIN_MVC || DARWIN
00994 /**********************************************/
00995 /* CatchCtrlC: VMS and UNIX specific function */
00996 /*   to allow control-c interrupts.           */
00997 /**********************************************/
00998 #if WIN_BTC
00999 #pragma argsused
01000 #endif
01001 static void CatchCtrlC(
01002   int sgnl)
01003   {
01004 #if ALLOW_ENVIRONMENT_GLOBALS
01005    SetHaltExecution(GetCurrentEnvironment(),TRUE);
01006    CloseAllBatchSources(GetCurrentEnvironment());
01007 #endif
01008    signal(SIGINT,CatchCtrlC);
01009   }
01010 #endif
01011 
01012 #if   WIN_MVC
01013 /******************************************************/
01014 /* CatchCtrlC: IBM Microsoft C and Borland Turbo C    */
01015 /*   specific function to allow control-c interrupts. */
01016 /******************************************************/
01017 /*
01018 static void interrupt CatchCtrlC()
01019   {
01020 #if ALLOW_ENVIRONMENT_GLOBALS
01021    SetHaltExecution(GetCurrentEnvironment(),TRUE);
01022    CloseAllBatchSources(GetCurrentEnvironment());
01023 #endif
01024   }
01025 */
01026 /**************************************************************/
01027 /* RestoreInterruptVectors: IBM Microsoft C and Borland Turbo */
01028 /*   C specific function for restoring interrupt vectors.     */
01029 /**************************************************************/
01030 /*
01031 static void RestoreInterruptVectors()
01032   {
01033 #if ALLOW_ENVIRONMENT_GLOBALS
01034    void *theEnv;
01035    
01036    theEnv = GetCurrentEnvironment();
01037 
01038    _dos_setvect(0x23,SystemDependentData(theEnv)->OldCtrlC);
01039    _dos_setvect(0x1b,SystemDependentData(theEnv)->OldBreak);
01040 #endif
01041   }
01042 */
01043 #endif
01044 
01045 #endif
01046 
01047 /**************************************/
01048 /* genexit:  A generic exit function. */
01049 /**************************************/
01050 globle void genexit(
01051   void *theEnv,
01052   int num)
01053   {
01054    if (SystemDependentData(theEnv)->jmpBuffer != NULL)
01055      { longjmp(*SystemDependentData(theEnv)->jmpBuffer,1); }
01056      
01057    exit(num);
01058   }
01059 
01060 /**************************************/
01061 /* SetJmpBuffer: */
01062 /**************************************/
01063 globle void SetJmpBuffer(
01064   void *theEnv,
01065   jmp_buf *theJmpBuffer)
01066   {
01067    SystemDependentData(theEnv)->jmpBuffer = theJmpBuffer;
01068   }
01069   
01070 /******************************************/
01071 /* genstrcpy: Generic genstrcpy function. */
01072 /******************************************/
01073 char *genstrcpy(
01074   char *dest,
01075   const char *src)
01076   {
01077    return strcpy(dest,src);
01078   }
01079 
01080 /********************************************/
01081 /* genstrncpy: Generic genstrncpy function. */
01082 /********************************************/
01083 char *genstrncpy(
01084   char *dest,
01085   const char *src,
01086   size_t n)
01087   {
01088    return strncpy(dest,src,n);
01089   }
01090   
01091 /******************************************/
01092 /* genstrcat: Generic genstrcat function. */
01093 /******************************************/
01094 char *genstrcat(
01095   char *dest,
01096   const char *src)
01097   {
01098    return strcat(dest,src);
01099   }
01100 
01101 /********************************************/
01102 /* genstrncat: Generic genstrncat function. */
01103 /********************************************/
01104 char *genstrncat(
01105   char *dest,
01106   const char *src,
01107   size_t n)
01108   {
01109    return strncat(dest,src,n);
01110   }
01111   
01112 /*****************************************/
01113 /* gensprintf: Generic sprintf function. */
01114 /*****************************************/
01115 int gensprintf(
01116   char *buffer,
01117   const char *restrictStr,
01118   ...)
01119   {
01120    va_list args;
01121    int rv;
01122    
01123    va_start(args,restrictStr);
01124    
01125    rv = vsprintf(buffer,restrictStr,args);
01126    
01127    va_end(args);
01128    
01129    return rv;
01130   }
01131   
01132 /******************************************************/
01133 /* genrand: Generic random number generator function. */
01134 /******************************************************/
01135 int genrand()
01136   {
01137    return(rand());
01138   }
01139   
01140 /**********************************************************************/
01141 /* genseed: Generic function for seeding the random number generator. */
01142 /**********************************************************************/
01143 globle void genseed(
01144   int seed)
01145   {
01146    srand((unsigned) seed);
01147   }
01148 
01149 /*********************************************/
01150 /* gengetcwd: Generic function for returning */
01151 /*   the current directory.                  */
01152 /*********************************************/
01153 #if WIN_BTC
01154 #pragma argsused
01155 #endif
01156 globle char *gengetcwd(
01157   char *buffer,
01158   int buflength)
01159   {
01160 #if MAC_MCW || WIN_MCW || MAC_XCD
01161    return(getcwd(buffer,buflength));
01162 #endif
01163 
01164    if (buffer != NULL)
01165      { buffer[0] = 0; }
01166    return(buffer);
01167   }
01168 
01169 /****************************************************/
01170 /* genremove: Generic function for removing a file. */
01171 /****************************************************/
01172 globle int genremove(
01173   char *fileName)
01174   {
01175    if (remove(fileName)) return(FALSE);
01176 
01177    return(TRUE);
01178   }
01179 
01180 /****************************************************/
01181 /* genrename: Generic function for renaming a file. */
01182 /****************************************************/
01183 globle int genrename(
01184   char *oldFileName,
01185   char *newFileName)
01186   {
01187    if (rename(oldFileName,newFileName)) return(FALSE);
01188 
01189    return(TRUE);
01190   }
01191 
01192 /**************************************/
01193 /* EnvSetBeforeOpenFunction: Sets the */
01194 /*  value of BeforeOpenFunction.      */
01195 /**************************************/
01196 globle int (*EnvSetBeforeOpenFunction(void *theEnv,
01197                                       int (*theFunction)(void *)))(void *)
01198   {
01199    int (*tempFunction)(void *);
01200 
01201    tempFunction = SystemDependentData(theEnv)->BeforeOpenFunction;
01202    SystemDependentData(theEnv)->BeforeOpenFunction = theFunction;
01203    return(tempFunction);
01204   }
01205 
01206 /*************************************/
01207 /* EnvSetAfterOpenFunction: Sets the */
01208 /*  value of AfterOpenFunction.      */
01209 /*************************************/
01210 globle int (*EnvSetAfterOpenFunction(void *theEnv,
01211                                      int (*theFunction)(void *)))(void *)
01212   {
01213    int (*tempFunction)(void *);
01214 
01215    tempFunction = SystemDependentData(theEnv)->AfterOpenFunction;
01216    SystemDependentData(theEnv)->AfterOpenFunction = theFunction;
01217    return(tempFunction);
01218   }
01219 
01220 /*********************************************/
01221 /* GenOpen: Trap routine for opening a file. */
01222 /*********************************************/
01223 globle FILE *GenOpen(
01224   void *theEnv,
01225   char *fileName,
01226   char *accessType)
01227   {
01228    FILE *theFile;
01229    
01230    if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL)
01231      { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); }
01232 
01233 #if WIN_MVC
01234 #if _MSC_VER >= 1400
01235    fopen_s(&theFile,fileName,accessType);
01236 #else
01237    theFile = fopen(fileName,accessType);
01238 #endif
01239 #else
01240    theFile = fopen(fileName,accessType);
01241 #endif
01242    
01243    if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01244      { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01245      
01246    return theFile;
01247   }
01248   
01249 /**********************************************/
01250 /* GenClose: Trap routine for closing a file. */
01251 /**********************************************/
01252 globle int GenClose(
01253   void *theEnv,
01254   FILE *theFile)
01255   {
01256    int rv;
01257    
01258    if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL)
01259      { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); }
01260 
01261    rv = fclose(theFile);
01262 
01263    if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01264      { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01265    
01266    return rv;
01267   }
01268   
01269 /************************************************************/
01270 /* GenOpenReadBinary: Generic and machine specific code for */
01271 /*   opening a file for binary access. Only one file may be */
01272 /*   open at a time when using this function since the file */
01273 /*   pointer is stored in a global variable.                */
01274 /************************************************************/
01275 globle int GenOpenReadBinary(
01276   void *theEnv,
01277   char *funcName,
01278   char *fileName)
01279   {
01280    if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL)
01281      { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); }
01282 
01283 #if WIN_BTC || WIN_MVC
01284 
01285 #if WIN_MVC
01286    SystemDependentData(theEnv)->BinaryFileHandle = _open(fileName,O_RDONLY | O_BINARY);
01287 #else
01288    SystemDependentData(theEnv)->BinaryFileHandle = open(fileName,O_RDONLY | O_BINARY);
01289 #endif
01290    if (SystemDependentData(theEnv)->BinaryFileHandle == -1)
01291      {
01292       if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01293         { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01294       OpenErrorMessage(theEnv,funcName,fileName);
01295       return(FALSE);
01296      }
01297 #endif
01298 
01299 #if (! WIN_BTC) && (! WIN_MVC)
01300 
01301    if ((SystemDependentData(theEnv)->BinaryFP = fopen(fileName,"rb")) == NULL)
01302      {
01303       if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01304         { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01305       OpenErrorMessage(theEnv,funcName,fileName);
01306       return(FALSE);
01307      }
01308 #endif
01309 
01310    if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01311      { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01312 
01313    return(TRUE);
01314   }
01315 
01316 /***********************************************/
01317 /* GenReadBinary: Generic and machine specific */
01318 /*   code for reading from a file.             */
01319 /***********************************************/
01320 globle void GenReadBinary(
01321   void *theEnv,
01322   void *dataPtr,
01323   size_t size)
01324   {
01325 #if WIN_MVC
01326    char *tempPtr;
01327 
01328    tempPtr = (char *) dataPtr;
01329    while (size > INT_MAX)
01330      {
01331       _read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,INT_MAX);
01332       size -= INT_MAX;
01333       tempPtr = tempPtr + INT_MAX;
01334      }
01335 
01336    if (size > 0) 
01337      { _read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,(unsigned int) size); }
01338 #endif
01339 
01340 #if WIN_BTC
01341    char *tempPtr;
01342 
01343    tempPtr = (char *) dataPtr;
01344    while (size > INT_MAX)
01345      {
01346       read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,INT_MAX);
01347       size -= INT_MAX;
01348       tempPtr = tempPtr + INT_MAX;
01349      }
01350 
01351    if (size > 0) 
01352      { read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,(STD_SIZE) size); }
01353 #endif
01354 
01355 #if (! WIN_BTC) && (! WIN_MVC)
01356    fread(dataPtr,size,1,SystemDependentData(theEnv)->BinaryFP); 
01357 #endif
01358   }
01359 
01360 /***************************************************/
01361 /* GetSeekCurBinary:  Generic and machine specific */
01362 /*   code for seeking a position in a file.        */
01363 /***************************************************/
01364 globle void GetSeekCurBinary(
01365   void *theEnv,
01366   long offset)
01367   {
01368 #if WIN_BTC
01369    lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_CUR);
01370 #endif
01371 
01372 #if WIN_MVC
01373    _lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_CUR);
01374 #endif
01375 
01376 #if (! WIN_BTC) && (! WIN_MVC)
01377    fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_CUR);
01378 #endif
01379   }
01380   
01381 /***************************************************/
01382 /* GetSeekSetBinary:  Generic and machine specific */
01383 /*   code for seeking a position in a file.        */
01384 /***************************************************/
01385 globle void GetSeekSetBinary(
01386   void *theEnv,
01387   long offset)
01388   {
01389 #if WIN_BTC
01390    lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_SET);
01391 #endif
01392 
01393 #if WIN_MVC
01394    _lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_SET);
01395 #endif
01396 
01397 #if (! WIN_BTC) && (! WIN_MVC)
01398    fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_SET);
01399 #endif
01400   }
01401 
01402 /************************************************/
01403 /* GenTellBinary:  Generic and machine specific */
01404 /*   code for telling a position in a file.     */
01405 /************************************************/
01406 globle void GenTellBinary(
01407   void *theEnv,
01408   long *offset)
01409   {
01410 #if WIN_BTC
01411    *offset = lseek(SystemDependentData(theEnv)->BinaryFileHandle,0,SEEK_CUR);
01412 #endif
01413 
01414 #if WIN_MVC
01415    *offset = _lseek(SystemDependentData(theEnv)->BinaryFileHandle,0,SEEK_CUR);
01416 #endif
01417 
01418 #if (! WIN_BTC) && (! WIN_MVC)
01419    *offset = ftell(SystemDependentData(theEnv)->BinaryFP);
01420 #endif
01421   }
01422 
01423 /****************************************/
01424 /* GenCloseBinary:  Generic and machine */
01425 /*   specific code for closing a file.  */
01426 /****************************************/
01427 globle void GenCloseBinary(
01428   void *theEnv)
01429   {
01430    if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL)
01431      { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); }
01432 
01433 #if WIN_BTC
01434    close(SystemDependentData(theEnv)->BinaryFileHandle);
01435 #endif
01436 
01437 #if WIN_MVC
01438    _close(SystemDependentData(theEnv)->BinaryFileHandle);
01439 #endif
01440 
01441 #if (! WIN_BTC) && (! WIN_MVC)
01442    fclose(SystemDependentData(theEnv)->BinaryFP);
01443 #endif
01444 
01445    if (SystemDependentData(theEnv)->AfterOpenFunction != NULL)
01446      { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); }
01447   }
01448   
01449 /***********************************************/
01450 /* GenWrite: Generic routine for writing to a  */
01451 /*   file. No machine specific code as of yet. */
01452 /***********************************************/
01453 globle void GenWrite(
01454   void *dataPtr,
01455   size_t size,
01456   FILE *fp)
01457   {
01458    if (size == 0) return;
01459 #if UNIX_7
01460    fwrite(dataPtr,size,1,fp);
01461 #else
01462    fwrite(dataPtr,size,1,fp);
01463 #endif
01464   }
01465 
01466 /*********************************************/
01467 /* InitializeKeywords: Adds key words to the */
01468 /*   symbol table so that they are available */
01469 /*   for command completion.                 */
01470 /*********************************************/
01471 #if WIN_BTC && (RUN_TIME || (! WINDOW_INTERFACE))
01472 #pragma argsused
01473 #endif
01474 static void InitializeKeywords(
01475   void *theEnv)
01476   {
01477 #if (! RUN_TIME) && WINDOW_INTERFACE
01478    void *ts;
01479 
01480    /*====================*/
01481    /* construct keywords */
01482    /*====================*/
01483 
01484    ts = EnvAddSymbol(theEnv,"defrule");
01485    IncrementSymbolCount(ts);
01486    ts = EnvAddSymbol(theEnv,"defglobal");
01487    IncrementSymbolCount(ts);
01488    ts = EnvAddSymbol(theEnv,"deftemplate");
01489    IncrementSymbolCount(ts);
01490    ts = EnvAddSymbol(theEnv,"deffacts");
01491    IncrementSymbolCount(ts);
01492    ts = EnvAddSymbol(theEnv,"deffunction");
01493    IncrementSymbolCount(ts);
01494    ts = EnvAddSymbol(theEnv,"defmethod");
01495    IncrementSymbolCount(ts);
01496    ts = EnvAddSymbol(theEnv,"defgeneric");
01497    IncrementSymbolCount(ts);
01498    ts = EnvAddSymbol(theEnv,"defclass");
01499    IncrementSymbolCount(ts);
01500    ts = EnvAddSymbol(theEnv,"defmessage-handler");
01501    IncrementSymbolCount(ts);
01502    ts = EnvAddSymbol(theEnv,"definstances");
01503    IncrementSymbolCount(ts);
01504 
01505    /*=======================*/
01506    /* set-strategy keywords */
01507    /*=======================*/
01508 
01509    ts = EnvAddSymbol(theEnv,"depth");
01510    IncrementSymbolCount(ts);
01511    ts = EnvAddSymbol(theEnv,"breadth");
01512    IncrementSymbolCount(ts);
01513    ts = EnvAddSymbol(theEnv,"lex");
01514    IncrementSymbolCount(ts);
01515    ts = EnvAddSymbol(theEnv,"mea");
01516    IncrementSymbolCount(ts);
01517    ts = EnvAddSymbol(theEnv,"simplicity");
01518    IncrementSymbolCount(ts);
01519    ts = EnvAddSymbol(theEnv,"complexity");
01520    IncrementSymbolCount(ts);
01521    ts = EnvAddSymbol(theEnv,"random");
01522    IncrementSymbolCount(ts);
01523 
01524    /*==================================*/
01525    /* set-salience-evaluation keywords */
01526    /*==================================*/
01527 
01528    ts = EnvAddSymbol(theEnv,"when-defined");
01529    IncrementSymbolCount(ts);
01530    ts = EnvAddSymbol(theEnv,"when-activated");
01531    IncrementSymbolCount(ts);
01532    ts = EnvAddSymbol(theEnv,"every-cycle");
01533    IncrementSymbolCount(ts);
01534 
01535    /*======================*/
01536    /* deftemplate keywords */
01537    /*======================*/
01538 
01539    ts = EnvAddSymbol(theEnv,"field");
01540    IncrementSymbolCount(ts);
01541    ts = EnvAddSymbol(theEnv,"multifield");
01542    IncrementSymbolCount(ts);
01543    ts = EnvAddSymbol(theEnv,"default");
01544    IncrementSymbolCount(ts);
01545    ts = EnvAddSymbol(theEnv,"type");
01546    IncrementSymbolCount(ts);
01547    ts = EnvAddSymbol(theEnv,"allowed-symbols");
01548    IncrementSymbolCount(ts);
01549    ts = EnvAddSymbol(theEnv,"allowed-strings");
01550    IncrementSymbolCount(ts);
01551    ts = EnvAddSymbol(theEnv,"allowed-numbers");
01552    IncrementSymbolCount(ts);
01553    ts = EnvAddSymbol(theEnv,"allowed-integers");
01554    IncrementSymbolCount(ts);
01555    ts = EnvAddSymbol(theEnv,"allowed-floats");
01556    IncrementSymbolCount(ts);
01557    ts = EnvAddSymbol(theEnv,"allowed-values");
01558    IncrementSymbolCount(ts);
01559    ts = EnvAddSymbol(theEnv,"min-number-of-elements");
01560    IncrementSymbolCount(ts);
01561    ts = EnvAddSymbol(theEnv,"max-number-of-elements");
01562    IncrementSymbolCount(ts);
01563    ts = EnvAddSymbol(theEnv,"NONE");
01564    IncrementSymbolCount(ts);
01565    ts = EnvAddSymbol(theEnv,"VARIABLE");
01566    IncrementSymbolCount(ts);
01567 
01568    /*==================*/
01569    /* defrule keywords */
01570    /*==================*/
01571 
01572    ts = EnvAddSymbol(theEnv,"declare");
01573    IncrementSymbolCount(ts);
01574    ts = EnvAddSymbol(theEnv,"salience");
01575    IncrementSymbolCount(ts);
01576    ts = EnvAddSymbol(theEnv,"test");
01577    IncrementSymbolCount(ts);
01578    ts = EnvAddSymbol(theEnv,"or");
01579    IncrementSymbolCount(ts);
01580    ts = EnvAddSymbol(theEnv,"and");
01581    IncrementSymbolCount(ts);
01582    ts = EnvAddSymbol(theEnv,"not");
01583    IncrementSymbolCount(ts);
01584    ts = EnvAddSymbol(theEnv,"logical");
01585    IncrementSymbolCount(ts);
01586 
01587    /*===============*/
01588    /* COOL keywords */
01589    /*===============*/
01590 
01591    ts = EnvAddSymbol(theEnv,"is-a");
01592    IncrementSymbolCount(ts);
01593    ts = EnvAddSymbol(theEnv,"role");
01594    IncrementSymbolCount(ts);
01595    ts = EnvAddSymbol(theEnv,"abstract");
01596    IncrementSymbolCount(ts);
01597    ts = EnvAddSymbol(theEnv,"concrete");
01598    IncrementSymbolCount(ts);
01599    ts = EnvAddSymbol(theEnv,"pattern-match");
01600    IncrementSymbolCount(ts);
01601    ts = EnvAddSymbol(theEnv,"reactive");
01602    IncrementSymbolCount(ts);
01603    ts = EnvAddSymbol(theEnv,"non-reactive");
01604    IncrementSymbolCount(ts);
01605    ts = EnvAddSymbol(theEnv,"slot");
01606    IncrementSymbolCount(ts);
01607    ts = EnvAddSymbol(theEnv,"field");
01608    IncrementSymbolCount(ts);
01609    ts = EnvAddSymbol(theEnv,"multiple");
01610    IncrementSymbolCount(ts);
01611    ts = EnvAddSymbol(theEnv,"single");
01612    IncrementSymbolCount(ts);
01613    ts = EnvAddSymbol(theEnv,"storage");
01614    IncrementSymbolCount(ts);
01615    ts = EnvAddSymbol(theEnv,"shared");
01616    IncrementSymbolCount(ts);
01617    ts = EnvAddSymbol(theEnv,"local");
01618    IncrementSymbolCount(ts);
01619    ts = EnvAddSymbol(theEnv,"access");
01620    IncrementSymbolCount(ts);
01621    ts = EnvAddSymbol(theEnv,"read");
01622    IncrementSymbolCount(ts);
01623    ts = EnvAddSymbol(theEnv,"write");
01624    IncrementSymbolCount(ts);
01625    ts = EnvAddSymbol(theEnv,"read-only");
01626    IncrementSymbolCount(ts);
01627    ts = EnvAddSymbol(theEnv,"read-write");
01628    IncrementSymbolCount(ts);
01629    ts = EnvAddSymbol(theEnv,"initialize-only");
01630    IncrementSymbolCount(ts);
01631    ts = EnvAddSymbol(theEnv,"propagation");
01632    IncrementSymbolCount(ts);
01633    ts = EnvAddSymbol(theEnv,"inherit");
01634    IncrementSymbolCount(ts);
01635    ts = EnvAddSymbol(theEnv,"no-inherit");
01636    IncrementSymbolCount(ts);
01637    ts = EnvAddSymbol(theEnv,"source");
01638    IncrementSymbolCount(ts);
01639    ts = EnvAddSymbol(theEnv,"composite");
01640    IncrementSymbolCount(ts);
01641    ts = EnvAddSymbol(theEnv,"exclusive");
01642    IncrementSymbolCount(ts);
01643    ts = EnvAddSymbol(theEnv,"allowed-lexemes");
01644    IncrementSymbolCount(ts);
01645    ts = EnvAddSymbol(theEnv,"allowed-instances");
01646    IncrementSymbolCount(ts);
01647    ts = EnvAddSymbol(theEnv,"around");
01648    IncrementSymbolCount(ts);
01649    ts = EnvAddSymbol(theEnv,"before");
01650    IncrementSymbolCount(ts);
01651    ts = EnvAddSymbol(theEnv,"primary");
01652    IncrementSymbolCount(ts);
01653    ts = EnvAddSymbol(theEnv,"after");
01654    IncrementSymbolCount(ts);
01655    ts = EnvAddSymbol(theEnv,"of");
01656    IncrementSymbolCount(ts);
01657    ts = EnvAddSymbol(theEnv,"self");
01658    IncrementSymbolCount(ts);
01659    ts = EnvAddSymbol(theEnv,"visibility");
01660    IncrementSymbolCount(ts);
01661    ts = EnvAddSymbol(theEnv,"override-message");
01662    IncrementSymbolCount(ts);
01663    ts = EnvAddSymbol(theEnv,"private");
01664    IncrementSymbolCount(ts);
01665    ts = EnvAddSymbol(theEnv,"public");
01666    IncrementSymbolCount(ts);
01667    ts = EnvAddSymbol(theEnv,"create-accessor");
01668    IncrementSymbolCount(ts);
01669 
01670    /*================*/
01671    /* watch keywords */
01672    /*================*/
01673 
01674    ts = EnvAddSymbol(theEnv,"compilations");
01675    IncrementSymbolCount(ts);
01676    ts = EnvAddSymbol(theEnv,"deffunctions");
01677    IncrementSymbolCount(ts);
01678    ts = EnvAddSymbol(theEnv,"globals");
01679    IncrementSymbolCount(ts);
01680    ts = EnvAddSymbol(theEnv,"rules");
01681    IncrementSymbolCount(ts);
01682    ts = EnvAddSymbol(theEnv,"activations");
01683    IncrementSymbolCount(ts);
01684    ts = EnvAddSymbol(theEnv,"statistics");
01685    IncrementSymbolCount(ts);
01686    ts = EnvAddSymbol(theEnv,"facts");
01687    IncrementSymbolCount(ts);
01688    ts = EnvAddSymbol(theEnv,"generic-functions");
01689    IncrementSymbolCount(ts);
01690    ts = EnvAddSymbol(theEnv,"methods");
01691    IncrementSymbolCount(ts);
01692    ts = EnvAddSymbol(theEnv,"instances");
01693    IncrementSymbolCount(ts);
01694    ts = EnvAddSymbol(theEnv,"slots");
01695    IncrementSymbolCount(ts);
01696    ts = EnvAddSymbol(theEnv,"messages");
01697    IncrementSymbolCount(ts);
01698    ts = EnvAddSymbol(theEnv,"message-handlers");
01699    IncrementSymbolCount(ts);
01700    ts = EnvAddSymbol(theEnv,"focus");
01701    IncrementSymbolCount(ts);
01702 #else
01703 #if MAC_MCW || WIN_MCW || MAC_XCD
01704 #pragma unused(theEnv)
01705 #endif
01706 #endif
01707   }
01708 
01709 #if WIN_BTC
01710 /*********************************************/
01711 /* strtoll: Convert string to long long int. */
01712 /*    Note supported by Turbo C++ 2006.      */
01713 /*********************************************/
01714 __int64 _RTLENTRY _EXPFUNC strtoll(
01715   const char * str,
01716   char**endptr,
01717   int base)
01718   // convert string to long long int
01719   {
01720    if (endptr != NULL)
01721          *endptr = (char*)str + (base == 10 ? strspn(str, "0123456789"): 0);
01722    return(_atoi64(str));
01723   }
01724 
01725 /*******************************************/
01726 /* llabs: absolute value of long long int. */
01727 /*    Note supported by Turbo C++ 2006.    */
01728 /*******************************************/
01729 __int64 _RTLENTRY _EXPFUNC llabs(
01730   __int64 val)
01731   {
01732    if (val >=0) return(val);
01733    else return(-val);
01734   }
01735 
01736 #endif