Exemplo n.º 1
0
/*****************************************************
  NAME         : AddHashedExpression
  DESCRIPTION  : Adds a new expression to the
                 expression hash table (or increments
                 the use count if it is already there)
  INPUTS       : The (new) expression
  RETURNS      : A pointer to the (new) hash node
  SIDE EFFECTS : Adds the new hash node or increments
                 the count of an existing one
  NOTES        : It is the caller's responsibility to
                 delete the passed expression.  This
                 routine copies, packs and installs
                 the given expression
 *****************************************************/
globle EXPRESSION *AddHashedExpression(
  void *theEnv,
  EXPRESSION *theExp)
  {
   EXPRESSION_HN *prv,*exphash;
   unsigned hashval;

   if (theExp == NULL) return(NULL);
   exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv);
   if (exphash != NULL)
     {
      exphash->count++;
      return(exphash->exp);
     }
   exphash = get_struct(theEnv,exprHashNode);
   exphash->hashval = hashval;
   exphash->count = 1;
   exphash->exp = PackExpression(theEnv,theExp);
   ExpressionInstall(theEnv,exphash->exp);
   exphash->next = ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval];
   ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval] = exphash;
   exphash->bsaveID = 0L;
   return(exphash->exp);
  }
Exemplo n.º 2
0
globle struct constraintRecord *GetConstraintRecord(
  void *theEnv)
  {
   CONSTRAINT_RECORD *constraints;
   unsigned i;

   constraints = get_struct(theEnv,constraintRecord);

   for (i = 0 ; i < sizeof(CONSTRAINT_RECORD) ; i++)
     { ((char *) constraints)[i] = '\0'; }

   SetAnyAllowedFlags(constraints,TRUE);

   constraints->multifieldsAllowed = FALSE;
   constraints->singlefieldsAllowed = TRUE;

   constraints->anyRestriction = FALSE;
   constraints->symbolRestriction = FALSE;
   constraints->stringRestriction = FALSE;
   constraints->floatRestriction = FALSE;
   constraints->integerRestriction = FALSE;
   constraints->classRestriction = FALSE;
   constraints->instanceNameRestriction = FALSE;
   constraints->classList = NULL;
   constraints->restrictionList = NULL;
   constraints->minValue = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->NegativeInfinity);
   constraints->maxValue = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity);
   constraints->minFields = GenConstant(theEnv,INTEGER,SymbolData(theEnv)->Zero);
   constraints->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity);
   constraints->bucket = -1;
   constraints->count = 0;
   constraints->multifield = NULL;
   constraints->next = NULL;

   return(constraints);
  }
Exemplo n.º 3
0
static int ParseExportSpec(
  void *theEnv,
  char *readSource,
  struct token *theToken,
  struct defmodule *newModule,
  struct defmodule *importModule)
  {
   struct portItem *newPort;
   SYMBOL_HN *theConstruct, *moduleName;
   struct portConstructItem *thePortConstruct;
   char *errorMessage;

   /*===========================================*/
   /* Set up some variables for error messages. */
   /*===========================================*/

   if (importModule != NULL)
     {
      errorMessage = "defmodule import specification";
      moduleName = importModule->name;
     }
   else
     {
      errorMessage = "defmodule export specification";
      moduleName = NULL;
     }

   /*=============================================*/
   /* Handle the special variables ?ALL and ?NONE */
   /* in the import/export specification.         */
   /*=============================================*/

   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,theToken);

   if (theToken->type == SF_VARIABLE)
     {
      /*==============================*/
      /* Check to see if the variable */
      /* is either ?ALL or ?NONE.     */
      /*==============================*/

      if (strcmp(ValueToString(theToken->value),"ALL") == 0)
        {
         newPort = (struct portItem *) get_struct(theEnv,portItem);
         newPort->moduleName = moduleName;
         newPort->constructType = NULL;
         newPort->constructName = NULL;
         newPort->next = NULL;
        }
      else if (strcmp(ValueToString(theToken->value),"NONE") == 0)
        { newPort = NULL; }
      else
        {
         SyntaxErrorMessage(theEnv,errorMessage);
         return(TRUE);
        }

      /*=======================================================*/
      /* The export/import specification must end with a right */
      /* parenthesis after ?ALL or ?NONE at this point.        */
      /*=======================================================*/

      GetToken(theEnv,readSource,theToken);

      if (theToken->type != RPAREN)
        {
         if (newPort != NULL) rtn_struct(theEnv,portItem,newPort);
         PPBackup(theEnv);
         SavePPBuffer(theEnv," ");
         SavePPBuffer(theEnv,theToken->printForm);
         SyntaxErrorMessage(theEnv,errorMessage);
         return(TRUE);
        }

      /*=====================================*/
      /* Add the new specification to either */
      /* the import or export list.          */
      /*=====================================*/

      if (newPort != NULL)
        {
         if (importModule != NULL)
           {
            newPort->next = newModule->importList;
            newModule->importList = newPort;
           }
         else
           {
            newPort->next = newModule->exportList;
            newModule->exportList = newPort;
           }
        }

      /*============================================*/
      /* Return FALSE to indicate the import/export */
      /* specification was successfully parsed.     */
      /*============================================*/

      return(FALSE);
     }

   /*========================================================*/
   /* If the ?ALL and ?NONE keywords were not used, then the */
   /* token must be the name of an importable construct.     */
   /*========================================================*/

   if (theToken->type != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,errorMessage);
      return(TRUE);
     }

   theConstruct = (SYMBOL_HN *) theToken->value;

   if ((thePortConstruct = ValidPortConstructItem(theEnv,ValueToString(theConstruct))) == NULL)
     {
      SyntaxErrorMessage(theEnv,errorMessage);
      return(TRUE);
     }

   /*=============================================================*/
   /* If the next token is the special variable ?ALL, then all    */
   /* constructs of the specified type are imported/exported. If  */
   /* the next token is the special variable ?NONE, then no       */
   /* constructs of the specified type will be imported/exported. */
   /*=============================================================*/

   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,theToken);

   if (theToken->type == SF_VARIABLE)
     {
      /*==============================*/
      /* Check to see if the variable */
      /* is either ?ALL or ?NONE.     */
      /*==============================*/

      if (strcmp(ValueToString(theToken->value),"ALL") == 0)
        {
         newPort = (struct portItem *) get_struct(theEnv,portItem);
         newPort->moduleName = moduleName;
         newPort->constructType = theConstruct;
         newPort->constructName = NULL;
         newPort->next = NULL;
        }
      else if (strcmp(ValueToString(theToken->value),"NONE") == 0)
        { newPort = NULL; }
      else
        {
         SyntaxErrorMessage(theEnv,errorMessage);
         return(TRUE);
        }

      /*=======================================================*/
      /* The export/import specification must end with a right */
      /* parenthesis after ?ALL or ?NONE at this point.        */
      /*=======================================================*/

      GetToken(theEnv,readSource,theToken);

      if (theToken->type != RPAREN)
        {
         if (newPort != NULL) rtn_struct(theEnv,portItem,newPort);
         PPBackup(theEnv);
         SavePPBuffer(theEnv," ");
         SavePPBuffer(theEnv,theToken->printForm);
         SyntaxErrorMessage(theEnv,errorMessage);
         return(TRUE);
        }

      /*=====================================*/
      /* Add the new specification to either */
      /* the import or export list.          */
      /*=====================================*/

      if (newPort != NULL)
        {
         if (importModule != NULL)
           {
            newPort->next = newModule->importList;
            newModule->importList = newPort;
           }
         else
           {
            newPort->next = newModule->exportList;
            newModule->exportList = newPort;
           }
        }

      /*============================================*/
      /* Return FALSE to indicate the import/export */
      /* specification was successfully parsed.     */
      /*============================================*/

      return(FALSE);
     }

   /*============================================*/
   /* There must be at least one named construct */
   /* in the import/export list at this point.   */
   /*============================================*/

   if (theToken->type == RPAREN)
     {
      SyntaxErrorMessage(theEnv,errorMessage);
      return(TRUE);
     }

   /*=====================================*/
   /* Read in the list of imported items. */
   /*=====================================*/

   while (theToken->type != RPAREN)
     {
      if (theToken->type != thePortConstruct->typeExpected)
        {
         SyntaxErrorMessage(theEnv,errorMessage);
         return(TRUE);
        }

      /*========================================*/
      /* Create the data structure to represent */
      /* the import/export specification for    */
      /* the named construct.                   */
      /*========================================*/

      newPort = (struct portItem *) get_struct(theEnv,portItem);
      newPort->moduleName = moduleName;
      newPort->constructType = theConstruct;
      newPort->constructName = (SYMBOL_HN *) theToken->value;

      /*=====================================*/
      /* Add the new specification to either */
      /* the import or export list.          */
      /*=====================================*/

      if (importModule != NULL)
        {
         newPort->next = newModule->importList;
         newModule->importList = newPort;
        }
      else
        {
         newPort->next = newModule->exportList;
         newModule->exportList = newPort;
        }

      /*===================================*/
      /* Move on to the next import/export */
      /* specification.                    */
      /*===================================*/

      SavePPBuffer(theEnv," ");
      GetToken(theEnv,readSource,theToken);
     }

   /*=============================*/
   /* Fix up pretty print buffer. */
   /*=============================*/

   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,")");

   /*============================================*/
   /* Return FALSE to indicate the import/export */
   /* specification was successfully parsed.     */
   /*============================================*/

   return(FALSE);
  }
Exemplo n.º 4
0
globle void AddActivation(
    void *theEnv,
    void *vTheRule,
    void *vBinds)
{
    struct activation *newActivation;
    struct defrule *theRule = (struct defrule *) vTheRule;
    struct partialMatch *binds = (struct partialMatch *) vBinds;
    struct defruleModule *theModuleItem;
    struct salienceGroup *theGroup;

    /*=======================================*/
    /* Focus on the module if the activation */
    /* is from an auto-focus rule.           */
    /*=======================================*/

    if (theRule->autoFocus)
    {
        EnvFocus(theEnv,(void *) theRule->header.whichModule->theModule);
    }

    /*=======================================================*/
    /* Create the activation. The activation stores pointers */
    /* to its associated partial match and defrule. The      */
    /* activation is given a time tag, its salience is       */
    /* evaluated, and it is assigned a random number for use */
    /* with the random conflict resolution strategy.         */
    /*=======================================================*/

    newActivation = get_struct(theEnv,activation);
    newActivation->theRule = theRule;
    newActivation->basis = binds;
    newActivation->timetag = AgendaData(theEnv)->CurrentTimetag++;
    newActivation->salience = EvaluateSalience(theEnv,theRule);

    newActivation->randomID = genrand();
    newActivation->prev = NULL;
    newActivation->next = NULL;

    AgendaData(theEnv)->NumberOfActivations++;

    /*=======================================================*/
    /* Point the partial match to the activation to complete */
    /* the link between the join network and the agenda.     */
    /*=======================================================*/

    binds->marker = (void *) newActivation;

    /*====================================================*/
    /* If activations are being watch, display a message. */
    /*====================================================*/

#if DEBUGGING_FUNCTIONS
    if (newActivation->theRule->watchActivation)
    {
        EnvPrintRouter(theEnv,WTRACE,(char*)"==> Activation ");
        PrintActivation(theEnv,WTRACE,(void *) newActivation);
        EnvPrintRouter(theEnv,WTRACE,(char*)"\n");
    }
#endif

    /*=====================================*/
    /* Place the activation on the agenda. */
    /*=====================================*/

    theModuleItem = (struct defruleModule *) theRule->header.whichModule;

    theGroup = ReuseOrCreateSalienceGroup(theEnv,theModuleItem,newActivation->salience);

    PlaceActivation(theEnv,&(theModuleItem->agenda),newActivation,theGroup);
}
Exemplo n.º 5
0
static void *AllocateModule(
  void *theEnv)
  {   
   return((void *) get_struct(theEnv,defglobalModule)); 
  }
