clipsruby 0.0.2

data/ext/clipsruby/dffnxcmp.c

@@ -0,0 +1,378 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  07/30/16             */
+   /*                                                     */
+   /*                                                     */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Generic Function Construct Compiler Code         */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.30: Added support for path name argument to        */
+/*            constructs-to-c.                               */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*      6.40: Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME)
+
+#include "conscomp.h"
+#include "envrnmnt.h"
+
+#include "dffnxcmp.h"
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static void                    ReadyDeffunctionsForCode(Environment *);
+   static bool                    DeffunctionsToCode(Environment *,const char *,const char *,char *,
+                                                     unsigned int,FILE *,unsigned int,unsigned int);
+   static void                    CloseDeffunctionFiles(Environment *,FILE *,FILE *,unsigned int);
+   static void                    DeffunctionModuleToCode(Environment *,FILE *,Defmodule *,unsigned int,unsigned int);
+   static void                    SingleDeffunctionToCode(Environment *,FILE *,Deffunction *,
+                                                          unsigned int,unsigned int,unsigned int);
+   static void                    InitDeffunctionCode(Environment *,FILE *,unsigned int,unsigned int);
+
+/* =========================================
+   *****************************************
+          EXTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/***************************************************
+  NAME         : SetupDeffunctionCompiler
+  DESCRIPTION  : Initializes the construct compiler
+                   item for deffunctions
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Code generator item initialized
+  NOTES        : None
+ ***************************************************/
+void SetupDeffunctionCompiler(
+  Environment *theEnv)
+  {
+   DeffunctionData(theEnv)->DeffunctionCodeItem = AddCodeGeneratorItem(theEnv,"deffunctions",0,ReadyDeffunctionsForCode,
+                                              InitDeffunctionCode,DeffunctionsToCode,2);
+  }
+
+
+/***************************************************
+  NAME         : PrintDeffunctionReference
+  DESCRIPTION  : Prints a reference to the run-time
+                 deffunction array for the construct
+                 compiler
+  INPUTS       : 1) The file output destination
+                 2) A pointer to the deffunction
+                 3) The id of the run-time image
+                 4) The maximum number of indices
+                    in any array
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Reference printed
+  NOTES        : None
+ ***************************************************/
+void PrintDeffunctionReference(
+  Environment *theEnv,
+  FILE *fp,
+  Deffunction *dfPtr,
+  unsigned imageID,
+  unsigned maxIndices)
+  {
+   if (dfPtr == NULL)
+     fprintf(fp,"NULL");
+   else
+     fprintf(fp,"&%s%d_%lu[%lu]",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),imageID,
+                                ((dfPtr->header.bsaveID / maxIndices) + 1),
+                                (dfPtr->header.bsaveID % maxIndices));
+  }
+
+/****************************************************
+  NAME         : DeffunctionCModuleReference
+  DESCRIPTION  : Prints out a reference to a
+                 deffunction module
+  INPUTS       : 1) The output file
+                 2) The id of the module item
+                 3) The id of the image
+                 4) The maximum number of elements
+                    allowed in an array
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Deffunction module reference printed
+  NOTES        : None
+ ****************************************************/
+void DeffunctionCModuleReference(
+  Environment *theEnv,
+  FILE *theFile,
+  unsigned long count,
+  unsigned int imageID,
+  unsigned int maxIndices)
+  {
+   fprintf(theFile,"MIHS &%s%u_%lu[%lu]",
+                      ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),
+                      imageID,
+                      (count / maxIndices) + 1,
+                      (count % maxIndices));
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/***************************************************
+  NAME         : ReadyDeffunctionsForCode
+  DESCRIPTION  : Sets index of deffunctions
+                   for use in compiled expressions
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : BsaveIndices set
+  NOTES        : None
+ ***************************************************/
+static void ReadyDeffunctionsForCode(
+  Environment *theEnv)
+  {
+   MarkConstructBsaveIDs(theEnv,DeffunctionData(theEnv)->DeffunctionModuleIndex);
+  }
+
+/**************************************************/
+/* InitDeffunctionCode: Writes out initialization */
+/*   code for deffunction for a run-time module.  */
+/**************************************************/
+static void InitDeffunctionCode(
+  Environment *theEnv,
+  FILE *initFP,
+  unsigned int imageID,
+  unsigned int maxIndices)
+  {
+#if MAC_XCD
+#pragma unused(maxIndices)
+#pragma unused(imageID)
+#pragma unused(theEnv)
+#endif
+   fprintf(initFP,"   DeffunctionRunTimeInitialize(theEnv);\n");
+  }
+
+/*******************************************************
+  NAME         : DeffunctionsToCode
+  DESCRIPTION  : Writes out static array code for
+                   deffunctions
+  INPUTS       : 1) The base name of the construct set
+                 2) The base id for this construct
+                 3) The file pointer for the header file
+                 4) The base id for the construct set
+                 5) The max number of indices allowed
+                    in an array
+  RETURNS      : False on errors,
+                 True if deffunctions written
+  SIDE EFFECTS : Code written to files
+  NOTES        : None
+ *******************************************************/
+static bool DeffunctionsToCode(
+  Environment *theEnv,
+  const char *fileName,
+  const char *pathName,
+  char *fileNameBuffer,
+  unsigned int fileID,
+  FILE *headerFP,
+  unsigned int imageID,
+  unsigned int maxIndices)
+  {
+   unsigned int fileCount = 1;
+   Defmodule *theModule;
+   Deffunction *theDeffunction;
+   unsigned int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1;
+   unsigned int deffunctionArrayCount = 0, deffunctionArrayVersion = 1;
+   FILE *moduleFile = NULL, *deffunctionFile = NULL;
+
+   /* ===============================================
+      Include the appropriate deffunction header file
+      =============================================== */
+   fprintf(headerFP,"#include \"dffnxfun.h\"\n");
+
+   /* =============================================================
+      Loop through all the modules and all the deffunctions writing
+      their C code representation to the file as they are traversed
+      ============================================================= */
+   theModule = GetNextDefmodule(theEnv,NULL);
+
+   while (theModule != NULL)
+     {
+      SetCurrentModule(theEnv,theModule);
+
+      moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
+                                    moduleArrayVersion,headerFP,
+                                    "DeffunctionModuleData",ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),
+                                    false,NULL);
+
+      if (moduleFile == NULL)
+        {
+         CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices);
+         return false;
+        }
+
+      DeffunctionModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices);
+      moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion,
+                                     maxIndices,NULL,NULL);
+
+      theDeffunction = GetNextDeffunction(theEnv,NULL);
+
+      while (theDeffunction != NULL)
+        {
+         deffunctionFile = OpenFileIfNeeded(theEnv,deffunctionFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
+                                            deffunctionArrayVersion,headerFP,
+                                            "Deffunction",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),
+                                            false,NULL);
+         if (deffunctionFile == NULL)
+           {
+            CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices);
+            return false;
+           }
+
+         SingleDeffunctionToCode(theEnv,deffunctionFile,theDeffunction,imageID,
+                                 maxIndices,moduleCount);
+         deffunctionArrayCount++;
+         deffunctionFile = CloseFileIfNeeded(theEnv,deffunctionFile,&deffunctionArrayCount,
+                                             &deffunctionArrayVersion,maxIndices,NULL,NULL);
+
+         theDeffunction = GetNextDeffunction(theEnv,theDeffunction);
+        }
+
+      theModule = GetNextDefmodule(theEnv,theModule);
+      moduleCount++;
+      moduleArrayCount++;
+     }
+
+   CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices);
+
+   return true;
+  }
+
+/***************************************************
+  NAME         : CloseDeffunctionFiles
+  DESCRIPTION  : Closes construct compiler files
+                  for deffunction structures
+  INPUTS       : 1) The deffunction module file
+                 2) The deffunction structure file
+                 3) The maximum number of indices
+                    allowed in an array
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Files closed
+  NOTES        : None
+ ***************************************************/
+static void CloseDeffunctionFiles(
+  Environment *theEnv,
+  FILE *moduleFile,
+  FILE *deffunctionFile,
+  unsigned int maxIndices)
+  {
+   unsigned int count = maxIndices;
+   unsigned int arrayVersion = 0;
+
+   if (deffunctionFile != NULL)
+     {
+      count = maxIndices;
+      CloseFileIfNeeded(theEnv,deffunctionFile,&count,&arrayVersion,maxIndices,NULL,NULL);
+     }
+
+   if (moduleFile != NULL)
+     {
+      count = maxIndices;
+      CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL);
+     }
+  }
+
+/***************************************************
+  NAME         : DeffunctionModuleToCode
+  DESCRIPTION  : Writes out the C values for a
+                 deffunction module item
+  INPUTS       : 1) The output file
+                 2) The module for the deffunctions
+                 3) The compile image id
+                 4) The maximum number of elements
+                    in an array
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Deffunction module item written
+  NOTES        : None
+ ***************************************************/
+static void DeffunctionModuleToCode(
+  Environment *theEnv,
+  FILE *theFile,
+  Defmodule *theModule,
+  unsigned int imageID,
+  unsigned int maxIndices)
+  {
+   fprintf(theFile,"{");
+   ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices,
+                         DeffunctionData(theEnv)->DeffunctionModuleIndex,ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem));
+   fprintf(theFile,"}");
+  }
+
+/***************************************************
+  NAME         : SingleDeffunctionToCode
+  DESCRIPTION  : Writes out a single deffunction's
+                 data to the file
+  INPUTS       : 1) The output file
+                 2) The deffunction
+                 3) The compile image id
+                 4) The maximum number of
+                    elements in an array
+                 5) The module index
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Deffunction data written
+  NOTES        : None
+ ***************************************************/
+static void SingleDeffunctionToCode(
+  Environment *theEnv,
+  FILE *theFile,
+  Deffunction *theDeffunction,
+  unsigned int imageID,
+  unsigned int maxIndices,
+  unsigned int moduleCount)
+  {
+   /* ==================
+      Deffunction Header
+      ================== */
+
+   fprintf(theFile,"{");
+   ConstructHeaderToCode(theEnv,theFile,&theDeffunction->header,imageID,maxIndices,moduleCount,
+                         ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),
+                         ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem));
+
+   /* =========================
+      Deffunction specific data
+      ========================= */
+   fprintf(theFile,",0,0,0,");
+   ExpressionToCode(theEnv,theFile,theDeffunction->code);
+   fprintf(theFile,",%d,%d,%d",
+           theDeffunction->minNumberOfParameters,
+           theDeffunction->maxNumberOfParameters,
+           theDeffunction->numberOfLocalVars);
+
+   fprintf(theFile,"}");
+  }
+
+#endif