Exemplo n.º 6
0
    void write_header( const View& view )
    {
        using png_rw_info_t = detail::png_write_support
            <
                typename channel_type<typename get_pixel_type<View>::type>::type,
                typename color_space_type<View>::type
            >;

        // Set the image information here.  Width and height are up to 2^31,
        // bit_depth is one of 1, 2, 4, 8, or 16, but valid values also depend on
        // the color_type selected. color_type is one of PNG_COLOR_TYPE_GRAY,
        // PNG_COLOR_TYPE_GRAY_ALPHA, PNG_COLOR_TYPE_PALETTE, PNG_COLOR_TYPE_RGB,
        // or PNG_COLOR_TYPE_RGB_ALPHA.  interlace is either PNG_INTERLACE_NONE or
        // PNG_INTERLACE_ADAM7, and the compression_type and filter_type MUST
        // currently be PNG_COMPRESSION_TYPE_BASE and PNG_FILTER_TYPE_BASE. REQUIRED
        png_set_IHDR( get_struct()
                    , get_info()
                    , static_cast< png_image_width::type  >( view.width()  )
                    , static_cast< png_image_height::type >( view.height() )
                    , static_cast< png_bitdepth::type     >( png_rw_info_t::_bit_depth )
                    , static_cast< png_color_type::type   >( png_rw_info_t::_color_type )
                    , _info._interlace_method
                    , _info._compression_type
                    , _info._filter_method
                    );

#ifdef BOOST_GIL_IO_PNG_FLOATING_POINT_SUPPORTED
        if( _info._valid_cie_colors )
        {
            png_set_cHRM( get_struct()
                        , get_info()
                        , _info._white_x
                        , _info._white_y
                        , _info._red_x
                        , _info._red_y
                        , _info._green_x
                        , _info._green_y
                        , _info._blue_x
                        , _info._blue_y
                        );
        }

        if( _info._valid_file_gamma )
        {
            png_set_gAMA( get_struct()
                        , get_info()
                        , _info._file_gamma
                        );
        }
#else
        if( _info._valid_cie_colors )
        {
            png_set_cHRM_fixed( get_struct()
                              , get_info()
                              , _info._white_x
                              , _info._white_y
                              , _info._red_x
                              , _info._red_y
                              , _info._green_x
                              , _info._green_y
                              , _info._blue_x
                              , _info._blue_y
                              );
        }

        if( _info._valid_file_gamma )
        {
            png_set_gAMA_fixed( get_struct()
                              , get_info()
                              , _info._file_gamma
                              );
        }
#endif // BOOST_GIL_IO_PNG_FLOATING_POINT_SUPPORTED

        if( _info._valid_icc_profile )
        {
#if PNG_LIBPNG_VER_MINOR >= 5
            png_set_iCCP( get_struct()
                        , get_info()
                        , const_cast< png_charp >( _info._icc_name.c_str() )
                        , _info._iccp_compression_type
                        , reinterpret_cast< png_const_bytep >( & (_info._profile.front ()) )
                        , _info._profile_length
                        );
#else
            png_set_iCCP( get_struct()
                        , get_info()
                        , const_cast< png_charp >( _info._icc_name.c_str() )
                        , _info._iccp_compression_type
                        , const_cast< png_charp >( & (_info._profile.front()) )
                        , _info._profile_length
                        );
#endif
        }

        if( _info._valid_intent )
        {
            png_set_sRGB( get_struct()
                        , get_info()
                        , _info._intent
                        );
        }

        if( _info._valid_palette )
        {
            png_set_PLTE( get_struct()
                        , get_info()
                        , const_cast< png_colorp >( &_info._palette.front() )
                        , _info._num_palette
                        );
        }

        if( _info._valid_background )
        {
            png_set_bKGD( get_struct()
                        , get_info()
                        , const_cast< png_color_16p >( &_info._background )
                        );
        }

        if( _info._valid_histogram )
        {
            png_set_hIST( get_struct()
                        , get_info()
                        , const_cast< png_uint_16p >( &_info._histogram.front() )
                        );
        }

        if( _info._valid_offset )
        {
            png_set_oFFs( get_struct()
                        , get_info()
                        , _info._offset_x
                        , _info._offset_y
                        , _info._off_unit_type
                        );
        }

        if( _info._valid_pixel_calibration )
        {
            std::vector< const char* > params( _info._num_params );
            for( std::size_t i = 0; i < params.size(); ++i )
            {
                params[i] = _info._params[ i ].c_str();
            }

            png_set_pCAL( get_struct()
                        , get_info()
                        , const_cast< png_charp >( _info._purpose.c_str() )
                        , _info._X0
                        , _info._X1
                        , _info._cal_type
                        , _info._num_params
                        , const_cast< png_charp  >( _info._units.c_str() )
                        , const_cast< png_charpp >( &params.front()     )
                        );
        }

        if( _info._valid_resolution )
        {
            png_set_pHYs( get_struct()
                        , get_info()
                        , _info._res_x
                        , _info._res_y
                        , _info._phy_unit_type
                        );
        }

        if( _info._valid_significant_bits )
        {
            png_set_sBIT( get_struct()
                        , get_info()
                        , const_cast< png_color_8p >( &_info._sig_bits )
                        );
        }

#ifndef BOOST_GIL_IO_PNG_1_4_OR_LOWER

#ifdef BOOST_GIL_IO_PNG_FLOATING_POINT_SUPPORTED
        if( _info._valid_scale_factors )
        {
            png_set_sCAL( get_struct()
                        , get_info()
                        , this->_info._scale_unit
                        , this->_info._scale_width
                        , this->_info._scale_height
                        );
        }
#else
#ifdef BOOST_GIL_IO_PNG_FIXED_POINT_SUPPORTED
        if( _info._valid_scale_factors )
        {
            png_set_sCAL_fixed( get_struct()
                              , get_info()
                              , this->_info._scale_unit
                              , this->_info._scale_width
                              , this->_info._scale_height
                              );
        }
#else
        if( _info._valid_scale_factors )
        {
            png_set_sCAL_s( get_struct()
                          , get_info()
                          , this->_info._scale_unit
                          , const_cast< png_charp >( this->_info._scale_width.c_str()  )
                          , const_cast< png_charp >( this->_info._scale_height.c_str() )
                          );
        }

#endif // BOOST_GIL_IO_PNG_FIXED_POINT_SUPPORTED
#endif // BOOST_GIL_IO_PNG_FLOATING_POINT_SUPPORTED
#endif // BOOST_GIL_IO_PNG_1_4_OR_LOWER

        if( _info._valid_text )
        {
            std::vector< png_text > texts( _info._num_text );
            for( std::size_t i = 0; i < texts.size(); ++i )
            {
                png_text pt;
                pt.compression = _info._text[i]._compression;
                pt.key         = const_cast< png_charp >( this->_info._text[i]._key.c_str()  );
                pt.text        = const_cast< png_charp >( this->_info._text[i]._text.c_str() );
                pt.text_length = _info._text[i]._text.length();

                texts[i] = pt;
            }

            png_set_text( get_struct()
                        , get_info()
                        , &texts.front()
                        , _info._num_text
                        );
        }

        if( _info._valid_modification_time )
        {
            png_set_tIME( get_struct()
                        , get_info()
                        , const_cast< png_timep >( &_info._mod_time )
                        );
        }

        if( _info._valid_transparency_factors )
        {
            int sample_max = ( 1u << _info._bit_depth );

            /* libpng doesn't reject a tRNS chunk with out-of-range samples */
            if( !(  (  _info._color_type == PNG_COLOR_TYPE_GRAY
                    && (int) _info._trans_values[0].gray > sample_max
                    )
                 || (  _info._color_type == PNG_COLOR_TYPE_RGB
                    &&(  (int) _info._trans_values[0].red   > sample_max
                      || (int) _info._trans_values[0].green > sample_max
                      || (int) _info._trans_values[0].blue  > sample_max
                      )
                    )
                 )
              )
            {
                //@todo Fix that once reading transparency values works
/*
                png_set_tRNS( get_struct()
                            , get_info()
                            , trans
                            , num_trans
                            , trans_values
                            );
*/
            }
        }

        // Compression Levels - valid values are [0,9]
        png_set_compression_level( get_struct()
                                 , _info._compression_level
                                 );

        png_set_compression_mem_level( get_struct()
                                     , _info._compression_mem_level
                                     );

        png_set_compression_strategy( get_struct()
                                    , _info._compression_strategy
                                    );

        png_set_compression_window_bits( get_struct()
                                       , _info._compression_window_bits
                                       );

        png_set_compression_method( get_struct()
                                  , _info._compression_method
                                  );

        png_set_compression_buffer_size( get_struct()
                                       , _info._compression_buffer_size
                                       );

#ifdef BOOST_GIL_IO_PNG_DITHERING_SUPPORTED
        // Dithering
        if( _info._set_dithering )
        {
            png_set_dither( get_struct()
                          , &_info._dithering_palette.front()
                          , _info._dithering_num_palette
                          , _info._dithering_maximum_colors
                          , &_info._dithering_histogram.front()
                          , _info._full_dither
                          );
        }
#endif // BOOST_GIL_IO_PNG_DITHERING_SUPPORTED

        // Filter
        if( _info._set_filter )
        {
            png_set_filter( get_struct()
                          , 0
                          , _info._filter
                          );
        }

        // Invert Mono
        if( _info._invert_mono )
        {
            png_set_invert_mono( get_struct() );
        }

        // True Bits
        if( _info._set_true_bits )
        {
            png_set_sBIT( get_struct()
                        , get_info()
                        , &_info._true_bits.front()
                        );
        }

        // sRGB Intent
        if( _info._set_srgb_intent )
        {
            png_set_sRGB( get_struct()
                        , get_info()
                        , _info._srgb_intent
                        );
        }

        // Strip Alpha
        if( _info._strip_alpha )
        {
            png_set_strip_alpha( get_struct() );
        }

        // Swap Alpha
        if( _info._swap_alpha )
        {
            png_set_swap_alpha( get_struct() );
        }


        png_write_info( get_struct()
                      , get_info()
                      );
    }
Exemplo n.º 7
0
globle void CreateMainModule(
  void *theEnv)
  {
   struct defmodule *newDefmodule;
   struct moduleItem *theItem;
   int i;
   struct defmoduleItemHeader *theHeader;

   /*=======================================*/
   /* Allocate the defmodule data structure */
   /* and name it the MAIN module.          */
   /*=======================================*/

   newDefmodule = get_struct(theEnv,defmodule);
   newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN");
   IncrementSymbolCount(newDefmodule->name);
   newDefmodule->next = NULL;
   newDefmodule->ppForm = NULL;
   newDefmodule->importList = NULL;
   newDefmodule->exportList = NULL;
   newDefmodule->bsaveID = 0L;
   newDefmodule->usrData = NULL;

   /*==================================*/
   /* Initialize the array for storing */
   /* the module's construct lists.    */
   /*==================================*/

   if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
   else
     {
      newDefmodule->itemsArray = (struct defmoduleItemHeader **)
                                 gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
           i++, theItem = theItem->next)
        {
         if (theItem->allocateFunction == NULL)
           { newDefmodule->itemsArray[i] = NULL; }
         else
           {
            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
                                          (*theItem->allocateFunction)(theEnv);
            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
            theHeader->theModule = newDefmodule;
            theHeader->firstItem = NULL;
            theHeader->lastItem = NULL;
           }
        }
     }

   /*=======================================*/
   /* Add the module to the list of modules */
   /* and make it the current module.       */
   /*=======================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
   SetNumberOfDefmodules(theEnv,1L);
#endif

   DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
   DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
   EnvSetCurrentModule(theEnv,(void *) newDefmodule);
  }
Exemplo n.º 8
0
/*****************************************************
  NAME         : AllocateModule
  DESCRIPTION  : Creates and initializes a
                 list of deffunctions for a new module
  INPUTS       : None
  RETURNS      : The new deffunction module
  SIDE EFFECTS : Deffunction module created
  NOTES        : None
 *****************************************************/
static void *AllocateModule(
  void *theEnv)
  {
   return((void *) get_struct(theEnv,deffunctionModule));
  }
Exemplo n.º 9
0
bool ParseDeffacts(
  Environment *theEnv,
  const char *readSource)
  {
#if (! RUN_TIME) && (! BLOAD_ONLY)
   CLIPSLexeme *deffactsName;
   struct expr *temp;
   Deffacts *newDeffacts;
   bool deffactsError;
   struct token inputToken;

   /*=========================*/
   /* Parsing initialization. */
   /*=========================*/

   deffactsError = false;
   SetPPBufferStatus(theEnv,true);

   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(deffacts ");

   /*==========================================================*/
   /* Deffacts can not be added when a binary image is loaded. */
   /*==========================================================*/

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == true) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"deffacts");
      return true;
     }
#endif

   /*============================*/
   /* Parse the deffacts header. */
   /*============================*/

   deffactsName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deffacts",
                                             (FindConstructFunction *) FindDeffactsInModule,
                                             (DeleteConstructFunction *) Undeffacts,"$",true,
                                             true,true,false);
   if (deffactsName == NULL) { return true; }

   /*===============================================*/
   /* Parse the list of facts in the deffacts body. */
   /*===============================================*/

   temp = BuildRHSAssert(theEnv,readSource,&inputToken,&deffactsError,false,false,"deffacts");

   if (deffactsError == true) { return true; }

   if (ExpressionContainsVariables(temp,false))
     {
      LocalVariableErrorMessage(theEnv,"a deffacts construct");
      ReturnExpression(theEnv,temp);
      return true;
     }

   SavePPBuffer(theEnv,"\n");

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed deffacts to the KB.      */
   /*==============================================*/

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      ReturnExpression(theEnv,temp);
      return false;
     }

   /*==========================*/
   /* Create the new deffacts. */
   /*==========================*/

   ExpressionInstall(theEnv,temp);
   newDeffacts = get_struct(theEnv,deffacts);
   IncrementLexemeCount(deffactsName);
   InitializeConstructHeader(theEnv,"deffacts",DEFFACTS,&newDeffacts->header,deffactsName);

   newDeffacts->assertList = PackExpression(theEnv,temp);
   ReturnExpression(theEnv,temp);

   /*=======================================================*/
   /* Save the pretty print representation of the deffacts. */
   /*=======================================================*/

   if (GetConserveMemory(theEnv) == true)
     { newDeffacts->header.ppForm = NULL; }
   else
     { newDeffacts->header.ppForm = CopyPPBuffer(theEnv); }

   /*=============================================*/
   /* Add the deffacts to the appropriate module. */
   /*=============================================*/

   AddConstructToModule(&newDeffacts->header);

#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */

   /*================================================================*/
   /* Return false to indicate the deffacts was successfully parsed. */
   /*================================================================*/

   return false;
  }
Exemplo n.º 10
0
globle int ParseDeftemplate(
  void *theEnv,
  char *readSource)
  {
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
   SYMBOL_HN *deftemplateName;
   struct deftemplate *newDeftemplate;
   struct templateSlot *slots;
   struct token inputToken;

   /*================================================*/
   /* Initialize pretty print and error information. */
   /*================================================*/

   DeftemplateData(theEnv)->DeftemplateError = FALSE;
   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SavePPBuffer(theEnv,"(deftemplate ");

   /*==============================================================*/
   /* Deftemplates can not be added when a binary image is loaded. */
   /*==============================================================*/

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"deftemplate");
      return(TRUE);
     }
#endif

   /*=======================================================*/
   /* Parse the name and comment fields of the deftemplate. */
   /*=======================================================*/

#if DEBUGGING_FUNCTIONS
   DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0;
#endif

   deftemplateName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deftemplate",
                                                EnvFindDeftemplate,EnvUndeftemplate,"%",
                                                TRUE,TRUE,DEFMODULE_CONSTRUCT);
   if (deftemplateName == NULL) return(TRUE);

   if (ReservedPatternSymbol(theEnv,ValueToString(deftemplateName),"deftemplate"))
     {
      ReservedPatternSymbolErrorMsg(theEnv,ValueToString(deftemplateName),"a deftemplate name");
      return(TRUE);
     }

   /*===========================================*/
   /* Parse the slot fields of the deftemplate. */
   /*===========================================*/

   slots = SlotDeclarations(theEnv,readSource,&inputToken);
   if (DeftemplateData(theEnv)->DeftemplateError == TRUE) return(TRUE);

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed deftemplate to the KB.   */
   /*==============================================*/

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      ReturnSlots(theEnv,slots);
      return(FALSE);
     }

   /*=====================================*/
   /* Create a new deftemplate structure. */
   /*=====================================*/

   newDeftemplate = get_struct(theEnv,deftemplate);
   newDeftemplate->header.name =  deftemplateName;
   newDeftemplate->header.next = NULL;
   newDeftemplate->header.usrData = NULL;
   newDeftemplate->slotList = slots;
   newDeftemplate->implied = FALSE;
   newDeftemplate->numberOfSlots = 0;
   newDeftemplate->busyCount = 0;
   newDeftemplate->watch = 0;
   newDeftemplate->inScope = TRUE;
   newDeftemplate->patternNetwork = NULL;
   newDeftemplate->factList = NULL;
   newDeftemplate->lastFact = NULL;
   newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
                                        GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex);

   /*================================*/
   /* Determine the number of slots. */
   /*================================*/

   while (slots != NULL)
     {
      newDeftemplate->numberOfSlots++;
      slots = slots->next;
     }

   /*====================================*/
   /* Store pretty print representation. */
   /*====================================*/

   if (EnvGetConserveMemory(theEnv) == TRUE)
     { newDeftemplate->header.ppForm = NULL; }
   else
     { newDeftemplate->header.ppForm = CopyPPBuffer(theEnv); }

   /*=======================================================================*/
   /* If a template is redefined, then we want to restore its watch status. */
   /*=======================================================================*/

#if DEBUGGING_FUNCTIONS
   if ((BitwiseTest(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0)) || EnvGetWatchItem(theEnv,"facts"))
     { EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); }
#endif

   /*==============================================*/
   /* Add deftemplate to the list of deftemplates. */
   /*==============================================*/

   AddConstructToModule(&newDeftemplate->header);

   InstallDeftemplate(theEnv,newDeftemplate);

#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif

   return(FALSE);
  }