data/ext/clipsruby/dffnxcmp.h

@@ -0,0 +1,54 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*             CLIPS Version 6.40  07/30/16            */
+   /*                                                     */
+   /*                                                     */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Deffunction Construct Compiler Code              */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.30: Added support for path name argument to        */
+/*            constructs-to-c.                               */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*      6.40: Removed LOCALE definition.                     */
+/*                                                           */
+/*            Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*************************************************************/
+
+#ifndef _H_dffnxcmp
+
+#pragma once
+
+#define _H_dffnxcmp
+
+#if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME)
+
+#include <stdio.h>
+
+#include "dffnxfun.h"
+
+   void                           SetupDeffunctionCompiler(Environment *);
+   void                           PrintDeffunctionReference(Environment *,FILE *,Deffunction *,unsigned,unsigned);
+   void                           DeffunctionCModuleReference(Environment *,FILE *,unsigned long,unsigned int,unsigned int);
+
+#endif /* DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */
+
+#endif /* _H_dffnxcmp */
+
+

data/ext/clipsruby/dffnxexe.c

@@ -0,0 +1,241 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  10/01/16             */
+   /*                                                     */
+   /*                                                     */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Deffunction Execution Routines                   */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
+/*                                                           */
+/*      6.30: Changed garbage collection algorithm.          */
+/*                                                           */
+/*            Changed integer type/precision.                */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*      6.40: Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/*            Added GCBlockStart and GCBlockEnd functions    */
+/*            for garbage collection blocks.                 */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if DEFFUNCTION_CONSTRUCT
+
+#include <stdio.h>
+#include <string.h>
+
+#include "constrct.h"
+#include "envrnmnt.h"
+#include "prcdrfun.h"
+#include "prccode.h"
+#include "prntutil.h"
+#include "proflfun.h"
+#include "router.h"
+#include "utility.h"
+#include "watch.h"
+
+#include "dffnxexe.h"
+
+/* =========================================
+   *****************************************
+                   CONSTANTS
+   =========================================
+   ***************************************** */
+#define BEGIN_TRACE ">> "
+#define END_TRACE   "<< "
+
+/* =========================================
+   *****************************************
+      INTERNALLY VISIBLE FUNCTION HEADERS
+   =========================================
+   ***************************************** */
+
+   static void                    UnboundDeffunctionErr(Environment *,const char *);
+
+#if DEBUGGING_FUNCTIONS
+   static void                    WatchDeffunction(Environment *,const char *);
+#endif
+
+/* =========================================
+   *****************************************
+          EXTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/****************************************************
+  NAME         : CallDeffunction
+  DESCRIPTION  : Executes the body of a deffunction
+  INPUTS       : 1) The deffunction
+                 2) Argument expressions
+                 3) Data object buffer to hold result
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Deffunction executed and result
+                 stored in data object buffer
+  NOTES        : Used in EvaluateExpression(theEnv,)
+ ****************************************************/
+void CallDeffunction(
+  Environment *theEnv,
+  Deffunction *dptr,
+  Expression *args,
+  UDFValue *returnValue)
+  {
+   bool oldce;
+   Deffunction *previouslyExecutingDeffunction;
+   GCBlock gcb;
+#if PROFILING_FUNCTIONS
+   struct profileFrameInfo profileFrame;
+#endif
+
+   returnValue->value = FalseSymbol(theEnv);
+   EvaluationData(theEnv)->EvaluationError = false;
+   if (EvaluationData(theEnv)->HaltExecution)
+     return;
+
+   GCBlockStart(theEnv,&gcb);
+
+   oldce = ExecutingConstruct(theEnv);
+   SetExecutingConstruct(theEnv,true);
+   previouslyExecutingDeffunction = DeffunctionData(theEnv)->ExecutingDeffunction;
+   DeffunctionData(theEnv)->ExecutingDeffunction = dptr;
+   EvaluationData(theEnv)->CurrentEvaluationDepth++;
+   dptr->executing++;
+   PushProcParameters(theEnv,args,CountArguments(args),DeffunctionName(dptr),
+                      "deffunction",UnboundDeffunctionErr);
+   if (EvaluationData(theEnv)->EvaluationError)
+     {
+      dptr->executing--;
+      DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction;
+      EvaluationData(theEnv)->CurrentEvaluationDepth--;
+
+      GCBlockEndUDF(theEnv,&gcb,returnValue);
+      CallPeriodicTasks(theEnv);
+
+      SetExecutingConstruct(theEnv,oldce);
+      return;
+     }
+
+#if DEBUGGING_FUNCTIONS
+   if (dptr->trace)
+     WatchDeffunction(theEnv,BEGIN_TRACE);
+#endif
+
+#if PROFILING_FUNCTIONS
+   StartProfile(theEnv,&profileFrame,
+                &dptr->header.usrData,
+                ProfileFunctionData(theEnv)->ProfileConstructs);
+#endif
+
+   EvaluateProcActions(theEnv,dptr->header.whichModule->theModule,
+                       dptr->code,dptr->numberOfLocalVars,
+                       returnValue,UnboundDeffunctionErr);
+
+#if PROFILING_FUNCTIONS
+    EndProfile(theEnv,&profileFrame);
+#endif
+
+#if DEBUGGING_FUNCTIONS
+   if (dptr->trace)
+     WatchDeffunction(theEnv,END_TRACE);
+#endif
+   ProcedureFunctionData(theEnv)->ReturnFlag = false;
+
+   dptr->executing--;
+   PopProcParameters(theEnv);
+   DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction;
+   EvaluationData(theEnv)->CurrentEvaluationDepth--;
+
+   GCBlockEndUDF(theEnv,&gcb,returnValue);
+   CallPeriodicTasks(theEnv);
+
+   SetExecutingConstruct(theEnv,oldce);
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/*******************************************************
+  NAME         : UnboundDeffunctionErr
+  DESCRIPTION  : Print out a synopis of the currently
+                   executing deffunction for unbound
+                   variable errors
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Error synopsis printed to STDERR
+  NOTES        : None
+ *******************************************************/
+static void UnboundDeffunctionErr(
+  Environment *theEnv,
+  const char *logName)
+  {
+   WriteString(theEnv,logName,"deffunction '");
+   WriteString(theEnv,logName,DeffunctionName(DeffunctionData(theEnv)->ExecutingDeffunction));
+   WriteString(theEnv,logName,"'.\n");
+  }
+
+#if DEBUGGING_FUNCTIONS
+
+/***************************************************
+  NAME         : WatchDeffunction
+  DESCRIPTION  : Displays a message indicating when
+                 a deffunction began and ended
+                 execution
+  INPUTS       : The beginning or end trace string
+                 to print when deffunction starts
+                 or finishes respectively
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Watch message printed
+  NOTES        : None
+ ***************************************************/
+static void WatchDeffunction(
+  Environment *theEnv,
+  const char *tstring)
+  {
+   if (ConstructData(theEnv)->ClearReadyInProgress ||
+       ConstructData(theEnv)->ClearInProgress)
+     { return; }
+
+   WriteString(theEnv,STDOUT,"DFN ");
+   WriteString(theEnv,STDOUT,tstring);
+   if (DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule != GetCurrentModule(theEnv))
+     {
+      WriteString(theEnv,STDOUT,DeffunctionModule(DeffunctionData(theEnv)->ExecutingDeffunction));;
+      WriteString(theEnv,STDOUT,"::");
+     }
+   WriteString(theEnv,STDOUT,DeffunctionData(theEnv)->ExecutingDeffunction->header.name->contents);
+   WriteString(theEnv,STDOUT," ED:");
+   WriteInteger(theEnv,STDOUT,EvaluationData(theEnv)->CurrentEvaluationDepth);
+   PrintProcParamArray(theEnv,STDOUT);
+  }
+
+#endif
+#endif