Exemplo n.º 11
0
static struct templateSlot *DefinedSlots(
  void *theEnv,
  char *readSource,
  SYMBOL_HN *slotName,
  int multifieldSlot,
  struct token *inputToken)
  {
   struct templateSlot *newSlot;
   struct expr *defaultList;
   int defaultFound = FALSE;
   int noneSpecified, deriveSpecified;
   CONSTRAINT_PARSE_RECORD parsedConstraints;

   /*===========================*/
   /* Build the slot container. */
   /*===========================*/

   newSlot = get_struct(theEnv,templateSlot);
   newSlot->slotName = slotName;
   newSlot->defaultList = NULL;
   newSlot->constraints = GetConstraintRecord(theEnv);
   if (multifieldSlot)
     { newSlot->constraints->multifieldsAllowed = TRUE; }
   newSlot->multislot = multifieldSlot;
   newSlot->noDefault = FALSE;
   newSlot->defaultPresent = FALSE;
   newSlot->defaultDynamic = FALSE;
   newSlot->next = NULL;

   /*========================================*/
   /* Parse the primitive slot if it exists. */
   /*========================================*/

   InitializeConstraintParseRecord(&parsedConstraints);
   GetToken(theEnv,readSource,inputToken);

   while (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,inputToken->printForm);

      /*================================================*/
      /* Slot attributes begin with a left parenthesis. */
      /*================================================*/

      if (inputToken->type != LPAREN)
        {
         SyntaxErrorMessage(theEnv,"deftemplate");
         ReturnSlots(theEnv,newSlot);
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      /*=============================================*/
      /* The name of the attribute must be a symbol. */
      /*=============================================*/

      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != SYMBOL)
        {
         SyntaxErrorMessage(theEnv,"deftemplate");
         ReturnSlots(theEnv,newSlot);
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      /*================================================================*/
      /* Determine if the attribute is one of the standard constraints. */
      /*================================================================*/

      if (StandardConstraint(ValueToString(inputToken->value)))
        {
         if (ParseStandardConstraint(theEnv,readSource,(ValueToString(inputToken->value)),
                                     newSlot->constraints,&parsedConstraints,
                                     multifieldSlot) == FALSE)
           {
            DeftemplateData(theEnv)->DeftemplateError = TRUE;
            ReturnSlots(theEnv,newSlot);
            return(NULL);
           }
        }

      /*=================================================*/
      /* else if the attribute is the default attribute, */
      /* then get the default list for this slot.        */
      /*=================================================*/

      else if ((strcmp(ValueToString(inputToken->value),"default") == 0) ||
               (strcmp(ValueToString(inputToken->value),"default-dynamic") == 0))
        {
         /*======================================================*/
         /* Check to see if the default has already been parsed. */
         /*======================================================*/

         if (defaultFound)
           {
            AlreadyParsedErrorMessage(theEnv,"default attribute",NULL);
            DeftemplateData(theEnv)->DeftemplateError = TRUE;
            ReturnSlots(theEnv,newSlot);
            return(NULL);
           }

         newSlot->noDefault = FALSE;

         /*=====================================================*/
         /* Determine whether the default is dynamic or static. */
         /*=====================================================*/

         if (strcmp(ValueToString(inputToken->value),"default") == 0)
           {
            newSlot->defaultPresent = TRUE;
            newSlot->defaultDynamic = FALSE;
           }
         else
           {
            newSlot->defaultPresent = FALSE;
            newSlot->defaultDynamic = TRUE;
           }

         /*===================================*/
         /* Parse the list of default values. */
         /*===================================*/

         defaultList = ParseDefault(theEnv,readSource,multifieldSlot,(int) newSlot->defaultDynamic,
                                  TRUE,&noneSpecified,&deriveSpecified,&DeftemplateData(theEnv)->DeftemplateError);
         if (DeftemplateData(theEnv)->DeftemplateError == TRUE)
           {
            ReturnSlots(theEnv,newSlot);
            return(NULL);
           }

         /*==================================*/
         /* Store the default with the slot. */
         /*==================================*/

         defaultFound = TRUE;
         if (deriveSpecified) newSlot->defaultPresent = FALSE;
         else if (noneSpecified)
           {
            newSlot->noDefault = TRUE;
            newSlot->defaultPresent = FALSE;
           }
         newSlot->defaultList = defaultList;
        }

      /*============================================*/
      /* Otherwise the attribute is an invalid one. */
      /*============================================*/

      else
        {
         SyntaxErrorMessage(theEnv,"slot attributes");
         ReturnSlots(theEnv,newSlot);
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      /*===================================*/
      /* Begin parsing the next attribute. */
      /*===================================*/

      GetToken(theEnv,readSource,inputToken);
     }

   /*============================*/
   /* Return the attribute list. */
   /*============================*/

   return(newSlot);
  }
Exemplo n.º 12
0
bool AddLogicalDependencies(
  Environment *theEnv,
  struct patternEntity *theEntity,
  bool existingEntity)
  {
   struct partialMatch *theBinds;
   struct dependency *newDependency;

   /*==============================================*/
   /* If the rule has no logical patterns, then no */
   /* dependencies have to be established.         */
   /*==============================================*/

   if (EngineData(theEnv)->TheLogicalJoin == NULL)
     {
      if (existingEntity) RemoveEntityDependencies(theEnv,theEntity);
      return true;
     }
   else if (existingEntity && (theEntity->dependents == NULL))
     { return true; }

   /*===========================================================*/
   /* Retrieve the partial match in the logical join associated */
   /* with activation partial match (retrieved when the run     */
   /* command was initiated). If the partial match's parent     */
   /* links have been removed, then the partial match must have */
   /* been deleted by a previous RHS action and the dependency  */
   /* link should not be added.                                 */
   /*===========================================================*/

   theBinds = EngineData(theEnv)->TheLogicalBind;
   if (theBinds == NULL) return false;
   if ((theBinds->leftParent == NULL) && (theBinds->rightParent == NULL))
     { return false; }

   /*==============================================================*/
   /* Add a dependency link between the partial match and the data */
   /* entity. The dependency links are stored in the partial match */
   /* behind the data entities stored in the partial match and the */
   /* activation link, if any.                                     */
   /*==============================================================*/

   newDependency = get_struct(theEnv,dependency);
   newDependency->dPtr = theEntity;
   newDependency->next = (struct dependency *) theBinds->dependents;
   theBinds->dependents = newDependency;

   /*================================================================*/
   /* Add a dependency link between the entity and the partialMatch. */
   /*================================================================*/

   newDependency = get_struct(theEnv,dependency);
   newDependency->dPtr = theBinds;
   newDependency->next = (struct dependency *) theEntity->dependents;
   theEntity->dependents = newDependency;

   /*==================================================================*/
   /* Return true to indicate that the data entity should be asserted. */
   /*==================================================================*/

   return true;
  }
Exemplo n.º 13
0
globle int ParseDeffacts(
  char *readSource)
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
   SYMBOL_HN *deffactsName;
   struct expr *temp;
   struct deffacts *newDeffacts;
   int deffactsError;
   struct token inputToken;

   /*=========================*/
   /* Parsing initialization. */
   /*=========================*/

   deffactsError = FALSE;
   SetPPBufferStatus(ON);

   FlushPPBuffer();
   SetIndentDepth(3);
   SavePPBuffer("(deffacts ");

   /*==========================================================*/
   /* Deffacts can not be added when a binary image is loaded. */
   /*==========================================================*/

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded() == TRUE) && (! CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage("deffacts");
      return(TRUE);
     }
#endif

   /*============================*/
   /* Parse the deffacts header. */
   /*============================*/

   deffactsName = GetConstructNameAndComment(readSource,&inputToken,"deffacts",
                                             FindDeffacts,Undeffacts,"$",TRUE,
                                             TRUE,TRUE);
   if (deffactsName == NULL) { return(TRUE); }

   /*===============================================*/
   /* Parse the list of facts in the deffacts body. */
   /*===============================================*/

   temp = BuildRHSAssert(readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts");

   if (deffactsError == TRUE) { return(TRUE); }

   if (ExpressionContainsVariables(temp,FALSE))
     {
      LocalVariableErrorMessage("a deffacts construct");
      ReturnExpression(temp);
      return(TRUE);
     }

   SavePPBuffer("\n");

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed deffacts to the KB.      */
   /*==============================================*/

   if (CheckSyntaxMode)
     {
      ReturnExpression(temp);
      return(FALSE);
     }

   /*==========================*/
   /* Create the new deffacts. */
   /*==========================*/

   ExpressionInstall(temp);
   newDeffacts = get_struct(deffacts);
   newDeffacts->header.name = deffactsName;
   IncrementSymbolCount(deffactsName);
   newDeffacts->assertList = PackExpression(temp);
   newDeffacts->header.whichModule = (struct defmoduleItemHeader *)
                              GetModuleItem(NULL,FindModuleItem("deffacts")->moduleIndex);

   newDeffacts->header.next = NULL;
   newDeffacts->header.usrData = NULL;
   ReturnExpression(temp);

   /*=======================================================*/
   /* Save the pretty print representation of the deffacts. */
   /*=======================================================*/

   if (GetConserveMemory() == TRUE)
     { newDeffacts->header.ppForm = NULL; }
   else
     { newDeffacts->header.ppForm = CopyPPBuffer(); }

   /*=============================================*/
   /* Add the deffacts to the appropriate module. */
   /*=============================================*/

   AddConstructToModule(&newDeffacts->header);

#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */

   /*================================================================*/
   /* Return FALSE to indicate the deffacts was successfully parsed. */
   /*================================================================*/

   return(FALSE);
  }
Exemplo n.º 14
0
/***************************************************
  NAME         : ObjectsRunTimeInitialize
  DESCRIPTION  : Initializes objects system lists
                   in a run-time module
  INPUTS       : 1) Pointer to new class hash table
                 2) Pointer to new slot name table
  RETURNS      : Nothing useful
  SIDE EFFECTS : Global pointers set
  NOTES        : None
 ***************************************************/
globle void ObjectsRunTimeInitialize(
    void *theEnv,
    DEFCLASS *ctable[],
    SLOT_NAME *sntable[],
    DEFCLASS **cidmap,
    unsigned mid)
{
    DEFCLASS *cls;
    void *tmpexp;
    register unsigned int i,j;

    if (DefclassData(theEnv)->ClassTable != NULL)
    {
        for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
            for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
            {
                for (i = 0 ; i < cls->slotCount ; i++)
                {
                    /* =====================================================================
                       For static default values, the data object value needs to deinstalled
                       and deallocated, and the expression needs to be restored (which was
                       temporarily stored in the supplementalInfo field of the data object)
                       ===================================================================== */
                    if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                    {
                        tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
                        ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
                        rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
                        cls->slots[i].defaultValue = tmpexp;
                    }
                }
            }
    }

    InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
    MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
    MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
    MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
    DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
    DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
#if DEFRULE_CONSTRUCT
    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
#endif

    DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
    DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
    DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
    DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
    DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
        LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
        LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[STRING] =
        LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
        LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
        LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
        LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);

    for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
        for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
        {
            for (i = 0 ; i < cls->slotCount ; i++)
            {
                if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                {
                    tmpexp = cls->slots[i].defaultValue;
                    cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
                    EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
                                                 (DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
                    ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
                    ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
                }
            }
        }

    SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
}
Exemplo n.º 15
0
/*****************************************************
  NAME         : AllocateModule
  DESCRIPTION  : Creates and initializes a
                 list of definstances for a new module
  INPUTS       : None
  RETURNS      : The new definstances module
  SIDE EFFECTS : Definstances module created
  NOTES        : None
 *****************************************************/
static void *AllocateModule(
  void *theEnv)
  {
   return((void *) get_struct(theEnv,definstancesModule));
  }
Exemplo n.º 16
0
/*****************************************************
  NAME         : AllocateDefgenericModule
  DESCRIPTION  : Creates and initializes a
                 list of defgenerics for a new module
  INPUTS       : None
  RETURNS      : The new deffunction module
  SIDE EFFECTS : Deffunction module created
  NOTES        : None
 *****************************************************/
globle void *AllocateDefgenericModule(
  void *theEnv)
  {
   return((void *) get_struct(theEnv,defgenericModule));
  }
Exemplo n.º 17
0
char *
print_arg(int fd, struct syscall_args *sc, unsigned long *args) {
  char *tmp = NULL;
  switch (sc->type & ARG_MASK) {
  case Hex:
    tmp = malloc(12);
    sprintf(tmp, "0x%lx", args[sc->offset]);
    break;
  case Octal:
    tmp = malloc(13);
    sprintf(tmp, "0%lo", args[sc->offset]);
    break;
  case Int:
    tmp = malloc(12);
    sprintf(tmp, "%ld", args[sc->offset]);
    break;
  case String:
    {
      char *tmp2;
      tmp2 = get_string(fd, (void*)args[sc->offset], 0);
      tmp = malloc(strlen(tmp2) + 3);
      sprintf(tmp, "\"%s\"", tmp2);
      free(tmp2);
    }
  break;
  case Quad:
    {
      unsigned long long t;
      unsigned long l1, l2;
      l1 = args[sc->offset];
      l2 = args[sc->offset+1];
      t = make_quad(l1, l2);
      tmp = malloc(24);
      sprintf(tmp, "0x%qx", t);
      break;
    }
  case Ptr:
    tmp = malloc(12);
    sprintf(tmp, "0x%lx", args[sc->offset]);
    break;
  case Ioctl:
    {
      const char *temp = ioctlname(args[sc->offset]);
      if (temp)
	tmp = strdup(temp);
      else {
	tmp = malloc(12);
	sprintf(tmp, "0x%lx", args[sc->offset]);
      }
    }
    break;
  case Signal:
    {
      long sig;

      sig = args[sc->offset];
      tmp = malloc(12);
      if (sig > 0 && sig < NSIG) {
	int i;
	sprintf(tmp, "sig%s", sys_signame[sig]);
	for (i = 0; tmp[i] != '\0'; ++i)
	  tmp[i] = toupper(tmp[i]);
      } else {
        sprintf(tmp, "%ld", sig);
      }
    }
    break;
  case Sockaddr:
    {
      struct sockaddr_storage ss;
      char addr[64];
      struct sockaddr_in *lsin;
      struct sockaddr_in6 *lsin6;
      struct sockaddr_un *sun;
      struct sockaddr *sa;
      char *p;
      u_char *q;
      int i;

      /* yuck: get ss_len */
      if (get_struct(fd, (void *)args[sc->offset], &ss,
	sizeof(ss.ss_len) + sizeof(ss.ss_family)) == -1)
	err(1, "get_struct %p", (void *)args[sc->offset]);
      /* sockaddr_un never have the length filled in! */
      if (ss.ss_family == AF_UNIX) {
	if (get_struct(fd, (void *)args[sc->offset], &ss,
	  sizeof(*sun))
	  == -1)
	  err(2, "get_struct %p", (void *)args[sc->offset]);
      } else {
	if (get_struct(fd, (void *)args[sc->offset], &ss,
	    ss.ss_len < sizeof(ss) ? ss.ss_len : sizeof(ss))
	  == -1)
	  err(2, "get_struct %p", (void *)args[sc->offset]);
      }

      switch (ss.ss_family) {
      case AF_INET:
	lsin = (struct sockaddr_in *)&ss;
	inet_ntop(AF_INET, &lsin->sin_addr, addr, sizeof addr);
	asprintf(&tmp, "{ AF_INET %s:%d }", addr, htons(lsin->sin_port));
	break;
      case AF_INET6:
	lsin6 = (struct sockaddr_in6 *)&ss;
	inet_ntop(AF_INET6, &lsin6->sin6_addr, addr, sizeof addr);
	asprintf(&tmp, "{ AF_INET6 [%s]:%d }", addr, htons(lsin6->sin6_port));
	break;
      case AF_UNIX:
        sun = (struct sockaddr_un *)&ss;
        asprintf(&tmp, "{ AF_UNIX \"%s\" }", sun->sun_path);
	break;
      default:
	sa = (struct sockaddr *)&ss;
        asprintf(&tmp, "{ sa_len = %d, sa_family = %d, sa_data = {%n%*s } }",
	  (int)sa->sa_len, (int)sa->sa_family, &i,
	  6 * (int)(sa->sa_len - ((char *)&sa->sa_data - (char *)sa)), "");
	if (tmp != NULL) {
	  p = tmp + i;
          for (q = (u_char *)&sa->sa_data; q < (u_char *)sa + sa->sa_len; q++)
            p += sprintf(p, " %#02x,", *q);
	}
      }
    }
    break;
  }
  return tmp;
}
Exemplo n.º 18
0
static void AddDefglobal(
  void *theEnv,
  SYMBOL_HN *name,
  DATA_OBJECT_PTR vPtr,
  struct expr *ePtr)
  {
   struct defglobal *defglobalPtr;
   intBool newGlobal = FALSE;
#if DEBUGGING_FUNCTIONS
   int GlobalHadWatch = FALSE;
#endif

   /*========================================================*/
   /* If the defglobal is already defined, then use the old  */
   /* data structure and substitute new values. If it hasn't */
   /* been defined, then create a new data structure.        */
   /*========================================================*/

   defglobalPtr = QFindDefglobal(theEnv,name);
   if (defglobalPtr == NULL)
     {
      newGlobal = TRUE;
      defglobalPtr = get_struct(theEnv,defglobal);
     }
   else
     {
      DeinstallConstructHeader(theEnv,&defglobalPtr->header);
#if DEBUGGING_FUNCTIONS
      GlobalHadWatch = defglobalPtr->watch;
#endif
     }

   /*===========================================*/
   /* Remove the old values from the defglobal. */
   /*===========================================*/

   if (newGlobal == FALSE)
     {
      ValueDeinstall(theEnv,&defglobalPtr->current);
      if (defglobalPtr->current.type == MULTIFIELD)
        { ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); }

      RemoveHashedExpression(theEnv,defglobalPtr->initial);
     }

   /*=======================================*/
   /* Copy the new values to the defglobal. */
   /*=======================================*/

   defglobalPtr->current.type = vPtr->type;
   if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value;
   else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr);
   ValueInstall(theEnv,&defglobalPtr->current);

   defglobalPtr->initial = AddHashedExpression(theEnv,ePtr);
   ReturnExpression(theEnv,ePtr);
   DefglobalData(theEnv)->ChangeToGlobals = TRUE;

   /*=================================*/
   /* Restore the old watch value to  */
   /* the defglobal if redefined.     */
   /*=================================*/

#if DEBUGGING_FUNCTIONS
   defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals;
#endif

   /*======================================*/
   /* Save the name and pretty print form. */
   /*======================================*/

   defglobalPtr->header.name = name;
   defglobalPtr->header.usrData = NULL;
   IncrementSymbolCount(name);

   SavePPBuffer(theEnv,"\n");
   if (EnvGetConserveMemory(theEnv) == TRUE)
     { defglobalPtr->header.ppForm = NULL; }
   else
     { defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); }

   defglobalPtr->inScope = TRUE;

   /*=============================================*/
   /* If the defglobal was redefined, we're done. */
   /*=============================================*/

   if (newGlobal == FALSE) return;

   /*===================================*/
   /* Copy the defglobal variable name. */
   /*===================================*/

   defglobalPtr->busyCount = 0;
   defglobalPtr->header.whichModule = (struct defmoduleItemHeader *)
                               GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex);

   /*=============================================*/
   /* Add the defglobal to the list of defglobals */
   /* for the current module.                     */
   /*=============================================*/

   AddConstructToModule(&defglobalPtr->header);
  }
Exemplo n.º 19
0
globle void AddBetaMemoriesToJoin(
  void *theEnv,
  struct joinNode *theNode)
  {   
   if ((theNode->leftMemory != NULL) || (theNode->rightMemory != NULL))
     { return; }

   //if ((! theNode->firstJoin) || theNode->patternIsExists)

   if ((! theNode->firstJoin) || theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight)
     {
      if (theNode->leftHash == NULL)
        {
         theNode->leftMemory = get_struct(theEnv,betaMemory); 
         theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         theNode->leftMemory->beta[0] = NULL;
         theNode->leftMemory->size = 1;
         theNode->leftMemory->count = 0;
         theNode->leftMemory->last = NULL;
        }
      else
        {
         theNode->leftMemory = get_struct(theEnv,betaMemory); 
         theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         memset(theNode->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         theNode->leftMemory->size = INITIAL_BETA_HASH_SIZE;
         theNode->leftMemory->count = 0;
         theNode->leftMemory->last = NULL;
        }

 //     if (theNode->firstJoin && theNode->patternIsExists)
      if (theNode->firstJoin && (theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight))
        {
         theNode->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); 
         theNode->leftMemory->beta[0]->owner = theNode;
        }
     }
   else
     { theNode->leftMemory = NULL; }

   if (theNode->joinFromTheRight)
     {
      if (theNode->leftHash == NULL)
        {
         theNode->rightMemory = get_struct(theEnv,betaMemory); 
         theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         theNode->rightMemory->beta[0] = NULL;
         theNode->rightMemory->last[0] = NULL;
         theNode->rightMemory->size = 1;
         theNode->rightMemory->count = 0;
        }
      else
        {
         theNode->rightMemory = get_struct(theEnv,betaMemory); 
         theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         memset(theNode->rightMemory->beta,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE);
         memset(theNode->rightMemory->last,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE);
         theNode->rightMemory->size = INITIAL_BETA_HASH_SIZE;
         theNode->rightMemory->count = 0;
        }
     }

   else if (theNode->firstJoin && (theNode->rightSideEntryStructure == NULL))
     {
      theNode->rightMemory = get_struct(theEnv,betaMemory); 
      theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
      theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
      theNode->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv);
      theNode->rightMemory->beta[0]->owner = theNode;
      theNode->rightMemory->beta[0]->rhsMemory = TRUE;
      theNode->rightMemory->last[0] = theNode->rightMemory->beta[0];
      theNode->rightMemory->size = 1;
      theNode->rightMemory->count = 1;    
     }

   else
     { theNode->rightMemory = NULL; }
  }
Exemplo n.º 20
0
static void *AllocateModule(
  Environment *theEnv)
  {
   return (void *) get_struct(theEnv,defglobalModule);
  }
Exemplo n.º 21
0
void NegEntryRetract(
  struct joinNode *theJoin,
  struct partialMatch *theMatch,
  int duringRetract)
  {
   struct partialMatch *theLHS;
   int result;
   struct rdriveinfo *tempDR;
   struct alphaMatch *tempAlpha;
   struct joinNode *listOfJoins;

   /*===============================================*/
   /* Loop through all LHS partial matches checking */
   /* for sets that satisfied the join expression.  */
   /*===============================================*/

   for (theLHS = theJoin->beta; theLHS != NULL; theLHS = theLHS->next)
     {
      /*===========================================================*/
      /* Don't bother checking partial matches that are satisfied. */
      /* We're looking for joins from which the removal of a       */
      /* partial match would satisfy the join.                     */
      /*===========================================================*/

      if (theLHS->counterf == FALSE) continue;

      /*==================================================*/
      /* If the partial match being removed isn't the one */
      /* preventing the LHS partial match from being      */
      /* satisifed, then don't bother processing it.      */
      /*==================================================*/

      if (theLHS->binds[theLHS->bcount - 1].gm.theValue != (void *) theMatch) continue;

      /*======================================================*/
      /* Try to find another RHS partial match which prevents */
      /* the LHS partial match from being satisifed.          */
      /*======================================================*/

      theLHS->binds[theLHS->bcount - 1].gm.theValue = NULL;
      result = FindNextConflictingAlphaMatch(theLHS,theMatch->next,theJoin);

      /*=========================================================*/
      /* If the LHS partial match now has no RHS partial matches */
      /* that conflict with it, then it satisfies the conditions */
      /* of the RHS not CE. Create a partial match and send it   */
      /* to the joins below.                                     */
      /*=========================================================*/

      if (result == FALSE)
        {
         /*===============================*/
         /* Create the new partial match. */
         /*===============================*/

         theLHS->counterf = FALSE;
         tempAlpha = get_struct(alphaMatch);
         tempAlpha->next = NULL;
         tempAlpha->matchingItem = NULL;
         tempAlpha->markers = NULL;
         theLHS->binds[theLHS->bcount - 1].gm.theMatch = tempAlpha;

         /*==============================================*/
         /* If partial matches from this join correspond */
         /* to a rule activation, then add an activation */
         /* to the agenda.                               */
         /*==============================================*/

         if (theJoin->ruleToActivate != NULL)
           { AddActivation(theJoin->ruleToActivate,theLHS); }

         /*=======================================================*/
         /* Send the partial match to the list of joins following */
         /* this join. If we're in the middle of a retract, add   */
         /* the partial match to the list of join activities that */
         /* need to be processed later. If we're doing an assert, */
         /* then the join activity can be processed immediately.  */
         /*=======================================================*/

         listOfJoins = theJoin->nextLevel;
         if (listOfJoins != NULL)
           {
            if (((struct joinNode *) (listOfJoins->rightSideEntryStructure)) == theJoin)
              { NetworkAssert(theLHS,listOfJoins,RHS); }
            else
              {
               if (duringRetract)
                 {
                  tempDR = get_struct(rdriveinfo);
                  tempDR->link = theLHS;
                  tempDR->jlist = theJoin->nextLevel;
                  tempDR->next = DriveRetractionList;
                  DriveRetractionList = tempDR;
                 }
               else while (listOfJoins != NULL)
                 {
                  NetworkAssert(theLHS,listOfJoins,LHS);
                  listOfJoins = listOfJoins->rightDriveNode;
                 }
              }
           }
        }
     }
  }
Exemplo n.º 22
0
static struct factPatternNode *CreateNewPatternNode(
  void *theEnv,
  struct lhsParseNode *thePattern,
  struct factPatternNode *nodeBeforeMatch,
  struct factPatternNode *upperLevel,
  unsigned endSlot)
  {
   struct factPatternNode *newNode;

   /*========================================*/
   /* Create the pattern node and initialize */
   /* its slots to the default values.       */
   /*========================================*/

   newNode = get_struct(theEnv,factPatternNode);
   newNode->nextLevel = NULL;
   newNode->rightNode = NULL;
   newNode->leftNode = NULL;
   newNode->leaveFields = thePattern->singleFieldsAfter;
   InitializePatternHeader(theEnv,(struct patternNodeHeader *) &newNode->header);

   if (thePattern->index > 0) 
     { newNode->whichField = (unsigned short) thePattern->index; }
   else newNode->whichField = 0;

   if (thePattern->slotNumber >= 0) 
     { newNode->whichSlot = (unsigned short) (thePattern->slotNumber - 1); }
   else 
     { newNode->whichSlot = newNode->whichField; }

   /*=============================================================*/
   /* Set the slot values which indicate whether the pattern node */
   /* is a single-field, multifield, or end-of-pattern node.      */
   /*=============================================================*/

   if ((thePattern->type == SF_WILDCARD) || (thePattern->type == SF_VARIABLE))
     { newNode->header.singlefieldNode = TRUE; }
   else if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE))
     { newNode->header.multifieldNode = TRUE; }
   newNode->header.endSlot = endSlot;

   /*===========================================================*/
   /* Install the expression associated with this pattern node. */
   /*===========================================================*/

   newNode->networkTest = AddHashedExpression(theEnv,thePattern->networkTest);

   /*===============================================*/
   /* Set the upper level pointer for the new node. */
   /*===============================================*/

   newNode->lastLevel = upperLevel;

   /*======================================================*/
   /* If there are no nodes on this level, then attach the */
   /* new node to the child pointer of the upper level.    */
   /*======================================================*/

   if (nodeBeforeMatch == NULL)
     {
      if (upperLevel == NULL) FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
      else upperLevel->nextLevel = newNode;
      return(newNode);
     }

   /*=====================================================*/
   /* If there is an upper level above the new node, then */
   /* place the new node as the first child in the upper  */
   /* level's nextLevel (child) link.                     */
   /*=====================================================*/

   if (upperLevel != NULL)
     {
      newNode->rightNode = upperLevel->nextLevel;
      if (upperLevel->nextLevel != NULL)
        { upperLevel->nextLevel->leftNode = newNode; }
      upperLevel->nextLevel = newNode;
      return(newNode);
     }

   /*=====================================================*/
   /* Since there is no upper level above the new node,   */
   /* (i.e. the new node is being added to the highest    */
   /* level in the pattern network), the new node becomes */
   /* the first node visited in the pattern network.      */
   /*=====================================================*/

   newNode->rightNode = FactData(theEnv)->CurrentDeftemplate->patternNetwork;
   if (FactData(theEnv)->CurrentDeftemplate->patternNetwork != NULL)
     { FactData(theEnv)->CurrentDeftemplate->patternNetwork->leftNode = newNode; }

   FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
   return(newNode);
  }
Exemplo n.º 23
0
static struct joinNode *CreateNewJoin(
  void *theEnv,
  struct expr *joinTest,
  struct expr *secondaryJoinTest,
  struct joinNode *lhsEntryStruct,
  void *rhsEntryStruct,
  int joinFromTheRight,
  int negatedRHSPattern,
  int existsRHSPattern,
  struct expr *leftHash,
  struct expr *rightHash)
  {
   struct joinNode *newJoin;
   struct joinLink *theLink;
   
   /*===============================================*/
   /* If compilations are being watch, print +j to  */
   /* indicate that a new join has been created for */
   /* this pattern of the rule (i.e. a join could   */
   /* not be shared with another rule.              */
   /*===============================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,(char*)"compilations") == TRUE) && GetPrintWhileLoading(theEnv))
     { EnvPrintRouter(theEnv,WDIALOG,(char*)"+j"); }
#endif

   /*======================*/
   /* Create the new join. */
   /*======================*/

   newJoin = get_struct(theEnv,joinNode);
   
   /*======================================================*/
   /* The first join of a rule does not have a beta memory */
   /* unless the RHS pattern is an exists or not CE.       */
   /*======================================================*/
   
   if ((lhsEntryStruct != NULL) || existsRHSPattern || negatedRHSPattern || joinFromTheRight)
     {
      if (leftHash == NULL)     
        {      
         newJoin->leftMemory = get_struct(theEnv,betaMemory); 
         newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         newJoin->leftMemory->beta[0] = NULL;
         newJoin->leftMemory->last = NULL;
         newJoin->leftMemory->size = 1;
         newJoin->leftMemory->count = 0;
         }
      else
        {
         newJoin->leftMemory = get_struct(theEnv,betaMemory); 
         newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         memset(newJoin->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         newJoin->leftMemory->last = NULL;
         newJoin->leftMemory->size = INITIAL_BETA_HASH_SIZE;
         newJoin->leftMemory->count = 0;
        }
      
      /*===========================================================*/
      /* If the first join of a rule connects to an exists or not  */
      /* CE, then we create an empty partial match for the usually */
      /* empty left beta memory so that we can track the current   */
      /* current right memory partial match satisfying the CE.     */
      /*===========================================================*/
         
      if ((lhsEntryStruct == NULL) && (existsRHSPattern || negatedRHSPattern || joinFromTheRight))
        {
         newJoin->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); 
         newJoin->leftMemory->beta[0]->owner = newJoin;
         newJoin->leftMemory->count = 1;
        }
     }
   else
     { newJoin->leftMemory = NULL; }
     
   if (joinFromTheRight)
     {
      if (leftHash == NULL)     
        {      
         newJoin->rightMemory = get_struct(theEnv,betaMemory); 
         newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
         newJoin->rightMemory->beta[0] = NULL;
         newJoin->rightMemory->last[0] = NULL;
         newJoin->rightMemory->size = 1;
         newJoin->rightMemory->count = 0;
         }
      else
        {
         newJoin->rightMemory = get_struct(theEnv,betaMemory); 
         newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         memset(newJoin->rightMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         memset(newJoin->rightMemory->last,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
         newJoin->rightMemory->size = INITIAL_BETA_HASH_SIZE;
         newJoin->rightMemory->count = 0;
        }     
     }
   else if ((lhsEntryStruct == NULL) && (rhsEntryStruct == NULL))
     {
      newJoin->rightMemory = get_struct(theEnv,betaMemory); 
      newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
      newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
      newJoin->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv);
      newJoin->rightMemory->beta[0]->owner = newJoin;
      newJoin->rightMemory->beta[0]->rhsMemory = TRUE;
      newJoin->rightMemory->last[0] = newJoin->rightMemory->beta[0];
      newJoin->rightMemory->size = 1;
      newJoin->rightMemory->count = 1;    
     }
   else
     { newJoin->rightMemory = NULL; }
     
   newJoin->nextLinks = NULL;
   newJoin->joinFromTheRight = joinFromTheRight;
   
   if (existsRHSPattern)
     { newJoin->patternIsNegated = FALSE; }
   else
     { newJoin->patternIsNegated = negatedRHSPattern; }
   newJoin->patternIsExists = existsRHSPattern;

   newJoin->marked = FALSE;
   newJoin->initialize = EnvGetIncrementalReset(theEnv);
   newJoin->logicalJoin = FALSE;
   newJoin->ruleToActivate = NULL;
   newJoin->memoryAdds = 0;
   newJoin->memoryDeletes = 0;
   newJoin->memoryCompares = 0;

   /*==============================================*/
   /* Install the expressions used to determine    */
   /* if a partial match satisfies the constraints */
   /* associated with this join.                   */
   /*==============================================*/

   newJoin->networkTest = AddHashedExpression(theEnv,joinTest);
   newJoin->secondaryNetworkTest = AddHashedExpression(theEnv,secondaryJoinTest);
   
   /*=====================================================*/
   /* Install the expression used to hash the beta memory */
   /* partial match to determine the location to search   */
   /* in the alpha memory.                                */
   /*=====================================================*/
   
   newJoin->leftHash = AddHashedExpression(theEnv,leftHash);
   newJoin->rightHash = AddHashedExpression(theEnv,rightHash);

   /*============================================================*/
   /* Initialize the values associated with the LHS of the join. */
   /*============================================================*/

   newJoin->lastLevel = lhsEntryStruct;

   if (lhsEntryStruct == NULL)
     {
      newJoin->firstJoin = TRUE;
      newJoin->depth = 1;
     }
   else
     {
      newJoin->firstJoin = FALSE;
      newJoin->depth = lhsEntryStruct->depth;
      newJoin->depth++; /* To work around Sparcworks C compiler bug */
      
      theLink = get_struct(theEnv,joinLink);
      theLink->join = newJoin;
      theLink->enterDirection = LHS;
      theLink->next = lhsEntryStruct->nextLinks;
      lhsEntryStruct->nextLinks = theLink;
     }

   /*=======================================================*/
   /* Initialize the pointer values associated with the RHS */
   /* of the join (both for the new join and the join or    */
   /* pattern which enters this join from the right.        */
   /*=======================================================*/

   newJoin->rightSideEntryStructure = rhsEntryStruct;
   
   if (rhsEntryStruct == NULL)
     { 
      if (newJoin->firstJoin)
        {
         theLink = get_struct(theEnv,joinLink);
         theLink->join = newJoin;
         theLink->enterDirection = RHS;
         theLink->next = DefruleData(theEnv)->RightPrimeJoins;
         DefruleData(theEnv)->RightPrimeJoins = theLink;
        }
        
      newJoin->rightMatchNode = NULL;
        
      return(newJoin); 
     }
     
   /*===========================================================*/
   /* If the first join of a rule is a not CE, then it needs to */
   /* be "primed" under certain circumstances. This used to be  */
   /* handled by adding the (initial-fact) pattern to a rule    */
   /* with the not CE as its first pattern, but this alternate  */
   /* mechanism is now used so patterns don't have to be added. */
   /*===========================================================*/
     
   if (newJoin->firstJoin && (newJoin->patternIsNegated || newJoin->joinFromTheRight) && (! newJoin->patternIsExists))
     {
      theLink = get_struct(theEnv,joinLink);
      theLink->join = newJoin;
      theLink->enterDirection = LHS;
      theLink->next = DefruleData(theEnv)->LeftPrimeJoins;
      DefruleData(theEnv)->LeftPrimeJoins = theLink;
     }
       
   if (joinFromTheRight)
     {
      theLink = get_struct(theEnv,joinLink);
      theLink->join = newJoin;
      theLink->enterDirection = RHS;
      theLink->next = ((struct joinNode *) rhsEntryStruct)->nextLinks;
      ((struct joinNode *) rhsEntryStruct)->nextLinks = theLink;
      newJoin->rightMatchNode = NULL;
     }
   else
     {
      newJoin->rightMatchNode = ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin;
      ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin = newJoin;
     }

   /*================================*/
   /* Return the newly created join. */
   /*================================*/

   return(newJoin);
  }
Exemplo n.º 24
0
globle void InitializeFactPatterns(
  void *theEnv)
  {
#if DEFRULE_CONSTRUCT
   struct patternParser *newPtr;

   InitializeFactReteFunctions(theEnv);

   newPtr = get_struct(theEnv,patternParser);

   newPtr->name = "facts";
   newPtr->priority = 0;
   newPtr->entityType = &FactData(theEnv)->FactInfo;
   
#if (! RUN_TIME) && (! BLOAD_ONLY)
   newPtr->recognizeFunction = FactPatternParserFind;
   newPtr->parseFunction = FactPatternParse;
   newPtr->postAnalysisFunction = NULL;
   newPtr->addPatternFunction = PlaceFactPattern;   
   newPtr->removePatternFunction = DetachFactPattern;
   newPtr->genJNConstantFunction = NULL;
   newPtr->replaceGetJNValueFunction = FactReplaceGetvar;
   newPtr->genGetJNValueFunction = FactGenGetvar;
   newPtr->genCompareJNValuesFunction = FactJNVariableComparison;
   newPtr->genPNConstantFunction = FactGenPNConstant;
   newPtr->replaceGetPNValueFunction = FactReplaceGetfield;
   newPtr->genGetPNValueFunction = FactGenGetfield;
   newPtr->genComparePNValuesFunction = FactPNVariableComparison;
   newPtr->returnUserDataFunction = NULL;
   newPtr->copyUserDataFunction = NULL;
#else
   newPtr->recognizeFunction = NULL;
   newPtr->parseFunction = NULL;
   newPtr->postAnalysisFunction = NULL;
   newPtr->addPatternFunction = NULL;   
   newPtr->removePatternFunction = NULL;
   newPtr->genJNConstantFunction = NULL;
   newPtr->replaceGetJNValueFunction = NULL;
   newPtr->genGetJNValueFunction = NULL;
   newPtr->genCompareJNValuesFunction = NULL;
   newPtr->genPNConstantFunction = NULL;
   newPtr->replaceGetPNValueFunction = NULL;
   newPtr->genGetPNValueFunction = NULL;
   newPtr->genComparePNValuesFunction = NULL;
   newPtr->returnUserDataFunction = NULL;
   newPtr->copyUserDataFunction = NULL;   
#endif

#if INCREMENTAL_RESET
   newPtr->markIRPatternFunction = MarkFactPatternForIncrementalReset;
   newPtr->incrementalResetFunction = FactsIncrementalReset;
#else
   newPtr->markIRPatternFunction = NULL;
   newPtr->incrementalResetFunction = NULL;
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
   newPtr->initialPatternFunction = CreateInitialFactPattern;
#if CONSTRUCT_COMPILER
   newPtr->codeReferenceFunction = FactPatternNodeReference;
#else
   newPtr->codeReferenceFunction = NULL;
#endif
#else
   newPtr->initialPatternFunction = NULL;
   newPtr->codeReferenceFunction = NULL;
#endif   

   AddPatternParser(theEnv,newPtr);
#endif
  }
Exemplo n.º 25
0
static void ProcessMultifieldNode(
  void *theEnv,
  struct factPatternNode *thePattern,
  struct multifieldMarker *markers,
  struct multifieldMarker *endMark,
  int offset)
  {
   struct multifieldMarker *newMark, *oldMark;
   int repeatCount;
   struct multifield *theSlotValue;
   DATA_OBJECT theResult;
   struct factPatternNode *tempPtr;
   intBool success;

   /*========================================*/
   /* Get a pointer to the slot value of the */
   /* multifield slot being pattern matched. */
   /*========================================*/

   theSlotValue = (struct multifield *)
     FactData(theEnv)->CurrentPatternFact->theProposition.theFields[thePattern->whichSlot].value;

   /*===============================================*/
   /* Save the value of the markers already stored. */
   /*===============================================*/

   oldMark = markers;

   /*===========================================*/
   /* Create a new multifield marker and append */
   /* it to the end of the current list.        */
   /*===========================================*/

   newMark = get_struct(theEnv,multifieldMarker);
   newMark->whichField = thePattern->whichField - 1;
   newMark->where.whichSlotNumber = (short) thePattern->whichSlot;
   newMark->startPosition = (thePattern->whichField - 1) + offset;
   newMark->next = NULL;

   if (endMark == NULL)
     {
      markers = newMark;
      FactData(theEnv)->CurrentPatternMarks = markers;
     }
   else
     { endMark->next = newMark; }

   /*============================================*/
   /* Handle a multifield constraint as the last */
   /* constraint of a slot as a special case.    */
   /*============================================*/

   if (thePattern->header.endSlot)
     {
      newMark->endPosition = (long) theSlotValue->multifieldLength -
                                    (thePattern->leaveFields + 1);

      /*=======================================================*/
      /* Make sure the endPosition is never more than less one */
      /* less of the startPosition (a multifield containing no */
      /* values.                                               */
      /*=======================================================*/

      if (newMark->endPosition < newMark->startPosition)
        { newMark->endPosition = newMark->startPosition - 1; }

      /*===========================================*/
      /* Determine if the constraint is satisfied. */
      /*===========================================*/

      if (thePattern->header.selector)
        {
         if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg))
           {
            EvaluateExpression(theEnv,thePattern->networkTest,&theResult);
         
            thePattern = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value);
            if (thePattern != NULL)
              { success = TRUE; }
            else
              { success = FALSE; }
           }
         else
           { success = FALSE; }
        }
      else if ((thePattern->networkTest == NULL) ?
          TRUE :
          (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest)))
        { success = TRUE; }
      else
        { success = FALSE; }
    
      if (success)
        {
         /*=======================================================*/
         /* If a leaf pattern node has been successfully reached, */
         /* then the pattern has been satisified. Generate an     */
         /* alpha match to store in the pattern node.             */
         /*=======================================================*/

         if (thePattern->header.stopNode)
           { ProcessFactAlphaMatch(theEnv,FactData(theEnv)->CurrentPatternFact,FactData(theEnv)->CurrentPatternMarks,thePattern); }

         /*=============================================*/
         /* Recursively continue pattern matching based */
         /* on the multifield binding just generated.   */
         /*=============================================*/

         FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
                          thePattern->nextLevel,0,FactData(theEnv)->CurrentPatternMarks,newMark);
        }

      /*================================================*/
      /* Discard the multifield marker since we've done */
      /* all the pattern matching for this binding of   */
      /* the multifield slot constraint.                */
      /*================================================*/

      rtn_struct(theEnv,multifieldMarker,newMark);
      if (endMark != NULL) endMark->next = NULL;
      FactData(theEnv)->CurrentPatternMarks = oldMark;
      return;
     }

   /*==============================================*/
   /* Perform matching for nodes beneath this one. */
   /*==============================================*/

   for (repeatCount = (long) (theSlotValue->multifieldLength -
                      (newMark->startPosition + thePattern->leaveFields));
        repeatCount >= 0;
        repeatCount--)
     {
      newMark->endPosition = newMark->startPosition + (repeatCount - 1);

      if (thePattern->header.selector)
        {
         if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg))
           {
            EvaluateExpression(theEnv,thePattern->networkTest,&theResult);
         
            tempPtr = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value);
            if (tempPtr != NULL)
              {
               FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
                                tempPtr->nextLevel,offset + repeatCount - 1,
                                FactData(theEnv)->CurrentPatternMarks,newMark);
              }
           }
        }
      else if ((thePattern->networkTest == NULL) ?
               TRUE :
               (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest)))
        {
         FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
                          thePattern->nextLevel,offset + repeatCount - 1,
                          FactData(theEnv)->CurrentPatternMarks,newMark);
        }
     }

    /*======================================================*/
    /* Get rid of the marker created for a multifield node. */
    /*======================================================*/

    rtn_struct(theEnv,multifieldMarker,newMark);
    if (endMark != NULL) endMark->next = NULL;
    FactData(theEnv)->CurrentPatternMarks = oldMark;
   }
Exemplo n.º 26
0
globle int DefineFunction3(
  void *theEnv,
  const char *name,
  int returnType,
  int (*pointer)(void *),
  const char *actualName,
  const char *restrictions,
  intBool environmentAware,
  void *context)
  {
   struct FunctionDefinition *newFunction;

   if ( (returnType != 'a') &&
        (returnType != 'b') &&
        (returnType != 'c') &&
        (returnType != 'd') &&
        (returnType != 'f') &&
        (returnType != 'g') &&
        (returnType != 'i') &&
        (returnType != 'j') &&
        (returnType != 'k') &&
        (returnType != 'l') &&
        (returnType != 'm') &&
        (returnType != 'n') &&
#if OBJECT_SYSTEM
        (returnType != 'o') &&
#endif
        (returnType != 's') &&
        (returnType != 'u') &&
        (returnType != 'v') &&
#if OBJECT_SYSTEM
        (returnType != 'x') &&
#endif
        (returnType != 'w') )
     { return(0); }

   newFunction = FindFunction(theEnv,name);
   if (newFunction == NULL)
     {
      newFunction = get_struct(theEnv,FunctionDefinition);
      newFunction->callFunctionName = (SYMBOL_HN *) EnvAddSymbol(theEnv,name);
      IncrementSymbolCount(newFunction->callFunctionName);
      newFunction->next = GetFunctionList(theEnv);
      ExternalFunctionData(theEnv)->ListOfFunctions = newFunction;
      AddHashFunction(theEnv,newFunction);
     }
     
   newFunction->returnValueType = (char) returnType;
   newFunction->functionPointer = (int (*)(void)) pointer;
   newFunction->actualFunctionName = actualName;
   if (restrictions != NULL)
     {
      if (((int) (strlen(restrictions)) < 2) ? TRUE :
          ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) ||
           (! isdigit(restrictions[1]) && (restrictions[1] != '*'))))
        restrictions = NULL;
     }
   newFunction->restrictions = restrictions;
   newFunction->parser = NULL;
   newFunction->overloadable = TRUE;
   newFunction->sequenceuseok = TRUE;
   newFunction->environmentAware = (short) environmentAware;
   newFunction->usrData = NULL;
   newFunction->context = context;

   return(1);
  }
Exemplo n.º 27
0
globle int ParseDefmodule(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *defmoduleName;
   struct defmodule *newDefmodule;
   struct token inputToken;
   int i;
   struct moduleItem *theItem;
   struct portItem *portSpecs, *nextSpec;
   struct defmoduleItemHeader *theHeader;
   struct callFunctionItem *defineFunctions;
   struct defmodule *redefiningMainModule = NULL;
   int parseError;
   struct portItem *oldImportList = NULL, *oldExportList = NULL;
   short overwrite = FALSE;

   /*================================================*/
   /* Flush the buffer which stores the pretty print */
   /* representation for a module.  Add the already  */
   /* parsed keyword defmodule to this buffer.       */
   /*================================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmodule ");

   /*===============================*/
   /* Modules cannot be loaded when */
   /* a binary load is in effect.   */
   /*===============================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmodule");
      return(TRUE);
     }
#endif

   /*=====================================================*/
   /* Parse the name and comment fields of the defmodule. */
   /* Remove the defmodule if it already exists.          */
   /*=====================================================*/

   defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
                                              EnvFindDefmodule,DeleteDefmodule,"+",
                                              TRUE,TRUE,FALSE);
   if (defmoduleName == NULL) { return(TRUE); }

   if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
     { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }

   /*==============================================*/
   /* Create the defmodule structure if necessary. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
      if (newDefmodule)
        { overwrite = TRUE; }
      else
        {
         newDefmodule = get_struct(theEnv,defmodule);
         newDefmodule->name = defmoduleName;
         newDefmodule->usrData = NULL;
         newDefmodule->next = NULL;
        }
     }
   else
     {
      overwrite = TRUE;
      newDefmodule = redefiningMainModule;
     }

   if (overwrite)
     {
      oldImportList = newDefmodule->importList;
      oldExportList = newDefmodule->exportList;
     }

   newDefmodule->importList = NULL;
   newDefmodule->exportList = NULL;

   /*===================================*/
   /* Finish parsing the defmodule (its */
   /* import/export specifications).    */
   /*===================================*/

   parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);

   /*====================================*/
   /* Check for import/export conflicts. */
   /*====================================*/

   if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);

   /*======================================================*/
   /* If an error occured in parsing or an import conflict */
   /* was detected, abort the definition of the defmodule. */
   /* If we're only checking syntax, then we want to exit  */
   /* at this point as well.                               */
   /*======================================================*/

   if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
     {
      while (newDefmodule->importList != NULL)
        {
         nextSpec = newDefmodule->importList->next;
         rtn_struct(theEnv,portItem,newDefmodule->importList);
         newDefmodule->importList = nextSpec;
        }

      while (newDefmodule->exportList != NULL)
        {
         nextSpec = newDefmodule->exportList->next;
         rtn_struct(theEnv,portItem,newDefmodule->exportList);
         newDefmodule->exportList = nextSpec;
        }

      if ((redefiningMainModule == NULL) && (! overwrite))
        { rtn_struct(theEnv,defmodule,newDefmodule); }

      if (overwrite)
        {
         newDefmodule->importList = oldImportList;
         newDefmodule->exportList = oldExportList;
        }

      if (parseError) return(TRUE);
      return(FALSE);
     }

   /*===============================================*/
   /* Increment the symbol table counts for symbols */
   /* used in the defmodule data structures.        */
   /*===============================================*/

   if (redefiningMainModule == NULL)
     { IncrementSymbolCount(newDefmodule->name); }
   else
     {
      if ((newDefmodule->importList != NULL) ||
          (newDefmodule->exportList != NULL))
        { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
     }

   for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   /*====================================================*/
   /* Allocate storage for the module's construct lists. */
   /*====================================================*/

   if (redefiningMainModule != NULL) { /* Do nothing */ }
   else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
   else
     {
      newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
           i++, theItem = theItem->next)
        {
         if (theItem->allocateFunction == NULL)
           { newDefmodule->itemsArray[i] = NULL; }
         else
           {
            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
                                          (*theItem->allocateFunction)(theEnv);
            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
            theHeader->theModule = newDefmodule;
            theHeader->firstItem = NULL;
            theHeader->lastItem = NULL;
           }
        }
     }

   /*=======================================*/
   /* Save the pretty print representation. */
   /*=======================================*/

   SavePPBuffer(theEnv,"\n");

   if (EnvGetConserveMemory(theEnv) == TRUE)
     { newDefmodule->ppForm = NULL; }
   else
     { newDefmodule->ppForm = CopyPPBuffer(theEnv); }

   /*==============================================*/
   /* Add the defmodule to the list of defmodules. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
      else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
      DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
      newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
     }

   EnvSetCurrentModule(theEnv,(void *) newDefmodule);

   /*=========================================*/
   /* Call any functions required by other    */
   /* constructs when a new module is defined */
   /*=========================================*/

   for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
        defineFunctions != NULL;
        defineFunctions = defineFunctions->next)
     { (* (void (*)(void *)) defineFunctions->func)(theEnv); }

   /*===============================================*/
   /* Defmodule successfully parsed with no errors. */
   /*===============================================*/

   return(FALSE);
  }
Exemplo n.º 28
0
static struct expr *BindParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;
   SYMBOL_HN *variableName;
   struct expr *texp;
   CONSTRAINT_RECORD *theConstraint = NULL;
#if DEFGLOBAL_CONSTRUCT
   struct defglobal *theGlobal;
   int count;
#endif

   SavePPBuffer(theEnv," ");

   /*=============================================*/
   /* Next token must be the name of the variable */
   /* to be bound.                                */
   /*=============================================*/

   GetToken(theEnv,infile,&theToken);
   if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE))
     {
      if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode)
        {
         SyntaxErrorMessage(theEnv,"bind function");
         ReturnExpression(theEnv,top);
         return(NULL);
        }
     }

   /*==============================*/
   /* Process the bind expression. */
   /*==============================*/

   top->argList = GenConstant(theEnv,SYMBOL,theToken.value);
   variableName = (SYMBOL_HN *) theToken.value;

#if DEFGLOBAL_CONSTRUCT
   if ((theToken.type == GBL_VARIABLE) ?
       ((theGlobal = (struct defglobal *)
                     FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName),
                                           &count,TRUE,FALSE)) != NULL) :
       FALSE)
     {
      top->argList->type = DEFGLOBAL_PTR;
      top->argList->value = (void *) theGlobal;
     }
   else if (theToken.type == GBL_VARIABLE)
     {
      GlobalReferenceErrorMessage(theEnv,ValueToString(variableName));
      ReturnExpression(theEnv,top);
      return(NULL);
     }
#endif

   texp = get_struct(theEnv,expr);
   texp->argList = texp->nextArg = NULL;
   if (CollectArguments(theEnv,texp,infile) == NULL)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   top->argList->nextArg = texp->argList;
   rtn_struct(theEnv,expr,texp);

#if DEFGLOBAL_CONSTRUCT
   if (top->argList->type == DEFGLOBAL_PTR) return(top);
#endif

   if (top->argList->nextArg != NULL)
     { theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); }

   AddBindName(theEnv,variableName,theConstraint);

   return(top);
  }
Exemplo n.º 29
0
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   fact queries - uses parse form.
  INPUTS       : 1) Name of calling function for error msgs
                 2) Data object - must be a symbol or a
                      multifield value containing all symbols
                 The symbols must be names of existing templates
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all templates
  NOTES        : None
 *************************************************************/
static QUERY_TEMPLATE *FormChain(
  void *theEnv,
  char *func,
  DATA_OBJECT *val)
  {
   struct deftemplate *templatePtr;
   QUERY_TEMPLATE *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *templateName;
   int count;

   if (val->type == DEFTEMPLATE_PTR)
     {
      IncrementDeftemplateBusyCount(theEnv,(void *) val->value);
      head = get_struct(theEnv,query_template);
      head->templatePtr = (struct deftemplate *) val->value;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == SYMBOL)
     {
      /* ===============================================
         Allow instance-set query restrictions to have a
         module specifier as part of the class name,
         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
         
      templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,DOPToString(val),
                                             &count,TRUE,NULL);
      if (templatePtr == NULL)
        {
         CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",DOPToString(val),func);
         return(NULL);
        }
      IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
      head = get_struct(theEnv,query_template);
      head->templatePtr = templatePtr;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            templateName = ValueToString(GetMFValue(val->value,i));
            
            templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,templateName,
                                             &count,TRUE,NULL);

            if (templatePtr == NULL)
              {
               CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",templateName,func);
               DeleteQueryTemplates(theEnv,head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryTemplates(theEnv,head);
            return(NULL);
           }
         IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
         tmp = get_struct(theEnv,query_template);
         tmp->templatePtr = templatePtr;

         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }
Exemplo n.º 30
0
/****************************************************
  NAME         : AddDeffunction
  DESCRIPTION  : Adds a deffunction to the list of
                 deffunctions
  INPUTS       : 1) The symbolic name
                 2) The action expressions
                 3) The minimum number of arguments
                 4) The maximum number of arguments
                    (can be -1)
                 5) The number of local variables
                 6) A flag indicating if this is
                    a header call so that the
                    deffunction can be recursively
                    called
  RETURNS      : The new deffunction (NULL on errors)
  SIDE EFFECTS : Deffunction structures allocated
  NOTES        : Assumes deffunction is not executing
 ****************************************************/
static DEFFUNCTION *AddDeffunction(
  void *theEnv,
  SYMBOL_HN *name,
  EXPRESSION *actions,
  int min,
  int max,
  int lvars,
  int headerp)
  {
   DEFFUNCTION *dfuncPtr;
   unsigned oldbusy;
#if DEBUGGING_FUNCTIONS
   unsigned DFHadWatch = FALSE;
#endif

   /*===============================================================*/
   /* If the deffunction doesn't exist, create a new structure to   */
   /* contain it and add it to the List of deffunctions. Otherwise, */
   /* use the existing structure and remove the pretty print form   */
   /* and interpretive code.                                        */
   /*===============================================================*/
   dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name));
   if (dfuncPtr == NULL)
     {
      dfuncPtr = get_struct(theEnv,deffunctionStruct);
      InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
      IncrementSymbolCount(name);
      dfuncPtr->code = NULL;
      dfuncPtr->minNumberOfParameters = min;
      dfuncPtr->maxNumberOfParameters = max;
      dfuncPtr->numberOfLocalVars = lvars;
      dfuncPtr->busy = 0;
      dfuncPtr->executing = 0;
     }
   else
     {
#if DEBUGGING_FUNCTIONS
      DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
#endif
      dfuncPtr->minNumberOfParameters = min;
      dfuncPtr->maxNumberOfParameters = max;
      dfuncPtr->numberOfLocalVars = lvars;
      oldbusy = dfuncPtr->busy;
      ExpressionDeinstall(theEnv,dfuncPtr->code);
      dfuncPtr->busy = oldbusy;
      ReturnPackedExpression(theEnv,dfuncPtr->code);
      dfuncPtr->code = NULL;
      SetDeffunctionPPForm((void *) dfuncPtr,NULL);

      /* =======================================
         Remove the deffunction from the list so
         that it can be added at the end
         ======================================= */
      RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
     }

   AddConstructToModule((struct constructHeader *) dfuncPtr);

   /* ==================================
      Install the new interpretive code.
      ================================== */

   if (actions != NULL)
     {
      /* ===============================
         If a deffunction is recursive,
         do not increment its busy count
         based on self-references
         =============================== */
      oldbusy = dfuncPtr->busy;
      ExpressionInstall(theEnv,actions);
      dfuncPtr->busy = oldbusy;
      dfuncPtr->code = actions;
     }

   /* ===============================================================
      Install the pretty print form if memory is not being conserved.
      =============================================================== */

#if DEBUGGING_FUNCTIONS
   EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
   if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
     SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv));
#endif
   return(dfuncPtr);
  }